From ef32dfb04c56193d286e6a0360440ae4f10204dd Mon Sep 17 00:00:00 2001 From: Jerome Bergmann Date: Mon, 11 Apr 2022 15:46:45 +0200 Subject: [PATCH 01/15] elm review init start using elm reveiw --- .travis.yml | 5 +- review/elm.json | 40 ++ review/src/ReviewConfig.elm | 51 +++ src/Device.elm | 99 +++-- src/Main.elm | 365 +++++++++++-------- src/Msg.elm | 66 ++-- src/Page.elm | 51 +-- src/Page/Admin.elm | 104 +++--- src/Page/Answer.elm | 220 ++++++----- src/Page/Code.elm | 508 ++++++++++++++------------ src/Page/CodingQuestion.elm | 125 ++++--- src/Page/Event.elm | 563 ++++++++++++++++------------- src/Page/NewPage.elm | 9 +- src/Page/PageOne.elm | 49 ++- src/Page/PageWithSubpage.elm | 62 ++-- src/Page/Question.elm | 210 ++++++----- src/Page/Questionary.elm | 430 +++++++++++----------- src/Page/Study.elm | 254 +++++++------ src/Page/Top.elm | 102 +++--- src/Page/User.elm | 65 ++-- src/Ports.elm | 10 +- src/Session.elm | 24 +- src/TestDrawer.elm | 39 +- src/Type/Database.elm | 25 +- src/Type/Database/Aquisition.elm | 44 ++- src/Type/Database/InputType.elm | 215 ++++++----- src/Type/Database/TypeMatching.elm | 189 +++++----- src/Type/Entity.elm | 4 +- src/Type/Graph.elm | 20 +- src/Type/IO.elm | 53 ++- src/Type/IO/Decoder.elm | 97 +++-- src/Type/IO/Encoder.elm | 10 +- src/Type/IO/Form.elm | 258 +++++++------ src/Type/IO/Internal.elm | 13 +- src/Type/IO/Setter.elm | 265 ++++++++------ src/Type/IO/ToString.elm | 210 ++++++----- src/Type/IO/Update.elm | 128 ++++--- src/Type/IO/Viewer.elm | 2 +- src/Type/IOTest.elm | 88 +++-- src/Type/Par.elm | 56 +-- src/Type/Timestamp.elm | 49 +-- src/Type/UpdateTest.elm | 123 ++++--- src/Utils.elm | 3 +- src/Viewer.elm | 44 ++- src/Viewer/Desktop.elm | 74 ++-- src/Viewer/EditableText.elm | 12 +- src/Viewer/Handset.elm | 115 +++--- src/Viewer/Internal.elm | 415 +++++++++++---------- src/Viewer/OrderAwareList.elm | 3 +- src/Viewer/Tablet.elm | 126 ++++--- tests/AquisitionTest.elm | 44 ++- tests/Example.elm | 21 +- tests/Tests.elm | 5 +- 53 files changed, 3455 insertions(+), 2707 deletions(-) create mode 100644 review/elm.json create mode 100644 review/src/ReviewConfig.elm diff --git a/.travis.yml b/.travis.yml index 4d81d88..b3965c6 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,11 +3,12 @@ language: elm sudo: required install: + - npm i elm-review - npm i create-elm-app -g - npm i elm-coverage -g - - npm i coveralls -g - + #- npm i coveralls -g script: + - elm-review - elm-app test - elm-coverage #- cat ./.coverage/lcov.info | coveralls diff --git a/review/elm.json b/review/elm.json new file mode 100644 index 0000000..a80ff03 --- /dev/null +++ b/review/elm.json @@ -0,0 +1,40 @@ +{ + "type": "application", + "source-directories": [ + "src" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "elm/core": "1.0.5", + "jfmengels/elm-review": "2.7.1", + "jfmengels/elm-review-common": "1.2.0", + "jfmengels/elm-review-debug": "1.0.6", + "leojpod/review-no-empty-html-text": "1.0.2", + "sparksp/elm-review-always": "1.0.5", + "sparksp/elm-review-ports": "1.3.1", + "stil4m/elm-syntax": "7.2.9", + "truqu/elm-review-nobooleancase": "1.0.0" + }, + "indirect": { + "elm/html": "1.0.0", + "elm/json": "1.1.3", + "elm/parser": "1.1.0", + "elm/project-metadata-utils": "1.0.2", + "elm/random": "1.0.0", + "elm/time": "1.0.0", + "elm/virtual-dom": "1.0.2", + "elm-community/list-extra": "8.5.2", + "elm-explorations/test": "1.2.2", + "miniBill/elm-unicode": "1.0.2", + "rtfeldman/elm-hex": "1.0.0", + "stil4m/structured-writer": "1.0.3" + } + }, + "test-dependencies": { + "direct": { + "elm-explorations/test": "1.2.2" + }, + "indirect": {} + } +} diff --git a/review/src/ReviewConfig.elm b/review/src/ReviewConfig.elm new file mode 100644 index 0000000..139439b --- /dev/null +++ b/review/src/ReviewConfig.elm @@ -0,0 +1,51 @@ +module ReviewConfig exposing (config) + +{-| Do not rename the ReviewConfig module or the config function, because +`elm-review` will look for these. + +To add packages that contain rules, add them to this review project using + + `elm install author/packagename` + +when inside the directory containing this file. + +-} + +import NoAlways +import NoBooleanCase +import NoDebug.Log +import NoDebug.TodoOrToString +import NoDuplicatePorts +import NoUnsafePorts +import NoEmptyText +import NoUnusedPorts +import NoDeprecated +import NoExposingEverything +import NoImportingEverything +import NoMissingTypeAnnotation +import NoMissingTypeAnnotationInLetIn +import NoMissingTypeExpose +import NoPrematureLetComputation +import Review.Rule exposing (Rule) + + +config : List Rule +config = + [ NoAlways.rule + , NoBooleanCase.rule + , NoDebug.Log.rule + , NoDebug.TodoOrToString.rule + , NoDuplicatePorts.rule + , NoUnsafePorts.rule NoUnsafePorts.any + , NoUnusedPorts.rule + , NoEmptyText.rule + , NoExposingEverything.rule + , NoDeprecated.rule NoDeprecated.defaults + , NoImportingEverything.rule [] + |> Review.Rule.ignoreErrorsForDirectories [ "tests/"] + , NoMissingTypeAnnotation.rule + , NoMissingTypeAnnotationInLetIn.rule + |> Review.Rule.ignoreErrorsForDirectories [ "tests/"] + , NoMissingTypeExpose.rule + , NoPrematureLetComputation.rule + ] diff --git a/src/Device.elm b/src/Device.elm index dfba87f..c042e53 100644 --- a/src/Device.elm +++ b/src/Device.elm @@ -1,17 +1,20 @@ -module Device exposing (fromPixel, Device(..),WindowType(..),Orientation(..)) - -type alias DeviceConfig = - { - device : Device - , orientation : Orientation - , windowType : WindowType - , columns : Int +module Device exposing (Device(..), DeviceConfig, Orientation(..), WindowType(..), fromPixel) + + +type alias DeviceConfig = + { device : Device + , orientation : Orientation + , windowType : WindowType + , columns : Int } -type Device + + +type Device = Handset | Tablet | Desktop + type WindowType = XSmall | Small @@ -19,22 +22,31 @@ type WindowType | Large | XLarge + type Orientation = Portrait | Landscape + fromPixel : Int -> Int -> DeviceConfig fromPixel width height = let - dom = max width height - orientation = if height > width then Portrait else Landscape + dom = + max width height + + orientation = + if height > width then + Portrait + + else + Landscape in - { - device = getDevice dom orientation - , orientation = orientation - , windowType = getWindowType dom - , columns = getColumns dom - } + { device = getDevice dom orientation + , orientation = orientation + , windowType = getWindowType dom + , columns = getColumns dom + } + getDevice : Int -> Orientation -> Device getDevice pixel orientation = @@ -42,42 +54,49 @@ getDevice pixel orientation = Landscape -> if pixel < 960 then Handset + + else if pixel < 1440 then + Tablet + else - if pixel < 1440 then - Tablet - else - Desktop + Desktop + Portrait -> if pixel < 600 then Handset + + else if pixel < 960 then + Tablet + else - if pixel < 960 then - Tablet - else - Desktop - + Desktop + + getWindowType : Int -> WindowType getWindowType pixel = if pixel < 600 then XSmall + + else if pixel < 1024 then + Small + + else if pixel < 1440 then + Medium + + else if pixel < 1920 then + Large + else - if pixel < 1024 then - Small - else - if pixel < 1440 then - Medium - else - if pixel < 1920 then - Large - else - XLarge + XLarge + getColumns : Int -> Int getColumns pixel = if pixel < 600 then 4 + + else if pixel < 840 then + 8 + else - if pixel < 840 then - 8 - else - 12 \ No newline at end of file + 12 diff --git a/src/Main.elm b/src/Main.elm index 5098ec0..1242a72 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -1,4 +1,4 @@ -module Main exposing (Model, init, main, subscriptions, update, view) +module Main exposing (Model, Page, init, main, subscriptions, update, view) -- import Page.NewPage as NewPage --import Html exposing (..) @@ -9,42 +9,40 @@ import Browser import Browser.Events import Browser.Navigation import Json.Decode +import Material.Snackbar as Snackbar import Msg import Page import Page.Admin as Admin +import Page.Answer as Answer +import Page.Code as Code +import Page.CodingQuestion as CodingQuestion import Page.Event as Event import Page.PageOne as PageOne import Page.PageWithSubpage as PageWithSubpage -import Page.Questionary as Questionary import Page.Question as Question +import Page.Questionary as Questionary import Page.Study as Study import Page.Top as Top import Page.User as User -import Page.CodingQuestion as CodingQuestion -import Page.Answer as Answer -import Page.Code as Code import Ports import Random exposing (generate) import Random.Char exposing (latin) import Random.String exposing (string) import Session import Task exposing (perform) -import Time exposing (now, Posix) -import Material.Snackbar as Snackbar +import Time exposing (Posix, now) import Type.Database as Db exposing (database) import Type.Database.TypeMatching as Match import Type.Flags import Type.IO exposing (form2update) -import Type.IO.Setter as Updater import Type.IO.Internal exposing (Id, box, unbox) +import Type.IO.Setter as Updater import Url import Url.Builder -import Url.Parser as Parser exposing ((),()) +import Url.Parser as Parser exposing ((), (), query) import Url.Parser.Query as Query import Viewer -import Url.Parser exposing (query) - -- TYPES @@ -98,7 +96,9 @@ init flags url key = ( model, cmds ) = routeUrl (urlAdaptHash url) <| Model key (NotFound <| Session.init flags) Viewer.header Nothing - newCmds = Cmd.batch [cmds, perform Msg.Tick now] + + newCmds = + Cmd.batch [ cmds, perform Msg.Tick now ] in -- On loading the application, we read form local storage. If the object is incorrectly formatted, clear localStorage case localStorage of @@ -107,7 +107,9 @@ init flags url key = Err _ -> let - newmodel = {-reportError "Could not load localstorage!"-} model + newmodel = + {- reportError "Could not load localstorage!" -} + model in -- If localstorage decoder failed, clear localstorage ( newmodel, Cmd.batch [ newCmds, Ports.clearLocalStorage () ] ) @@ -122,9 +124,6 @@ defaultUpdate message ( model, effect ) = let session = extractSession model - - db = - session.db in (\( x, y ) -> ( x, Cmd.batch [ effect, y ] )) <| case message of @@ -198,6 +197,10 @@ defaultUpdate message ( model, effect ) = updateSession model { session | db = new_db } Msg.CRUD msg -> + let + db = + session.db + in case msg of Msg.Create kind id callbacks -> let @@ -214,7 +217,7 @@ defaultUpdate message ( model, effect ) = case kind of Db.UserType -> updateDbSession model { session | user = Just (box id) } newDb - |> chainableUpdate (Msg.SetUser (box id)) + |> chainableUpdate (Msg.SetUser (box id)) Db.QuestionaryType -> updateDbSession model session newDb @@ -243,9 +246,10 @@ defaultUpdate message ( model, effect ) = case Db.database.updater msg_ db of Err e -> let - newmodel = reportError (Updater.errToString e) model + newmodel = + reportError (Updater.errToString e) model in - ( newmodel, Cmd.none ) + ( newmodel, Cmd.none ) Ok newDb -> case msg_ of @@ -279,41 +283,46 @@ defaultUpdate message ( model, effect ) = _ -> updateDbSession model session newDb - - Msg.Access kind id -> - ( model, Cmd.batch [ Cmd.map (Msg.CRUD << Msg.Update) <| - perform - (\z -> - Updater.AttributeMsg (Match.toStringPlural kind) <| - Updater.DictKeyMsg id <| - Updater.AttributeMsg "accessed" <| - Updater.IntMsg (Time.posixToMillis z) - ) - now - ]) + Msg.Access kind id -> + ( model + , Cmd.batch + [ Cmd.map (Msg.CRUD << Msg.Update) <| + perform + (\z -> + Updater.AttributeMsg (Match.toStringPlural kind) <| + Updater.DictKeyMsg id <| + Updater.AttributeMsg "accessed" <| + Updater.IntMsg (Time.posixToMillis z) + ) + now + ] + ) Msg.UpdateAll updates -> case List.foldl (Result.andThen << Db.database.updater) (Ok db) updates of Err e -> let - newmodel = reportError (Updater.errToString e) model + newmodel = + reportError (Updater.errToString e) model in - ( newmodel, Cmd.none ) + ( newmodel, Cmd.none ) + Ok newDb -> updateDbSession model session newDb Msg.Delete kind id -> let - newDb = Match.delete (box id) kind db + newDb = + Match.delete (box id) kind db in - updateDbSession model session newDb - -- Msg.SwapAttributes kind (first, second) attribute -> - -- let - -- fvalue = db - -- in - - -- (model, Cmd.none) + updateDbSession model session newDb + + -- Msg.SwapAttributes kind (first, second) attribute -> + -- let + -- fvalue = db + -- in + -- (model, Cmd.none) Msg.Form msg -> case form2update msg of Just dbmsg -> @@ -324,44 +333,50 @@ defaultUpdate message ( model, effect ) = Msg.Follow kind id -> ( model, Browser.Navigation.pushUrl model.key <| "#" ++ Url.Builder.absolute [ Match.toString kind, id ] [] ) - - Msg.FollowSubpage kind id subpages qparam -> - ( model, Browser.Navigation.pushUrl model.key <| "#" ++ Url.Builder.absolute ([ Match.toString kind, id] ++ subpages) qparam ) + + Msg.FollowSubpage kind id subpages qparam -> + ( model, Browser.Navigation.pushUrl model.key <| "#" ++ Url.Builder.absolute ([ Match.toString kind, id ] ++ subpages) qparam ) Msg.SetUser id -> - let - newSession = - { session | user = Just id } - in - updateSession model newSession - |> (\(x, y) -> (x, Cmd.batch [y - , - perform - (\z -> - Match.setField - { kind = Db.UserType - , attribute = "last_login" - , setter = Updater.IntMsg << Time.posixToMillis - , value = z - , id = id - } - ) - now])) - + let + newSession = + { session | user = Just id } + in + updateSession model newSession + |> (\( x, y ) -> + ( x + , Cmd.batch + [ y + , perform + (\z -> + Match.setField + { kind = Db.UserType + , attribute = "last_login" + , setter = Updater.IntMsg << Time.posixToMillis + , value = z + , id = id + } + ) + now + ] + ) + ) + Msg.Back -> - (model, Browser.Navigation.back model.key 1) + ( model, Browser.Navigation.back model.key 1 ) Msg.Tick time -> - ({model | time = Just time}, Cmd.none) - + ( { model | time = Just time }, Cmd.none ) + Msg.SnackbarClosed messageId -> let - oldheader = model.header - newheader = {oldheader | queue = Snackbar.close messageId oldheader.queue} + oldheader = + model.header + + newheader = + { oldheader | queue = Snackbar.close messageId oldheader.queue } in - - ({model | header = newheader}, Cmd.none) - + ( { model | header = newheader }, Cmd.none ) _ -> ( model, Cmd.none ) @@ -442,12 +457,13 @@ update message model = ( newmodel, effect ) = --Admin.update message mapPageMsg model Admin (Page.update message m) - - session = - extractSession newmodel in case message of Msg.Admin (Msg.AdminDb _) -> + let + session = + extractSession newmodel + in updateSession newmodel (extractSession newmodel) |> (\( x, y ) -> ( x, Cmd.batch [ y, Ports.toDb (Type.IO.encode database.encoder session.db) ] )) @@ -462,26 +478,29 @@ update message model = defaultUpdate message ( newmodel, effect ) Study m -> - mapPageMsg model Study (Page.update message m) |> defaultUpdate message Event m -> - case message of - Msg.Event (Msg.AnswerQuestions newmodel) -> - let - session = extractSession model - (newpage, effect) = Answer.page session newmodel - in - ({model| page = Answer <| newpage}, effect) - _ -> - mapPageMsg model Event (Page.update message m) - |> defaultUpdate message + case message of + Msg.Event (Msg.AnswerQuestions newmodel) -> + let + session = + extractSession model + + ( newpage, effect ) = + Answer.page session newmodel + in + ( { model | page = Answer <| newpage }, effect ) + + _ -> + mapPageMsg model Event (Page.update message m) + |> defaultUpdate message Questionary m -> mapPageMsg model Questionary (Page.update message m) - |> defaultUpdate message - + |> defaultUpdate message + Question m -> mapPageMsg model Question (Page.update message m) |> defaultUpdate message @@ -493,7 +512,7 @@ update message model = Answer m -> mapPageMsg model Answer (Page.update message m) |> defaultUpdate message - + Code m -> mapPageMsg model Code (Page.update message m) |> defaultUpdate message @@ -509,12 +528,12 @@ update message model = view : Model -> Browser.Document Msg.Msg view model = - let - session = - extractSession model - in case model.page of NotFound _ -> + let + session = + extractSession model + in Viewer.view session never Viewer.notFound Viewer.header model.time User m -> @@ -542,16 +561,16 @@ view model = Questionary m -> Page.view m model.header model.time - + Question m -> Page.view m model.header model.time - + CodingQuestion m -> Page.view m model.header model.time - + Answer m -> Page.view m model.header model.time - + Code m -> Page.view m model.header model.time @@ -562,18 +581,19 @@ view model = subscriptions : Model -> Sub Msg.Msg -subscriptions {page} = +subscriptions { page } = Sub.batch <| - [case page of + [ case page of Questionary (Page.Page m) -> Sub.map m.toMsg m.subscriptions + _ -> Sub.none , Browser.Events.onResize Msg.OnWindowResize , Ports.onLocalStorageChange Msg.OnLocalStorageChange , Ports.onDbChange Msg.OnDbChange , Time.every 1000 Msg.Tick - ] + ] @@ -653,10 +673,10 @@ extractSession model = Questionary m -> getSession m - + Question m -> getSession m - + CodingQuestion m -> getSession m @@ -667,6 +687,7 @@ extractSession model = getSession m + -- Update the session of the active page (This could be changed to send a OnSessionChange Msg rather than using init) -- However, I think it's better you design your pages such that initializing the page is equivalent to updating the session! @@ -708,19 +729,19 @@ updateSession model session = Questionary (Page.Page m) -> Questionary.page session m.page.id m.page.focus (Just m.page.questions) m.page.dnd |> (\( x, y ) -> ( { model | page = Questionary x }, y )) - + Question (Page.Page m) -> Question.page session m.page.id |> (\( x, y ) -> ( { model | page = Question x }, y )) - + CodingQuestion (Page.Page m) -> CodingQuestion.page session m.page.id |> (\( x, y ) -> ( { model | page = CodingQuestion x }, y )) - + Answer (Page.Page m) -> Answer.page session m.page |> (\( x, y ) -> ( { model | page = Answer x }, y )) - + Code (Page.Page m) -> Code.page session m.page.id |> (\( x, y ) -> ( { model | page = Code x }, y )) @@ -740,17 +761,27 @@ updateDbSession model session db = -- ROUTING -- The following functions create the client-side router. Update "parser" and "paths" for each page you add/remove + + testMethod = - case Url.fromString "http://localhost:3000/event/oLFlGAGBkkaZDCTsnmOA/answer?tsid=a" of + case Url.fromString "http://localhost:3000/event/oLFlGAGBkkaZDCTsnmOA/answer?tsid=a" of Nothing -> Nothing + Just oldUrl -> let - hashUrl = { oldUrl | path = Maybe.withDefault "" oldUrl.fragment, fragment = Nothing } - func x y = "yes" + hashUrl = + { oldUrl | path = Maybe.withDefault "" oldUrl.fragment, fragment = Nothing } + + func x y = + "yes" in - Parser.parse (Parser.map func (Parser.s paths.event Parser.string Parser.s "answer" Query.custom "tsid" identity)) oldUrl - --Parser.parse (Parser.s paths.event Parser.string Answer.parser ) + Parser.parse (Parser.map func (Parser.s paths.event Parser.string Parser.s "answer" Query.custom "tsid" identity)) oldUrl + + + +--Parser.parse (Parser.s paths.event Parser.string Answer.parser ) + routeUrl : Url.Url -> Model -> ( Model, Cmd Msg.Msg ) routeUrl url model = @@ -763,9 +794,8 @@ routeUrl url model = { url | path = Maybe.withDefault "" url.fragment, fragment = Nothing } in -- If you'd like to use hash-based routing: - --case Parser.parse (parser model session) hashUrl of - case Parser.parse (parser model session) url of + case Parser.parse (parser model session) url of Just success -> success @@ -793,47 +823,63 @@ parser model session = , route (Parser.s paths.study Parser.string) (\id -> mapPageMsg model Study (Study.page session (box id) False)) , route (Parser.s paths.study Parser.string Parser.s "code") - (\id -> mapPageMsg model Code (Code.page session (box id))) + (\id -> mapPageMsg model Code (Code.page session (box id))) + -- - , route (Parser.s paths.event Parser.string Answer.parser ) - (\eid answer_result -> + , route (Parser.s paths.event Parser.string Answer.parser) + (\eid answer_result -> case answer_result eid of Just amodel -> - mapPageMsg model Answer (Answer.page - session - amodel) - Nothing -> - mapPageMsg model Event ( - Event.page - session - Msg.EventSettings - (box eid) - False) + mapPageMsg model + Answer + (Answer.page + session + amodel + ) + Nothing -> + mapPageMsg model + Event + (Event.page + session + Msg.EventSettings + (box eid) + False + ) ) - , route (Parser.s paths.event Parser.string Parser.s "people") - (\id -> mapPageMsg model Event ( - Event.page - session - Msg.EventPeople - (box id) - False)) + (\id -> + mapPageMsg model + Event + (Event.page + session + Msg.EventPeople + (box id) + False + ) + ) , route (Parser.s paths.event Parser.string Parser.s "settings") - (\id -> mapPageMsg model Event ( - Event.page - session - Msg.EventSettings - (box id) - False)) - + (\id -> + mapPageMsg model + Event + (Event.page + session + Msg.EventSettings + (box id) + False + ) + ) , route (Parser.s paths.event Parser.string) - (\id -> mapPageMsg model Event ( - Event.page - session - Msg.EventOverview - (box id) - False)) + (\id -> + mapPageMsg model + Event + (Event.page + session + Msg.EventOverview + (box id) + False + ) + ) , route (Parser.s paths.questionary Parser.string) (\id -> mapPageMsg model Questionary (Questionary.page session (box id) Questionary.defaultFokus Nothing Viewer.system.model)) , route (Parser.s paths.question Parser.string) @@ -879,23 +925,32 @@ toHashUrl url = { url | fragment = Just url.path, path = "" } -reportError : String -> Model -> Model +reportError : String -> Model -> Model reportError msg model = let - oldheader = model.header - message = Snackbar.message msg - |> Snackbar.setStacked True - newQueue = Snackbar.addMessage message oldheader.queue - newheader = {oldheader | queue = newQueue} + oldheader = + model.header + + message = + Snackbar.message msg + |> Snackbar.setStacked True + + newQueue = + Snackbar.addMessage message oldheader.queue + + newheader = + { oldheader | queue = newQueue } in - {model|header = newheader} + { model | header = newheader } + urlAdaptHash : Url.Url -> Url.Url urlAdaptHash url = let - mbnewUrl = url - |> Url.toString + mbnewUrl = + url + |> Url.toString |> String.replace "/#/" "/" |> Url.fromString in - Maybe.withDefault url mbnewUrl \ No newline at end of file + Maybe.withDefault url mbnewUrl diff --git a/src/Msg.elm b/src/Msg.elm index b60c50f..01af8db 100644 --- a/src/Msg.elm +++ b/src/Msg.elm @@ -1,36 +1,35 @@ module Msg exposing ( AdminMsg(..) , DbMsg(..) + , EditableTextMsg(..) + , EventMsg(..) + , EventSubPage(..) + , ListMsg(..) + , LongMsg(..) , Msg(..) , PageOneMsg(..) , PageWithSubpageMsg(..) + , QuestionMsg(..) + , QuestionaryMsg(..) + , ShortMsg(..) + , StudyMsg(..) , TopMsg(..) , UserMsg(..) , ViewerMsg(..) - , StudyMsg(..) - , EventMsg(..) - , QuestionaryMsg(..) - , QuestionMsg(..) - , EditableTextMsg(..) - , ShortMsg(..) - , LongMsg(..) - , ListMsg(..) - , EventSubPage(..) ) import Browser +import DnDList import Json.Encode -import Type.Database exposing (Type) -import Type.IO.Form exposing (UpdateMsg(..)) -import Type.IO.Setter as Updater -import Type.IO.Internal exposing (Id) -import Type.Database as Db -import Type.Database.InputType as IT import Material.Snackbar as Snackbar import Time exposing (Posix) +import Type.Database as Db exposing (Type) +import Type.Database.InputType as IT +import Type.IO.Form exposing (UpdateMsg(..)) +import Type.IO.Internal exposing (Id) +import Type.IO.Setter as Updater import Url import Url.Builder -import DnDList type Msg @@ -41,7 +40,7 @@ type Msg | Viewer ViewerMsg | Top TopMsg | User UserMsg - | Admin (AdminMsg) + | Admin AdminMsg -- | NewPageMsg NewPage.Msg | PageOne PageOneMsg | Study StudyMsg @@ -61,7 +60,6 @@ type Msg | Tick Posix | SnackbarClosed Snackbar.MessageId | DnDEvent DnDList.Msg - type ViewerMsg @@ -76,12 +74,13 @@ type TopMsg | LocalStorageInputFieldChange String | SetLocalStorage | ClearLocalStorage - + type EditableTextMsg = GetFocus | LooseFocus + type StudyMsg = StudyNameEdit EditableTextMsg | ExportStudy String @@ -89,21 +88,27 @@ type StudyMsg type EventMsg = EventNameEdit EditableTextMsg - | AnswerQuestions {questionary: String, test_subject: String, event: String} + | AnswerQuestions { questionary : String, test_subject : String, event : String } | EventSwitchTo EventSubPage + type EventSubPage = EventSettings | EventOverview | EventPeople + type QuestionaryMsg = CurrentQuestionSelected (Maybe String) | QuestionNameEdit EditableTextMsg | ContextMenu (Maybe String) -{- | OnQuestionDrag DnDList.Msg - | Tock Posix -} + + +{- | OnQuestionDrag DnDList.Msg + | Tock Posix +-} + type QuestionMsg = SetInputType String @@ -111,16 +116,18 @@ type QuestionMsg | Long LongMsg | List ListMsg -type ShortMsg + +type ShortMsg = ShortLabel String | ShortPlaceholder String -type LongMsg + +type LongMsg = LongLabel String -type ListMsg + +type ListMsg = SingleInput IT.SingleInputType - type DbMsg @@ -130,7 +137,10 @@ type DbMsg | UpdateAll (List Updater.Msg) | Delete Type String | Access Type String - --| SwapAttributes Type (String, String) String + + + +--| SwapAttributes Type (String, String) String type PageOneMsg @@ -147,5 +157,5 @@ type UserMsg type AdminMsg = AdminForm UpdateMsg - | AdminDb (DbMsg) + | AdminDb DbMsg | ValueChanged String diff --git a/src/Page.elm b/src/Page.elm index bfa84b2..bae0a64 100644 --- a/src/Page.elm +++ b/src/Page.elm @@ -1,44 +1,49 @@ -module Page exposing (..) +module Page exposing (Page(..), liftupdate, liftview, update, view) -import Session -import Viewer -import Msg import Browser exposing (Document) +import Msg import Session -import Html import Time exposing (Posix) +import Viewer + +type Page a msg + = Page + { session : Session.Session + , page : a + , view : Page a msg -> Viewer.Details Msg.Msg + , toMsg : msg -> Msg.Msg + , subscriptions : Sub msg + , -- header : Viewer.Header, + update : msg -> Page a msg -> ( Page a msg, Cmd msg ) + } -type Page a msg= - Page - { session : Session.Session, - page : a, - view : (Page a msg -> Viewer.Details Msg.Msg), - toMsg : (msg -> Msg.Msg), - subscriptions : Sub msg, - -- header : Viewer.Header, - update : (msg -> Page a msg -> (Page a msg, Cmd msg)) - } view : Page a msg -> Viewer.Header -> Maybe Posix -> Document Msg.Msg -view (Page model) header = +view (Page model) header = Viewer.view model.session model.toMsg (model.view (Page model)) header + liftview : (a -> Viewer.Details msg) -> Page a msg -> Viewer.Details msg -liftview pview (Page a)= +liftview pview (Page a) = pview a.page -update : msg -> Page a msg -> (Page a msg, Cmd msg) + +update : msg -> Page a msg -> ( Page a msg, Cmd msg ) update msg (Page model) = model.update msg (Page model) + + -- updateHeader : Msg.ViewerMsg -> Page a msg -> Page a msg -- updateHeader msg (Page model) = -- Page {model| header = Viewer.update msg model.header} -liftupdate : (msg -> a -> (a, Cmd msg)) -> msg -> Page a msg -> (Page a msg, Cmd msg) -liftupdate uf msg (Page model) = + +liftupdate : (msg -> a -> ( a, Cmd msg )) -> msg -> Page a msg -> ( Page a msg, Cmd msg ) +liftupdate uf msg (Page model) = let - (newModel, effect) = uf msg model.page - in - (Page {model | page = newModel}, effect) + ( newModel, effect ) = + uf msg model.page + in + ( Page { model | page = newModel }, effect ) diff --git a/src/Page/Admin.elm b/src/Page/Admin.elm index 95e0646..08fb955 100644 --- a/src/Page/Admin.elm +++ b/src/Page/Admin.elm @@ -1,4 +1,4 @@ -module Page.Admin exposing (Model, init, page, parser, update, url, view) +module Page.Admin exposing (Model, SubPage, init, page, parser, update, url, view) --import Browser @@ -8,9 +8,9 @@ import Html.Attributes exposing (class, href) import Material.Button as Button exposing (config) import Material.DataTable as DataTable exposing - ( dataTable - , cell + ( cell , config + , dataTable , row ) import Msg exposing (AdminMsg) @@ -23,9 +23,9 @@ import Type.Database as Db import Type.Database.TypeMatching as Match import Type.IO exposing (form2update) import Type.IO.Form as Form +import Type.IO.Internal exposing (Id, box, unbox) import Type.IO.Setter as Update import Type.IO.ToString as ToString -import Type.IO.Internal exposing (Id, box, unbox) import Url.Parser as Parser exposing ((), ()) import Url.Parser.Query as Query import Viewer exposing (detailsConfig) @@ -69,6 +69,7 @@ page session table = , view = view , toMsg = identity , subscriptions = Sub.none + -- , header = Viewer.header , update = update @@ -172,41 +173,42 @@ view : Page Model Msg.Msg -> Viewer.Details Msg.Msg view (Page.Page model) = { detailsConfig | title = toTitle model.page - , body = \_ -> - [ h1 [] [ text "Admin Panel" ] - , div [ class "content" ] <| - case model.page.subpage of - Home -> - [ h3 [] [ text "This is a page that can handle sbpaths in its routing." ] - , div - [] - (Dict.toList model.session.db.users - |> List.map (\( x, _ ) -> text x) - ) - - -- , newEntry "answer" - -- , h3 [] [ text <| "The current subpath is : /" ++ String.fromInt (Maybe.withDefault -1 model.page.user_id) ] - -- , div [] [ text "The subpath could be anything, or a specific type, like a string or integer. You can have many levels of subpaths if you wanted!" ] - -- , div [] - -- [ text " This demo accepts a single level subpath that can be any string. For example, " - -- , a [ href "/pagewithsubpage/xyz" ] [ text "/pagewithsubpage/xyz" ] - -- ] - -- , div [] [ a [ href "/pagewithsubpage/a-wonderful-subpath" ] [ text "click here to go to a subpath" ] ] - -- , div [] [ a [ href "/pagewithsubpage/i-love-elm" ] [ text "click here to go to another subpath" ] ] - , viewTables (Page model) - ] - - Query kind id -> - [ p [] [ text <| "Querying " ++ Maybe.withDefault "" id ] - , toTable (filterKeys id kind model.session.db) kind model.session.db - ] - - Edit kind id -> - [ div [] <| edit model.session.db kind id - , Maybe.map (\x -> Html.h4 [] [ text ("Error: " ++ x) ]) model.page.error - |> Maybe.withDefault (div [] []) - ] - ] + , body = + \_ -> + [ h1 [] [ text "Admin Panel" ] + , div [ class "content" ] <| + case model.page.subpage of + Home -> + [ h3 [] [ text "This is a page that can handle sbpaths in its routing." ] + , div + [] + (Dict.toList model.session.db.users + |> List.map (\( x, _ ) -> text x) + ) + + -- , newEntry "answer" + -- , h3 [] [ text <| "The current subpath is : /" ++ String.fromInt (Maybe.withDefault -1 model.page.user_id) ] + -- , div [] [ text "The subpath could be anything, or a specific type, like a string or integer. You can have many levels of subpaths if you wanted!" ] + -- , div [] + -- [ text " This demo accepts a single level subpath that can be any string. For example, " + -- , a [ href "/pagewithsubpage/xyz" ] [ text "/pagewithsubpage/xyz" ] + -- ] + -- , div [] [ a [ href "/pagewithsubpage/a-wonderful-subpath" ] [ text "click here to go to a subpath" ] ] + -- , div [] [ a [ href "/pagewithsubpage/i-love-elm" ] [ text "click here to go to another subpath" ] ] + , viewTables (Page model) + ] + + Query kind id -> + [ p [] [ text <| "Querying " ++ Maybe.withDefault "" id ] + , toTable (filterKeys id kind model.session.db) kind model.session.db + ] + + Edit kind id -> + [ div [] <| edit model.session.db kind id + , Maybe.map (\x -> Html.h4 [] [ text ("Error: " ++ x) ]) model.page.error + |> Maybe.withDefault (div [] []) + ] + ] , search = case model.page.subpage of Query _ id -> @@ -247,8 +249,8 @@ toTable keys kind db = values = List.map (\id -> id :: List.map (\fname -> Match.getField id fname kind db |> Maybe.withDefault "") (Match.fields kind)) keys in - DataTable.dataTable - (DataTable.config) + DataTable.dataTable + DataTable.config { thead = [ row [] <| List.map @@ -291,14 +293,16 @@ edit db kind id = Ok form -> [ form , Button.text - (Button.config |> Button.setOnClick - (Msg.Form <| - Form.AttrMsg (Match.toStringPlural kind) <| - Form.DictMsg (Just id) <| - Form.AttrMsg "value" <| - Form.AttrMsg x <| - Form.StringMsg (Just "Value") - )) + (Button.config + |> Button.setOnClick + (Msg.Form <| + Form.AttrMsg (Match.toStringPlural kind) <| + Form.DictMsg (Just id) <| + Form.AttrMsg "value" <| + Form.AttrMsg x <| + Form.StringMsg (Just "Value") + ) + ) "SetValue!" , case Db.database.toString @@ -414,7 +418,7 @@ viewValue id kind db = else div [] [ text "No result found! Create One?" - , Button.text (Button.config |> Button.setOnClick (Msg.AdminDb <| Msg.Create kind id []) ) + , Button.text (Button.config |> Button.setOnClick (Msg.AdminDb <| Msg.Create kind id [])) "Create!" ] diff --git a/src/Page/Answer.elm b/src/Page/Answer.elm index e5c26e5..5f91078 100644 --- a/src/Page/Answer.elm +++ b/src/Page/Answer.elm @@ -1,13 +1,14 @@ -module Page.Answer exposing (..) +module Page.Answer exposing (Model, RelatedData, demoContent, page, parser, relatedData, toTitle, update, view, viewQuestion) + +--import Html.Keyed as Keyed import Dict -import Element exposing (fill, height, width, px, padding ) -import Element.Font as Font +import Element exposing (fill, height, padding, px, width) import Element.Background as Background +import Element.Font as Font +import Element.Keyed as Keyed import Html exposing (text) import Html.Attributes exposing (style) ---import Html.Keyed as Keyed -import Element.Keyed as Keyed import List.Extra import Material.Button as Button exposing (config) import Material.TextArea as TextArea @@ -18,11 +19,11 @@ import Session import Type.Database as Db import Type.Database.InputType exposing (InputType(..)) import Type.Database.TypeMatching as Match -import Type.IO.Setter as Updater import Type.IO.Internal as Id exposing (Id, box, unbox) -import Viewer exposing (detailsConfig) +import Type.IO.Setter as Updater import Url.Parser as Parser exposing (()) import Url.Parser.Query as Query +import Viewer exposing (detailsConfig) type alias Model = @@ -45,6 +46,7 @@ page session init = , view = view , toMsg = identity , subscriptions = Sub.none + -- , header = Viewer.header , update = update @@ -97,26 +99,35 @@ page session init = -} ( Page model, Cmd.none ) + parser : Parser.Parser ((String -> Maybe Model) -> a) a parser = - Parser.s "answer" (Parser.query <| - Query.map2 - (\qid tsid -> (\eid -> Maybe.map2 Model qid tsid - |> Maybe.map (\x -> x eid))) - (Query.string "qid") - (Query.string "tsid")) - {- let - page2parser : Db.Type -> Parser.Parser (SubPage -> b) b - page2parser subpage = - Parser.map (Query subpage) (Parser.s (Match.toString subpage) Query.string "q") - - page2edit : Db.Type -> Parser.Parser (SubPage -> b) b - page2edit subpage = - Parser.map (Edit subpage) (Parser.s (Match.toString subpage) Parser.string) - in - Parser.oneOf - (Parser.map Home Parser.top :: List.map page2parser Match.types ++ List.map page2edit Match.types) -} - + Parser.s "answer" + (Parser.query <| + Query.map2 + (\qid tsid -> + \eid -> + Maybe.map2 Model qid tsid + |> Maybe.map (\x -> x eid) + ) + (Query.string "qid") + (Query.string "tsid") + ) + + + +{- let + page2parser : Db.Type -> Parser.Parser (SubPage -> b) b + page2parser subpage = + Parser.map (Query subpage) (Parser.s (Match.toString subpage) Query.string "q") + + page2edit : Db.Type -> Parser.Parser (SubPage -> b) b + page2edit subpage = + Parser.map (Edit subpage) (Parser.s (Match.toString subpage) Parser.string) + in + Parser.oneOf + (Parser.map Home Parser.top :: List.map page2parser Match.types ++ List.map page2edit Match.types) +-} update : Msg.Msg -> Page.Page Model Msg.Msg -> ( Page.Page Model Msg.Msg, Cmd Msg.Msg ) @@ -132,55 +143,57 @@ view (Page.Page model) = db = model.session.db - viewportHeight = model.session.windowSize.height - - in + + viewportHeight = + model.session.windowSize.height + in { detailsConfig | title = toTitle model.page , user = model.session.user , body = - \_ -> [ - case infos.currentQuestionId of + \_ -> + [ case infos.currentQuestionId of Just qid -> - case Dict.get (unbox qid) <| Dict.fromList (List.map (\(a,b) -> (unbox a, b)) infos.questions ) of + case Dict.get (unbox qid) <| Dict.fromList (List.map (\( a, b ) -> ( unbox a, b )) infos.questions) of Just question -> - - Element.layout [ height <| px <| viewportHeight - 48, padding 24] <| - Element.column [height fill, width fill] + Element.layout [ height <| px <| viewportHeight - 48, padding 24 ] <| + Element.column [ height fill, width fill ] [ Element.el [ height fill, width fill ] <| viewQuestion db qid question infos.currentAnswer model.page - , Element.row [ Element.alignBottom, width fill] - [ Element.el [Element.alignLeft] <| Element.html - (case infos.previous of - Just prev -> - Button.raised - (Button.config |> Button.setOnClick prev) - "Previous" - - Nothing -> - text "" - ) + , Element.row [ Element.alignBottom, width fill ] + [ Element.el [ Element.alignLeft ] <| + Element.html + (case infos.previous of + Just prev -> + Button.raised + (Button.config |> Button.setOnClick prev) + "Previous" + + Nothing -> + text "" + ) , Element.el [ Element.centerX, width fill ] (Element.text "") - , Element.el [ Element.alignRight] <| Element.html - (case infos.next of - Just next -> - Button.raised - (Button.config |> Button.setOnClick next) - "Next" - - Nothing -> - text "" - ) + , Element.el [ Element.alignRight ] <| + Element.html + (case infos.next of + Just next -> + Button.raised + (Button.config |> Button.setOnClick next) + "Next" + + Nothing -> + text "" + ) ] ] Nothing -> - text "Question not found" + text "Question not found" Nothing -> Html.div demoContent [ text "Nothing to do!" ] - ] + ] } @@ -248,41 +261,59 @@ viewQuestion db qid question mbAnswer model = ] ) in - Keyed.column [width fill, height fill] [ - ( "title", Element.el [ width fill, height fill] <| Element.el [Element.centerX, Element.centerY {-Background.color (Element.rgb 0.8 0.8 0.8)-},padding 32] <| Element.paragraph [Font.size 32] [Element.text question.text] ) - ,("edit", Keyed.row [width fill, height fill] [ - ("padleft", Element.el [width fill] <| Element.none) - , (unbox qid, Element.el [ width fill, height fill] <| Element.el [Element.centerY, width fill] <| (case mbit of - Nothing -> - Element.html <| text "Undefined input type" - Just (ShortAnswer s) -> - Element.html <| TextField.filled - (TextField.config - |> TextField.setLabel s.label - |> TextField.setValue mbvalue - |> TextField.setPlaceholder s.placeholder - |> TextField.setOnInput tonInput - --|> TextField.setMaxLength s.maxLength - --|> TextField.setMinLength s.minLength - ) - - - - Just (LongAnswer l) -> - Element.html <| TextArea.filled - (TextArea.config - |> TextArea.setLabel l.label - |> TextArea.setValue mbvalue - |> TextArea.setOnInput tonInput - |> TextArea.setRows l.rows - |> TextArea.setCols l.cols - ) - - - Just (List _) -> - Element.text "List Answer" - )) - , ("padright", Element.el [width fill] <| Element.none)])] + Keyed.column [ width fill, height fill ] + [ ( "title" + , Element.el [ width fill, height fill ] <| + Element.el + [ Element.centerX + , Element.centerY + + {- Background.color (Element.rgb 0.8 0.8 0.8) -} + , padding 32 + ] + <| + Element.paragraph [ Font.size 32 ] [ Element.text question.text ] + ) + , ( "edit" + , Keyed.row [ width fill, height fill ] + [ ( "padleft", Element.el [ width fill ] <| Element.none ) + , ( unbox qid + , Element.el [ width fill, height fill ] <| + Element.el [ Element.centerY, width fill ] <| + case mbit of + Nothing -> + Element.html <| text "Undefined input type" + + Just (ShortAnswer s) -> + Element.html <| + TextField.filled + (TextField.config + |> TextField.setLabel s.label + |> TextField.setValue mbvalue + |> TextField.setPlaceholder s.placeholder + |> TextField.setOnInput tonInput + --|> TextField.setMaxLength s.maxLength + --|> TextField.setMinLength s.minLength + ) + + Just (LongAnswer l) -> + Element.html <| + TextArea.filled + (TextArea.config + |> TextArea.setLabel l.label + |> TextArea.setValue mbvalue + |> TextArea.setOnInput tonInput + |> TextArea.setRows l.rows + |> TextArea.setCols l.cols + ) + + Just (List _) -> + Element.text "List Answer" + ) + , ( "padright", Element.el [ width fill ] <| Element.none ) + ] + ) + ] type alias RelatedData = @@ -318,7 +349,7 @@ relatedData db model = |> List.map (List.sortBy (\( _, val ) -> val.created)) |> List.filterMap List.Extra.last |> List.sortBy (\( _, val ) -> val.accessed) - |> List.map (\(a, b) -> (box a, b)) + |> List.map (\( a, b ) -> ( box a, b )) qids_present = List.map (\( _, val ) -> val.value.question) answers @@ -342,7 +373,6 @@ relatedData db model = currentAnswer = answerFromId currentQuestion - curID : Maybe Int curID = @@ -361,7 +391,7 @@ relatedData db model = prevAnswer = answerFromId prevID - getMsg : Maybe (Id Db.Question String) -> Maybe (Id Db.Answer String, Db.Answer) -> Maybe (Msg.Msg) + getMsg : Maybe (Id Db.Question String) -> Maybe ( Id Db.Answer String, Db.Answer ) -> Maybe Msg.Msg getMsg id answer = case answer of Just ( aid, _ ) -> diff --git a/src/Page/Code.elm b/src/Page/Code.elm index 49c41fd..e4a699c 100644 --- a/src/Page/Code.elm +++ b/src/Page/Code.elm @@ -1,13 +1,14 @@ -module Page.Code exposing (..) +module Page.Code exposing (CodingAnswerTemplate, Model, demoContent, init, page, toTitle, update, view, viewCodingQuestion) + +--import Html.Keyed as Keyed import Dict -import Element exposing (fill, height, width, px, padding ) -import Element.Font as Font +import Element exposing (fill, height, padding, px, width) import Element.Background as Background +import Element.Font as Font +import Element.Keyed as Keyed import Html exposing (text) import Html.Attributes exposing (style) ---import Html.Keyed as Keyed -import Element.Keyed as Keyed import List.Extra import Material.Button as Button exposing (config) import Material.TextArea as TextArea @@ -15,146 +16,166 @@ import Material.TextField as TextField import Msg import Page exposing (Page(..)) import Session -import Type.Database as Db +import Type.Database as Db exposing (Answer) import Type.Database.InputType exposing (InputType(..)) import Type.Database.TypeMatching as Match -import Type.IO.Setter as Updater import Type.IO.Internal as Id exposing (Id, box, unbox) -import Viewer exposing (detailsConfig) +import Type.IO.Setter as Updater import Url.Parser as Parser exposing (()) import Url.Parser.Query as Query -import Type.Database exposing (Answer) +import Viewer exposing (detailsConfig) type alias Model = { id : Id Db.Study String - , templates : List (CodingAnswerTemplate) - , answer : Maybe (Id Db.CodingAnswer String, Db.Timestamp Db.CodingAnswer) --- , answers : List (String, Db.Timestamp Db.CodingAnswer) - , current : Maybe (CodingAnswerTemplate) - , currentEmpty : Maybe (Id Answer String, Id Db.CodingQuestion String) - , previous : Maybe (Msg.Msg) - , next : Maybe (Msg.Msg) + , templates : List CodingAnswerTemplate + , answer : Maybe ( Id Db.CodingAnswer String, Db.Timestamp Db.CodingAnswer ) + + -- , answers : List (String, Db.Timestamp Db.CodingAnswer) + , current : Maybe CodingAnswerTemplate + , currentEmpty : Maybe ( Id Answer String, Id Db.CodingQuestion String ) + , previous : Maybe Msg.Msg + , next : Maybe Msg.Msg } + type alias CodingAnswerTemplate = - { - answerId : Id Db.Answer String - , answer : Db.Timestamp Db.Answer - , questionId : Id Db.Question String - , question : Db.Timestamp Db.Question - , coding_questionId : Id Db.CodingQuestion String - , coding_question : Db.Timestamp Db.CodingQuestion - , input_typeId : Id InputType String - , input_type : Db.Timestamp InputType + { answerId : Id Db.Answer String + , answer : Db.Timestamp Db.Answer + , questionId : Id Db.Question String + , question : Db.Timestamp Db.Question + , coding_questionId : Id Db.CodingQuestion String + , coding_question : Db.Timestamp Db.CodingQuestion + , input_typeId : Id InputType String + , input_type : Db.Timestamp InputType } + init : Id Db.Study String -> Db.Database -> Model init id db = let - question2codingQuestionary : (Id Db.Question String, Db.Timestamp Db.Question ) -> List (Id Db.CodingQuestionary String, Db.Timestamp Db.CodingQuestionary) - question2codingQuestionary (qid, value ) = + question2codingQuestionary : ( Id Db.Question String, Db.Timestamp Db.Question ) -> List ( Id Db.CodingQuestionary String, Db.Timestamp Db.CodingQuestionary ) + question2codingQuestionary ( qid, value ) = Dict.filter (\cid cq -> cq.value.question == qid) db.coding_questionnaries - |> Dict.toList - |> List.map (\(cid, other) -> (box cid, other)) - codingQuestionary2codingQuestion : (Id Db.CodingQuestionary String, Db.Timestamp Db.CodingQuestionary ) -> List (Id Db.CodingQuestion String, Db.Timestamp Db.CodingQuestion) - codingQuestionary2codingQuestion (qid, value) = + |> Dict.toList + |> List.map (\( cid, other ) -> ( box cid, other )) + + codingQuestionary2codingQuestion : ( Id Db.CodingQuestionary String, Db.Timestamp Db.CodingQuestionary ) -> List ( Id Db.CodingQuestion String, Db.Timestamp Db.CodingQuestion ) + codingQuestionary2codingQuestion ( qid, value ) = Dict.filter (\cid cq -> cq.value.coding_questionary == qid) db.coding_questions - |> Dict.toList - |> List.map (\(cid, other) -> (box cid, other)) - codingQuestion2input_type (qid, value) = + |> Dict.toList + |> List.map (\( cid, other ) -> ( box cid, other )) + + codingQuestion2input_type ( qid, value ) = Dict.filter (\itid it -> value.value.input_type == box itid) db.input_types - |> Dict.toList - |> List.map (\(itid, other) -> (box itid, other)) - - answers = Dict.filter (\eid event -> event.value.study == id) db.events - |> Dict.toList - |> List.map (\(eid,event) -> (box eid, event)) - |> List.map (\(eid,event) -> Dict.filter (\aid answer -> answer.value.event == eid) db.answers) - |> List.map (Dict.toList) - |> List.concat - all_coding_answers = List.map (\(answer_id,answer) -> ((box answer_id, answer),Dict.filter (\question_id question -> answer.value.question == box question_id) db.questions )) answers - |> List.map (\(answer, questiondict)-> (answer, Dict.toList questiondict)) - |> List.map (\(answer, questions) -> List.map (\question -> (answer,question)) questions) - |> List.concat - |> List.map (\(a,(b,c))-> (a,(box b,c))) - |> List.map (\(answer, question) -> (answer, question, question2codingQuestionary question )) - |> List.map (\(answer, question, codingQuestionnaries) -> List.map (\codingQuestionary -> (answer,question,codingQuestionary)) codingQuestionnaries ) - |> List.concat - |> List.map (\(answer, question, questionary) -> (answer, question, codingQuestionary2codingQuestion questionary )) - |> List.map (\(answer, question, codingQuestions) -> List.map (\codingQuestion -> (answer,question,codingQuestion)) codingQuestions ) - |> List.concat - |> List.map (\(a,b,c)-> (a,b,c)) - |> List.map (\(a, q, c) -> (a, q, (c,codingQuestion2input_type c ))) - |> List.map (\(a, q, (c,cl))->List.map (\cs -> (a, q, (c,cs))) cl) - |> List.concat - |> List.map (\(answer, question, (coding_question, input_type)) -> - {answer = answer - , question = question - , coding_question = coding_question - , input_type = input_type}) - all_relevant_keys : List (Id Answer String, Id Db.CodingQuestion String) - all_relevant_keys = List.map (\{answer,coding_question} -> (answer, coding_question)) all_coding_answers - |> List.map (\((aid,_),(cqid,_))-> (aid, cqid)) - present_coding_answers : List (Id Db.CodingAnswer String, Db.Timestamp Db.CodingAnswer) - present_coding_answers = Dict.filter (\cai cav -> List.member (cav.value.answer, cav.value.coding_question) all_relevant_keys) db.coding_answers - |> Dict.toList - |> List.sortBy (\(_,cav) -> cav.accessed) - |> List.map (\(cai,cav) -> (box cai, cav)) - history : List (Id Db.CodingAnswer String, Db.Timestamp Db.CodingAnswer) - history = List.sortBy (\(_,cav) -> cav.created) present_coding_answers - templates = List.map (\{answer,question, coding_question,input_type} -> - CodingAnswerTemplate - (Tuple.first answer) - (Tuple.second answer) - (Tuple.first question) - (Tuple.second question) - (Tuple.first coding_question) - (Tuple.second coding_question) - (Tuple.first input_type) - (Tuple.second input_type) - ) all_coding_answers - qids_missing : List (Id Answer String, Id Db.CodingQuestion String) + |> Dict.toList + |> List.map (\( itid, other ) -> ( box itid, other )) + + answers = + Dict.filter (\eid event -> event.value.study == id) db.events + |> Dict.toList + |> List.map (\( eid, event ) -> ( box eid, event )) + |> List.map (\( eid, event ) -> Dict.filter (\aid answer -> answer.value.event == eid) db.answers) + |> List.map Dict.toList + |> List.concat + + all_coding_answers = + List.map (\( answer_id, answer ) -> ( ( box answer_id, answer ), Dict.filter (\question_id question -> answer.value.question == box question_id) db.questions )) answers + |> List.map (\( answer, questiondict ) -> ( answer, Dict.toList questiondict )) + |> List.map (\( answer, questions ) -> List.map (\question -> ( answer, question )) questions) + |> List.concat + |> List.map (\( a, ( b, c ) ) -> ( a, ( box b, c ) )) + |> List.map (\( answer, question ) -> ( answer, question, question2codingQuestionary question )) + |> List.map (\( answer, question, codingQuestionnaries ) -> List.map (\codingQuestionary -> ( answer, question, codingQuestionary )) codingQuestionnaries) + |> List.concat + |> List.map (\( answer, question, questionary ) -> ( answer, question, codingQuestionary2codingQuestion questionary )) + |> List.map (\( answer, question, codingQuestions ) -> List.map (\codingQuestion -> ( answer, question, codingQuestion )) codingQuestions) + |> List.concat + |> List.map (\( a, b, c ) -> ( a, b, c )) + |> List.map (\( a, q, c ) -> ( a, q, ( c, codingQuestion2input_type c ) )) + |> List.map (\( a, q, ( c, cl ) ) -> List.map (\cs -> ( a, q, ( c, cs ) )) cl) + |> List.concat + |> List.map + (\( answer, question, ( coding_question, input_type ) ) -> + { answer = answer + , question = question + , coding_question = coding_question + , input_type = input_type + } + ) + + all_relevant_keys : List ( Id Answer String, Id Db.CodingQuestion String ) + all_relevant_keys = + List.map (\{ answer, coding_question } -> ( answer, coding_question )) all_coding_answers + |> List.map (\( ( aid, _ ), ( cqid, _ ) ) -> ( aid, cqid )) + + present_coding_answers : List ( Id Db.CodingAnswer String, Db.Timestamp Db.CodingAnswer ) + present_coding_answers = + Dict.filter (\cai cav -> List.member ( cav.value.answer, cav.value.coding_question ) all_relevant_keys) db.coding_answers + |> Dict.toList + |> List.sortBy (\( _, cav ) -> cav.accessed) + |> List.map (\( cai, cav ) -> ( box cai, cav )) + + history : List ( Id Db.CodingAnswer String, Db.Timestamp Db.CodingAnswer ) + history = + List.sortBy (\( _, cav ) -> cav.created) present_coding_answers + + templates = + List.map + (\{ answer, question, coding_question, input_type } -> + CodingAnswerTemplate + (Tuple.first answer) + (Tuple.second answer) + (Tuple.first question) + (Tuple.second question) + (Tuple.first coding_question) + (Tuple.second coding_question) + (Tuple.first input_type) + (Tuple.second input_type) + ) + all_coding_answers + + qids_missing : List ( Id Answer String, Id Db.CodingQuestion String ) qids_missing = - List.filter (\(answerid,coding_questionid) -> not <| List.member (answerid, coding_questionid) (List.map (\(_,ca) -> (ca.value.answer,ca.value.coding_question)) present_coding_answers)) all_relevant_keys - - currentAnswer : Maybe (Id Db.CodingAnswer String, Db.Timestamp Db.CodingAnswer) + List.filter (\( answerid, coding_questionid ) -> not <| List.member ( answerid, coding_questionid ) (List.map (\( _, ca ) -> ( ca.value.answer, ca.value.coding_question )) present_coding_answers)) all_relevant_keys + + currentAnswer : Maybe ( Id Db.CodingAnswer String, Db.Timestamp Db.CodingAnswer ) currentAnswer = List.Extra.last present_coding_answers - + currentQuestion : Maybe CodingAnswerTemplate currentQuestion = - case currentAnswer of - Just (caid, cav) -> - templates - |> List.filter (\{coding_questionId} -> coding_questionId == cav.value.coding_question) - |> List.filter (\{answerId} -> answerId == cav.value.answer) - |> List.head + case currentAnswer of + Just ( caid, cav ) -> + templates + |> List.filter (\{ coding_questionId } -> coding_questionId == cav.value.coding_question) + |> List.filter (\{ answerId } -> answerId == cav.value.answer) + |> List.head + Nothing -> Nothing - + curID = Maybe.andThen (\x -> List.Extra.elemIndex x history) currentAnswer - next : Maybe (Id Db.CodingAnswer String, Db.Timestamp Db.CodingAnswer) + next : Maybe ( Id Db.CodingAnswer String, Db.Timestamp Db.CodingAnswer ) next = Maybe.andThen (\x -> List.Extra.getAt (x + 1) history) curID - previous : Maybe (Id Db.CodingAnswer String, Db.Timestamp Db.CodingAnswer) + previous : Maybe ( Id Db.CodingAnswer String, Db.Timestamp Db.CodingAnswer ) previous = Maybe.andThen (\x -> List.Extra.getAt (x - 1) history) curID getMsg answer = case answer of - Just (aid,_) -> + Just ( aid, _ ) -> Just (Msg.CRUD <| Msg.Access Db.CodingAnswerType (unbox aid)) Nothing -> case List.head qids_missing of - Just (answerid, coding_questionid) -> + Just ( answerid, coding_questionid ) -> Just - ( - Msg.CRUD + (Msg.CRUD (Msg.CreateRandom Db.CodingAnswerType [ \canswerid -> Match.setField @@ -174,14 +195,13 @@ init id db = } ] ) - ) + ) + Nothing -> Nothing - - - in - Model id templates currentAnswer currentQuestion (List.head qids_missing) (getMsg previous) (getMsg next) + Model id templates currentAnswer currentQuestion (List.head qids_missing) (getMsg previous) (getMsg next) + -- INIT @@ -196,20 +216,16 @@ page session id = , view = view , toMsg = identity , subscriptions = Sub.none + -- , header = Viewer.header , update = update -- , update = Page.liftupdate update } - - in - ( Page model, Cmd.none ) - - update : Msg.Msg -> Page.Page Model Msg.Msg -> ( Page.Page Model Msg.Msg, Cmd Msg.Msg ) update message (Page model) = ( Page model, Cmd.none ) @@ -218,104 +234,117 @@ update message (Page model) = view : Page Model Msg.Msg -> Viewer.Details Msg.Msg view (Page.Page pageM) = let - db = session.db - model = pageM.page - session = pageM.session - viewportHeight = session.windowSize.height - - in + + model = + pageM.page + + session = + pageM.session + + viewportHeight = + session.windowSize.height + in { detailsConfig | title = toTitle model , user = session.user , body = - \_ -> [ - case model.current of - Just (current) -> - - - Element.layout [ height <| px <| viewportHeight - 48, padding 24] <| - Element.column [height fill, width fill] - [ Element.el [ height fill, width fill ] <| viewCodingQuestion db current.coding_questionId current.coding_question model.answer current.answerId model current.answer - , Element.row [ Element.alignBottom, width fill] - [ Element.el [Element.alignLeft] <| Element.html - (case model.previous of - Just prev -> - Button.raised - (Button.config |> Button.setOnClick prev) - "Previous" - - Nothing -> - text "" - ) - , Element.el [ Element.centerX, width fill ] (Element.text "") - , Element.el [ Element.alignRight] <| Element.html - (case model.next of - Just next -> - Button.raised - (Button.config |> Button.setOnClick next) - "Next" - - Nothing -> - text "" - ) - ] - ] - - + \_ -> + [ case model.current of + Just current -> + Element.layout [ height <| px <| viewportHeight - 48, padding 24 ] <| + Element.column [ height fill, width fill ] + [ Element.el [ height fill, width fill ] <| viewCodingQuestion db current.coding_questionId current.coding_question model.answer current.answerId model current.answer + , Element.row [ Element.alignBottom, width fill ] + [ Element.el [ Element.alignLeft ] <| + Element.html + (case model.previous of + Just prev -> + Button.raised + (Button.config |> Button.setOnClick prev) + "Previous" + + Nothing -> + text "" + ) + , Element.el [ Element.centerX, width fill ] (Element.text "") + , Element.el [ Element.alignRight ] <| + Element.html + (case model.next of + Just next -> + Button.raised + (Button.config |> Button.setOnClick next) + "Next" + + Nothing -> + text "" + ) + ] + ] Nothing -> case model.currentEmpty of - Just (answerid, coding_questionid) -> + Just ( answerid, coding_questionid ) -> let - mbcoding_question = Dict.get (unbox coding_questionid) db.coding_questions - mbinput_type = Maybe.map (\x -> Dict.get (unbox x.value.input_type) db.input_types) mbcoding_question - mbanswer = Dict.get (unbox answerid) db.answers + mbcoding_question = + Dict.get (unbox coding_questionid) db.coding_questions + + mbinput_type = + Maybe.map (\x -> Dict.get (unbox x.value.input_type) db.input_types) mbcoding_question + + mbanswer = + Dict.get (unbox answerid) db.answers in - case (mbinput_type, mbanswer, mbcoding_question) of - (Just input_type, Just answer, Just coding_question) -> - Element.layout [ height <| px <| viewportHeight - 48, padding 24] <| - Element.column [height fill, width fill] - [ Element.el [ height fill, width fill ] <| viewCodingQuestion db coding_questionid coding_question Nothing answerid model answer - , Element.row [ Element.alignBottom, width fill] - [ Element.el [Element.alignLeft] <| Element.html - (case model.previous of - Just prev -> - Button.raised - (Button.config |> Button.setOnClick prev) - "Previous" - - Nothing -> - text "" - ) - , Element.el [ Element.centerX, width fill ] (Element.text "") - , Element.el [ Element.alignRight] <| Element.html - (case model.next of - Just next -> - Button.raised - (Button.config |> Button.setOnClick next) - "Next" - - Nothing -> - text "" - ) + case ( mbinput_type, mbanswer, mbcoding_question ) of + ( Just input_type, Just answer, Just coding_question ) -> + Element.layout [ height <| px <| viewportHeight - 48, padding 24 ] <| + Element.column [ height fill, width fill ] + [ Element.el [ height fill, width fill ] <| viewCodingQuestion db coding_questionid coding_question Nothing answerid model answer + , Element.row [ Element.alignBottom, width fill ] + [ Element.el [ Element.alignLeft ] <| + Element.html + (case model.previous of + Just prev -> + Button.raised + (Button.config |> Button.setOnClick prev) + "Previous" + + Nothing -> + text "" + ) + , Element.el [ Element.centerX, width fill ] (Element.text "") + , Element.el [ Element.alignRight ] <| + Element.html + (case model.next of + Just next -> + Button.raised + (Button.config |> Button.setOnClick next) + "Next" + + Nothing -> + text "" + ) + ] ] - ] + _ -> text "I failed to start." - Nothing -> + + Nothing -> Html.div demoContent [ text "Nothing to do!" ] - ] + ] } viewCodingQuestion : Db.Database -> Id Db.CodingQuestion String -> Db.Timestamp Db.CodingQuestion -> Maybe ( Id Db.CodingAnswer String, Db.Timestamp Db.CodingAnswer ) -> Id Db.Answer String -> Model -> Db.Timestamp Db.Answer -> Element.Element Msg.Msg viewCodingQuestion db qid tquestion mbAnswer anid model answer = let - question = tquestion.value + question = + tquestion.value + mbit = Dict.get (unbox question.input_type) db.input_types |> Maybe.map (\x -> x.value) @@ -350,7 +379,6 @@ viewCodingQuestion db qid tquestion mbAnswer anid model answer = , id = box answerid , value = unbox qid } - , \answerid -> Match.setField { kind = Db.CodingAnswerType @@ -370,45 +398,71 @@ viewCodingQuestion db qid tquestion mbAnswer anid model answer = ] ) in - Keyed.column [width fill, height fill] [ - ( "title", Element.el [ width fill, height fill] <| Element.el [Element.centerX, Element.centerY {-Background.color (Element.rgb 0.8 0.8 0.8)-},padding 32] <| Element.paragraph [Font.size 32] [Element.text question.text] ) - , ("answer",Element.el [ width fill, height fill] <| Element.el [Element.centerX, Element.centerY {-Background.color (Element.rgb 0.8 0.8 0.8)-},padding 32] <| Element.paragraph [Font.size 32] [Element.text answer.value.value]) - ,("edit", Keyed.row [width fill, height fill] [ - ("padleft", Element.el [width fill] <| Element.none) - , (unbox qid, Element.el [ width fill, height fill] <| Element.el [Element.centerY, width fill] <| (case mbit of - Nothing -> - Element.html <| text "Undefined input type" - Just (ShortAnswer s) -> - Element.html <| TextField.filled - (TextField.config - |> TextField.setLabel s.label - |> TextField.setValue mbvalue - |> TextField.setPlaceholder s.placeholder - |> TextField.setOnInput tonInput - --|> TextField.setMaxLength s.maxLength - --|> TextField.setMinLength s.minLength - ) - - - - Just (LongAnswer l) -> - Element.html <| TextArea.filled - (TextArea.config - |> TextArea.setLabel l.label - |> TextArea.setValue mbvalue - |> TextArea.setOnInput tonInput - |> TextArea.setRows l.rows - |> TextArea.setCols l.cols - ) - - - Just (List _) -> - Element.text "List Answer" - )) - , ("padright", Element.el [width fill] <| Element.none)])] - - - + Keyed.column [ width fill, height fill ] + [ ( "title" + , Element.el [ width fill, height fill ] <| + Element.el + [ Element.centerX + , Element.centerY + + {- Background.color (Element.rgb 0.8 0.8 0.8) -} + , padding 32 + ] + <| + Element.paragraph [ Font.size 32 ] [ Element.text question.text ] + ) + , ( "answer" + , Element.el [ width fill, height fill ] <| + Element.el + [ Element.centerX + , Element.centerY + + {- Background.color (Element.rgb 0.8 0.8 0.8) -} + , padding 32 + ] + <| + Element.paragraph [ Font.size 32 ] [ Element.text answer.value.value ] + ) + , ( "edit" + , Keyed.row [ width fill, height fill ] + [ ( "padleft", Element.el [ width fill ] <| Element.none ) + , ( unbox qid + , Element.el [ width fill, height fill ] <| + Element.el [ Element.centerY, width fill ] <| + case mbit of + Nothing -> + Element.html <| text "Undefined input type" + + Just (ShortAnswer s) -> + Element.html <| + TextField.filled + (TextField.config + |> TextField.setLabel s.label + |> TextField.setValue mbvalue + |> TextField.setPlaceholder s.placeholder + |> TextField.setOnInput tonInput + --|> TextField.setMaxLength s.maxLength + --|> TextField.setMinLength s.minLength + ) + + Just (LongAnswer l) -> + Element.html <| + TextArea.filled + (TextArea.config + |> TextArea.setLabel l.label + |> TextArea.setValue mbvalue + |> TextArea.setOnInput tonInput + |> TextArea.setRows l.rows + |> TextArea.setCols l.cols + ) + + Just (List _) -> + Element.text "List Answer" + ) + , ( "padright", Element.el [ width fill ] <| Element.none ) + ] + ) + ] demoContent : List (Html.Attribute msg) diff --git a/src/Page/CodingQuestion.elm b/src/Page/CodingQuestion.elm index 1e770d6..fc496bd 100644 --- a/src/Page/CodingQuestion.elm +++ b/src/Page/CodingQuestion.elm @@ -1,17 +1,17 @@ -module Page.CodingQuestion exposing (..) +module Page.CodingQuestion exposing (Model, RelatedData, init, page, relatedData, toTitle, update, view, viewInputTypeSelection, viewSettings) import Dict import Html exposing (Html, p, text) +import Material.Button as Button import Material.FormField as FormField import Material.LayoutGrid exposing (cell, inner, layoutGrid) +import Material.List as List +import Material.List.Item as ListItem exposing (ListItem) import Material.Radio as Radio import Material.Slider as Slider -import Material.TextField as TextField import Material.Switch as Switch +import Material.TextField as TextField import Material.Typography as Typography exposing (typography) -import Material.List as List -import Material.List.Item as ListItem exposing (ListItem) -import Material.Button as Button import Maybe.Extra import Msg import Page exposing (Page(..)) @@ -20,13 +20,13 @@ import Time exposing (Posix) import Type.Database as Db import Type.Database.InputType as IT import Type.Database.TypeMatching as Match -import Type.IO.Setter as Updater import Type.IO.Internal as Id exposing (Id, box, unbox) +import Type.IO.Setter as Updater import Viewer exposing (detailsConfig) type alias Model = - { id : (Id Db.Question String) + { id : Id Db.Question String , question : Maybe (Db.Timestamp Db.CodingQuestion) , short : Maybe (Id IT.InputType String) , long : Maybe (Id IT.InputType String) @@ -45,10 +45,7 @@ init db id = Nothing Nothing Nothing - - - - + q = Dict.get (unbox id) db.coding_questions |> Maybe.map .value @@ -84,6 +81,7 @@ page session id = , view = view , toMsg = identity , subscriptions = Sub.none + -- , header = Viewer.header , update = update @@ -204,8 +202,6 @@ view (Page.Page model) = mbInfos = relatedData model.page.id db - - in { detailsConfig | title = toTitle model.page @@ -245,7 +241,7 @@ view (Page.Page model) = ) ] ++ viewInputTypeSelection model.page infos.input_type - , cell [] <| viewSettings model.session.db model.page.id model.page infos.input_type + , cell [] <| viewSettings model.session.db model.page.id model.page infos.input_type ] ] @@ -282,9 +278,8 @@ relatedData id db = coding_questions = {- List.sortBy (\( _, y ) -> y.index) <| -} Dict.toList db.coding_questionnaries - |> List.filter (\( _, y ) -> y.value.question == id) - |> List.map (\( x, y ) -> ( box x, y.value )) - + |> List.filter (\( _, y ) -> y.value.question == id) + |> List.map (\( x, y ) -> ( box x, y.value )) question = timestampedQuestion.value @@ -514,7 +509,6 @@ viewInputTypeSelection model ( id, _ ) = ] - viewSettings : Db.Database -> Id Db.Question String -> Model -> ( Id IT.InputType String, Maybe IT.InputType ) -> List (Html Msg.Msg) viewSettings db id model ( itid, mbit ) = let @@ -586,10 +580,14 @@ viewSettings db id model ( itid, mbit ) = [ text <| "Min Length: " ++ (Maybe.withDefault "0" <| Maybe.map String.fromInt short.minLength) , Slider.slider (Slider.config - |> (\x -> - case (Maybe.map toFloat short.minLength) of - Just length -> Slider.setValue length x - Nothing -> x) + |> (\x -> + case Maybe.map toFloat short.minLength of + Just length -> + Slider.setValue length x + + Nothing -> + x + ) -- |> Slider.setMax (Maybe.map toFloat short.maxLength) |> Slider.setOnInput (\x -> @@ -607,10 +605,14 @@ viewSettings db id model ( itid, mbit ) = [ text <| "Max Length: " ++ (Maybe.withDefault "100" <| Maybe.map String.fromInt short.maxLength) , Slider.slider (Slider.config - |> (\x -> - case (Maybe.map toFloat short.maxLength) of - Just length -> Slider.setValue length x - Nothing -> x) + |> (\x -> + case Maybe.map toFloat short.maxLength of + Just length -> + Slider.setValue length x + + Nothing -> + x + ) -- |> Slider.setMin (Maybe.map toFloat short.minLength) |> Slider.setOnInput (\x -> @@ -629,9 +631,8 @@ viewSettings db id model ( itid, mbit ) = _ -> [ text "No Config found" ] - else - if model.long == Just itid then - case Maybe.map .value <| Maybe.andThen (\x -> Dict.get (unbox x) db.input_types) model.long of + else if model.long == Just itid then + case Maybe.map .value <| Maybe.andThen (\x -> Dict.get (unbox x) db.input_types) model.long of Just (IT.LongAnswer long) -> [ TextField.filled (TextField.config @@ -682,11 +683,14 @@ viewSettings db id model ( itid, mbit ) = [ text <| "Min Length: " ++ (Maybe.withDefault "0" <| Maybe.map String.fromInt long.minLength) , Slider.slider (Slider.config - |> (\x -> - case (Maybe.map toFloat long.minLength) of - Just length -> Slider.setValue length x - Nothing -> x) - + |> (\x -> + case Maybe.map toFloat long.minLength of + Just length -> + Slider.setValue length x + + Nothing -> + x + ) -- |> Slider.setMax (Maybe.map toFloat short.maxLength) |> Slider.setOnInput (\x -> @@ -704,10 +708,14 @@ viewSettings db id model ( itid, mbit ) = [ text <| "Max Length: " ++ (Maybe.withDefault "100" <| Maybe.map String.fromInt long.maxLength) , Slider.slider (Slider.config - |> (\x -> - case (Maybe.map toFloat long.maxLength) of - Just length -> Slider.setValue length x - Nothing -> x) + |> (\x -> + case Maybe.map toFloat long.maxLength of + Just length -> + Slider.setValue length x + + Nothing -> + x + ) -- |> Slider.setMin (Maybe.map toFloat short.minLength) |> Slider.setOnInput (\x -> @@ -725,24 +733,25 @@ viewSettings db id model ( itid, mbit ) = _ -> [ text "No Config found" ] - else - if model.list == Just itid then - case Maybe.map .value <| Maybe.andThen (\x -> Dict.get (unbox x) db.input_types) model.list of - Just (IT.List list) -> - [ text "Boxes or Radio?" - , FormField.formField - (FormField.config - |> FormField.setLabel (Just "Radio Button") - ) - [ Radio.radio Radio.config ] - , FormField.formField - (FormField.config - |> FormField.setLabel (Just "Checkbox") - ) - [ Radio.radio Radio.config ] - ] - _ -> - [ text "No Config found"] - else - [text "You have not selected an Input type yet." ] + else if model.list == Just itid then + case Maybe.map .value <| Maybe.andThen (\x -> Dict.get (unbox x) db.input_types) model.list of + Just (IT.List list) -> + [ text "Boxes or Radio?" + , FormField.formField + (FormField.config + |> FormField.setLabel (Just "Radio Button") + ) + [ Radio.radio Radio.config ] + , FormField.formField + (FormField.config + |> FormField.setLabel (Just "Checkbox") + ) + [ Radio.radio Radio.config ] + ] + + _ -> + [ text "No Config found" ] + + else + [ text "You have not selected an Input type yet." ] diff --git a/src/Page/Event.elm b/src/Page/Event.elm index 1778eb4..4b21773 100644 --- a/src/Page/Event.elm +++ b/src/Page/Event.elm @@ -2,31 +2,33 @@ module Page.Event exposing (Model, init, page, update, view) --import Browser -import Msg import Dict exposing (Dict) -import Html exposing (Html, text, div, p) -import Page exposing (Page(..)) -import Session +import Html exposing (Html, div, p, text) import Identicon exposing (identicon) -import Time exposing (Posix) -import Viewer exposing (detailsConfig) -import Material.LayoutGrid as LG exposing (layoutGrid, cell, inner) -import Material.Typography as Typography import Material.Button as Button exposing (unelevated) import Material.DataTable as DataTable -import Material.TabBar as TabBar -import Material.Tab as Tab import Material.Icon as Icon -import Type.Database as Db +import Material.LayoutGrid as LG exposing (cell, inner, layoutGrid) import Material.List as MList exposing (list) -import Material.List.Item as MLItem exposing (listItem, graphic) +import Material.List.Item as MLItem exposing (graphic, listItem) +import Material.Tab as Tab +import Material.TabBar as TabBar +import Material.Typography as Typography +import Msg +import Page exposing (Page(..)) +import Session +import Time exposing (Posix) +import Type.Database as Db import Type.Database.TypeMatching as Match -import Type.IO.Setter as Updater import Type.IO.Internal as Id exposing (Id, box, unbox) -import Viewer.EditableText as EditableText +import Type.IO.Setter as Updater import Url.Builder import Url.Parser as Parser exposing (()) import Url.Parser.Query as Query +import Viewer exposing (detailsConfig) +import Viewer.EditableText as EditableText + + {- This is a page with subpages. You can change the behaviour depending on the subpage path! @@ -40,6 +42,8 @@ type alias Model = , nameFocus : Bool } + + -- INIT @@ -57,6 +61,7 @@ page session subpage id focus = , view = view , toMsg = identity , subscriptions = Sub.none + -- , header = Viewer.header , update = update @@ -66,15 +71,15 @@ page session subpage id focus = ( Page model, Cmd.none ) + -- parser : Parser.Parser ((String -> Maybe Model) -> a) a -- parser = -- Parser.s "answer" (Parser.query <| --- Query.map2 +-- Query.map2 -- (\qid tsid -> (\eid -> Maybe.map2 Model qid tsid -- |> Maybe.map (\x -> x eid))) -- (Query.string "qid") -- (Query.string "tsid")) - -- UPDATE @@ -87,23 +92,29 @@ update message (Page model) = case msg_ of Msg.GetFocus -> let - old_page = model.page - new_page = {old_page | nameFocus = True} + old_page = + model.page + + new_page = + { old_page | nameFocus = True } in - - ( Page {model| page = new_page}, Cmd.none ) + ( Page { model | page = new_page }, Cmd.none ) + Msg.LooseFocus -> let - old_page = model.page - new_page = {old_page | nameFocus = False} + old_page = + model.page + + new_page = + { old_page | nameFocus = False } in - - ( Page {model| page = new_page}, Cmd.none ) - Msg.AnswerQuestions {questionary, test_subject, event} -> - (Page model, Cmd.none) - + ( Page { model | page = new_page }, Cmd.none ) + + Msg.AnswerQuestions { questionary, test_subject, event } -> + ( Page model, Cmd.none ) + Msg.EventSwitchTo _ -> - (Page model, Cmd.none) + ( Page model, Cmd.none ) _ -> ( Page model, Cmd.none ) @@ -116,294 +127,330 @@ update message (Page model) = view : Page Model Msg.Msg -> Viewer.Details Msg.Msg view (Page.Page model) = let - db = model.session.db - mbInfos = relatedData model.page.id db + db = + model.session.db + + mbInfos = + relatedData model.page.id db + econf = { active = model.page.nameFocus , activator = Msg.Event <| Msg.EventNameEdit Msg.GetFocus - , deactivator = \_ -> (Msg.Event <| Msg.EventNameEdit Msg.LooseFocus) - , callback = \z -> Match.setField - { kind = Db.EventType - , attribute = "name" - , setter = Updater.StringMsg - , id = model.page.id - , value = z - }} + , deactivator = \_ -> Msg.Event <| Msg.EventNameEdit Msg.LooseFocus + , callback = + \z -> + Match.setField + { kind = Db.EventType + , attribute = "name" + , setter = Updater.StringMsg + , id = model.page.id + , value = z + } + } in case mbInfos of Just infos -> { detailsConfig | title = infos.name , user = model.session.user - , actions = [("settings", Msg.FollowSubpage Db.EventType (unbox infos.id) ["settings"] [])] - , body =\_ -> - [ - {- TabBar.tabBar TabBar.config - [ Tab.tab - (Tab.config - |> Tab.setActive (model.page.page == Msg.EventOverview) - --|> Tab.setOnClick (TabClicked 0) - ) - { label = "Overview", icon = Just <| Tab.icon "poll"} - , Tab.tab - (Tab.config - |> Tab.setActive (model.page.page == Msg.EventPeople) - |> Tab.setOnClick (Msg.Event <| Msg.EventSwitchTo <| Msg.EventPeople) - ) - { label = "Participants", icon = Just <| Tab.icon "people" } - , Tab.tab - (Tab.config - |> Tab.setActive (model.page.page == Msg.EventSettings) - --|> Tab.setOnClick (TabClicked 1) - ) - { label = "Settings", icon = Just <| Tab.icon "settings" } - ] - -} - case model.page.page of + , actions = [ ( "settings", Msg.FollowSubpage Db.EventType (unbox infos.id) [ "settings" ] [] ) ] + , body = + \_ -> + [ {- TabBar.tabBar TabBar.config + [ Tab.tab + (Tab.config + |> Tab.setActive (model.page.page == Msg.EventOverview) + --|> Tab.setOnClick (TabClicked 0) + ) + { label = "Overview", icon = Just <| Tab.icon "poll"} + , Tab.tab + (Tab.config + |> Tab.setActive (model.page.page == Msg.EventPeople) + |> Tab.setOnClick (Msg.Event <| Msg.EventSwitchTo <| Msg.EventPeople) + ) + { label = "Participants", icon = Just <| Tab.icon "people" } + , Tab.tab + (Tab.config + |> Tab.setActive (model.page.page == Msg.EventSettings) + --|> Tab.setOnClick (TabClicked 1) + ) + { label = "Settings", icon = Just <| Tab.icon "settings" } + ] + -} + case model.page.page of Msg.EventSettings -> text "Settings:" - Msg.EventPeople -> - layoutGrid [Typography.typography] [ - inner [][ - cell [LG.span8Desktop] - [ Html.h1 [ Typography.headline5 ] [ text "Test Subjects" ] - , viewList infos.test_subjects (Msg.Follow Db.TestSubjectType) (\(x,_) -> String.toUpper <| String.left 4 (unbox x)) - , unelevated - (Button.config - |> Button.setIcon (Just <| Button.icon "add") - |> Button.setOnClick ( - --Just <| - Msg.CRUD <| - Msg.CreateRandom Db.TestSubjectType - [ \x -> - Match.setField - { kind = Db.TestSubjectType - , attribute = "event" - , setter = Updater.StringMsg - , id = box x - , value = unbox infos.id - } - ] - )) - "Add" + + Msg.EventPeople -> + layoutGrid [ Typography.typography ] + [ inner [] + [ cell [ LG.span8Desktop ] + [ Html.h1 [ Typography.headline5 ] [ text "Test Subjects" ] + , viewList infos.test_subjects (Msg.Follow Db.TestSubjectType) (\( x, _ ) -> String.toUpper <| String.left 4 (unbox x)) + , unelevated + (Button.config + |> Button.setIcon (Just <| Button.icon "add") + |> Button.setOnClick + --Just <| + (Msg.CRUD <| + Msg.CreateRandom Db.TestSubjectType + [ \x -> + Match.setField + { kind = Db.TestSubjectType + , attribute = "event" + , setter = Updater.StringMsg + , id = box x + , value = unbox infos.id + } + ] + ) + ) + "Add" + ] + ] ] - ]] + _ -> - layoutGrid [Typography.typography] [ - inner [][ - cell [][ - Html.h1 [ Typography.headline5 ] [ - EditableText.text + layoutGrid [ Typography.typography ] + [ inner [] + [ cell [] + [ Html.h1 [ Typography.headline5 ] + [ EditableText.text econf - [] - (Maybe.withDefault "" <| Maybe.map (\x -> x.value.name) <| Dict.get (unbox model.page.id) db.events)] - , p [][ text <| "Location:" ++ unbox infos.location] - , p [][ unelevated - (Button.config - |> Button.setIcon (Just <| Button.icon "add") - |> Button.setOnClick ( - --Just <| - Msg.CRUD <| - Msg.CreateRandom Db.TestSubjectType - [ \x -> - Match.setField - { kind = Db.TestSubjectType - , attribute = "event" - , setter = Updater.StringMsg - , id = box x - , value = unbox infos.id - } - ] - )) - "Add Subjects"] - + [] + (Maybe.withDefault "" <| Maybe.map (\x -> x.value.name) <| Dict.get (unbox model.page.id) db.events) + ] + , p [] [ text <| "Location:" ++ unbox infos.location ] + , p [] + [ unelevated + (Button.config + |> Button.setIcon (Just <| Button.icon "add") + |> Button.setOnClick + --Just <| + (Msg.CRUD <| + Msg.CreateRandom Db.TestSubjectType + [ \x -> + Match.setField + { kind = Db.TestSubjectType + , attribute = "event" + , setter = Updater.StringMsg + , id = box x + , value = unbox infos.id + } + ] + ) + ) + "Add Subjects" + ] + ] + + --, p [][ text <| "Leader: " ++ viewLeader infos.leader model.session.user] + {- , cell [] + [ Html.h1 [ Typography.headline5 ] [ text "Questionnaries" ] + , viewList + infos.questionnaries + (Msg.Follow Db.QuestionaryType) + (\(_,y) -> .name y) + , unelevated + (Button.config + |> Button.setIcon (Just <| Button.icon "add") + |> Button.setOnClick ( + --Just <| + Msg.CRUD <| + Msg.CreateRandom Db.QuestionaryType + [ \x -> + Match.setField + { kind = Db.QuestionaryType + , attribute = "study" + , setter = Updater.StringMsg + , id = x + , value = Tuple.first infos.study + } + ] + ) + ) + "Add"] + -} + , cell [] [ viewTable db infos.questionnaries infos.test_subjects infos.id ] + ] ] - --, p [][ text <| "Leader: " ++ viewLeader infos.leader model.session.user] - - {- , cell [] - [ Html.h1 [ Typography.headline5 ] [ text "Questionnaries" ] - , viewList - infos.questionnaries - (Msg.Follow Db.QuestionaryType) - (\(_,y) -> .name y) - , unelevated - (Button.config - |> Button.setIcon (Just <| Button.icon "add") - |> Button.setOnClick ( - --Just <| - Msg.CRUD <| - Msg.CreateRandom Db.QuestionaryType - [ \x -> - Match.setField - { kind = Db.QuestionaryType - , attribute = "study" - , setter = Updater.StringMsg - , id = x - , value = Tuple.first infos.study - } - ] - ) - ) - "Add"] -} - , cell [][viewTable db infos.questionnaries infos.test_subjects infos.id] - ]] - -- , layoutGridCell [][ - -- Html.h1 [ Typography.headline5 ] [ text "Events" ] - -- , viewList infos.events (Msg.Follow Db.EventType) - -- , unelevatedButton - -- {buttonConfig| icon = Just "add" - -- , onClick = Just <| - -- Msg.CRUD <| - -- Msg.CreateRandom Db.EventType [ - -- Match.setField Db.EventType "event" Updater.StringMsg infos.id - -- ] } - -- "Add" - -- ] - -- , layoutGridCell [][ - -- Html.h1 [ Typography.headline5 ] [ text "Questionnaries" ] - -- , viewList infos.questionnaries (Msg.Follow Db.QuestionaryType) - -- , unelevatedButton - -- {buttonConfig| icon = Just "add" - -- , onClick = Just <| - -- Msg.CRUD <| - -- Msg.CreateRandom Db.QuestionaryType [ - -- Match.setField Db.QuestionaryType "event" Updater.StringMsg infos.id - -- ] } - -- "Add" - -- ] - ] - - + + -- , layoutGridCell [][ + -- Html.h1 [ Typography.headline5 ] [ text "Events" ] + -- , viewList infos.events (Msg.Follow Db.EventType) + -- , unelevatedButton + -- {buttonConfig| icon = Just "add" + -- , onClick = Just <| + -- Msg.CRUD <| + -- Msg.CreateRandom Db.EventType [ + -- Match.setField Db.EventType "event" Updater.StringMsg infos.id + -- ] } + -- "Add" + -- ] + -- , layoutGridCell [][ + -- Html.h1 [ Typography.headline5 ] [ text "Questionnaries" ] + -- , viewList infos.questionnaries (Msg.Follow Db.QuestionaryType) + -- , unelevatedButton + -- {buttonConfig| icon = Just "add" + -- , onClick = Just <| + -- Msg.CRUD <| + -- Msg.CreateRandom Db.QuestionaryType [ + -- Match.setField Db.QuestionaryType "event" Updater.StringMsg infos.id + -- ] } + -- "Add" + -- ] + ] } - + Nothing -> { detailsConfig | title = toTitle model.page , user = model.session.user - , body = \_ -> - [ - layoutGrid [] [ - inner [][ - cell [][ - Html.h1 [ Typography.headline5 ] [ text <| "Event not Found: " ++ (unbox model.page.id) ] + , body = + \_ -> + [ layoutGrid [] + [ inner [] + [ cell [] + [ Html.h1 [ Typography.headline5 ] [ text <| "Event not Found: " ++ unbox model.page.id ] + ] ] ] ] - ] } - - - --- Todo: Add Events, Description, Leader, Name, Questionary + +-- Todo: Add Events, Description, Leader, Name, Questionary -- HELPERS + + type alias RelatedData = - { - id : Id Db.Event String, - name : String, - location : Id Db.Place String, - created : Posix, - creator : (Id Db.User String, Maybe Db.User), - updated : Posix, - study : (Id Db.Study String, Maybe Db.Study), - questionnaries : List (Id Db.Questionary String, Db.Questionary), - test_subjects : List (Id Db.TestSubject String, Db.TestSubject) + { id : Id Db.Event String + , name : String + , location : Id Db.Place String + , created : Posix + , creator : ( Id Db.User String, Maybe Db.User ) + , updated : Posix + , study : ( Id Db.Study String, Maybe Db.Study ) + , questionnaries : List ( Id Db.Questionary String, Db.Questionary ) + , test_subjects : List ( Id Db.TestSubject String, Db.TestSubject ) } + relatedData : Id Db.Event String -> Db.Database -> Maybe RelatedData relatedData id db = case Dict.get (unbox id) db.events of Just timestampedEvent -> let - event = timestampedEvent.value + event = + timestampedEvent.value in - Just - { - id = id, - name = event.name, - location = event.place, - study = (event.study, Maybe.map .value <| Dict.get (unbox event.study) db.studies), - created = Time.millisToPosix timestampedEvent.created, - creator = (timestampedEvent.creator, Maybe.map .value <| Dict.get (unbox timestampedEvent.creator) db.users), - updated = Time.millisToPosix timestampedEvent.modified, - questionnaries = List.map (Tuple.mapFirst box) <| Dict.toList <| Dict.map (\x y -> (y.value)) <| Dict.filter (\x y -> y.value.study == event.study) db.questionnaries, - test_subjects = List.map (Tuple.mapFirst box) <| Dict.toList <| Dict.map (\x y -> (y.value)) <| Dict.filter (\x y -> y.value.event == id) db.test_subjects - } - + Just + { id = id + , name = event.name + , location = event.place + , study = ( event.study, Maybe.map .value <| Dict.get (unbox event.study) db.studies ) + , created = Time.millisToPosix timestampedEvent.created + , creator = ( timestampedEvent.creator, Maybe.map .value <| Dict.get (unbox timestampedEvent.creator) db.users ) + , updated = Time.millisToPosix timestampedEvent.modified + , questionnaries = List.map (Tuple.mapFirst box) <| Dict.toList <| Dict.map (\x y -> y.value) <| Dict.filter (\x y -> y.value.study == event.study) db.questionnaries + , test_subjects = List.map (Tuple.mapFirst box) <| Dict.toList <| Dict.map (\x y -> y.value) <| Dict.filter (\x y -> y.value.event == id) db.test_subjects + } + Nothing -> Nothing -viewLeader : (String, Maybe Db.User) -> Maybe String -> String -viewLeader (id, mbLeader) cur = + +viewLeader : ( String, Maybe Db.User ) -> Maybe String -> String +viewLeader ( id, mbLeader ) cur = if Just id == cur then "You" + else Maybe.andThen .name mbLeader - |> Maybe.withDefault id + |> Maybe.withDefault id + + {- viewList : List (String, a) -> (String -> msg) -> Html msg -viewList elements onClick = - let - iList = List.map (\(x,_) -> - MLItem.listItem - (MLItem.config |> MLItem.setOnClick (onClick x)) - [ MLItem.graphic [] [ identicon "100%" x],text x ]) elements - in - case iList of - f :: r -> - list MList.config f r - _ -> - list MList.config - ( - MLItem.listItem MLItem.config [ text "Nothing here, create one?"] - ) - [] - -} -viewList : List ( Id a String, a ) -> (String -> msg) -> ((Id a String, a) -> String) -> Html msg + viewList elements onClick = + let + iList = List.map (\(x,_) -> + MLItem.listItem + (MLItem.config |> MLItem.setOnClick (onClick x)) + [ MLItem.graphic [] [ identicon "100%" x],text x ]) elements + in + case iList of + f :: r -> + list MList.config f r + _ -> + list MList.config + ( + MLItem.listItem MLItem.config [ text "Nothing here, create one?"] + ) + [] +-} + + +viewList : List ( Id a String, a ) -> (String -> msg) -> (( Id a String, a ) -> String) -> Html msg viewList elements onClick nameGetter = let - mlist = List.map (\( x, y ) -> listItem (MLItem.config |> MLItem.setOnClick (onClick (unbox x)) ) [ graphic [] [ identicon "100%" (unbox x) ], text <| nameGetter (x,y)]) elements + mlist = + List.map (\( x, y ) -> listItem (MLItem.config |> MLItem.setOnClick (onClick (unbox x))) [ graphic [] [ identicon "100%" (unbox x) ], text <| nameGetter ( x, y ) ]) elements in - case mlist of - f :: r -> - list MList.config f r - _ -> - list MList.config + case mlist of + f :: r -> + list MList.config f r + + _ -> + list MList.config + (listItem MLItem.config [ text "Nothing here, create one?" ]) + [] - (listItem MLItem.config [ text "Nothing here, create one?" ]) - [] -viewTable : Db.Database -> List (Id Db.Questionary String, Db.Questionary) -> List (Id Db.TestSubject String, Db.TestSubject) -> Id Db.Event String -> Html Msg.Msg +viewTable : Db.Database -> List ( Id Db.Questionary String, Db.Questionary ) -> List ( Id Db.TestSubject String, Db.TestSubject ) -> Id Db.Event String -> Html Msg.Msg viewTable db questionnaries test_subjects event_id = DataTable.dataTable DataTable.config { thead = [ DataTable.row [] <| - DataTable.cell [] [ text "Subject"] :: List.map (\(x,y) -> DataTable.cell [] [text y.name]) questionnaries - --[ DataTable.cell [] [ text "Desert" ] ] + DataTable.cell [] [ text "Subject" ] + :: List.map (\( x, y ) -> DataTable.cell [] [ text y.name ]) questionnaries + + --[ DataTable.cell [] [ text "Desert" ] ] ] , tbody = - List.map (\(test_subject_id,test_subject_value) -> - + List.map + (\( test_subject_id, test_subject_value ) -> DataTable.row [] <| - DataTable.cell [] [text <| String.toUpper <| String.left 4 (unbox test_subject_id)]::List.map (\(questionary_id, questionary_value) -> - DataTable.cell [] [ - let - answers = Dict.filter (\answer_id answer_table -> List.member (unbox answer_table.value.question) q_ids ) db.answers - |> Dict.filter (\answer_id answer_table -> answer_table.value.test_subject == test_subject_id) - |> Dict.toList - questions = Dict.filter (\question_id question_table -> question_table.value.questionary == questionary_id) db.questions - |> Dict.toList - q_ids = List.map (\(qid,_)-> qid) questions - in - Button.unelevated - (Button.config |> Button.setOnClick (Msg.FollowSubpage Db.EventType (unbox event_id) ["answer"] [Url.Builder.string "qid" (unbox questionary_id), Url.Builder.string "tsid" (unbox test_subject_id)]) ) <| (String.fromInt <| List.length answers) ++ "/" ++ (String.fromInt <| List.length questions) - ] - ) - questionnaries - ) test_subjects + DataTable.cell [] [ text <| String.toUpper <| String.left 4 (unbox test_subject_id) ] + :: List.map + (\( questionary_id, questionary_value ) -> + DataTable.cell [] + [ let + answers = + Dict.filter (\answer_id answer_table -> List.member (unbox answer_table.value.question) q_ids) db.answers + |> Dict.filter (\answer_id answer_table -> answer_table.value.test_subject == test_subject_id) + |> Dict.toList + + questions = + Dict.filter (\question_id question_table -> question_table.value.questionary == questionary_id) db.questions + |> Dict.toList + + q_ids = + List.map (\( qid, _ ) -> qid) questions + in + Button.unelevated + (Button.config |> Button.setOnClick (Msg.FollowSubpage Db.EventType (unbox event_id) [ "answer" ] [ Url.Builder.string "qid" (unbox questionary_id), Url.Builder.string "tsid" (unbox test_subject_id) ])) + <| + (String.fromInt <| List.length answers) + ++ "/" + ++ (String.fromInt <| List.length questions) + ] + ) + questionnaries + ) + test_subjects } - toTitle : Model -> String diff --git a/src/Page/NewPage.elm b/src/Page/NewPage.elm index f246086..dd18a96 100644 --- a/src/Page/NewPage.elm +++ b/src/Page/NewPage.elm @@ -47,10 +47,11 @@ update msg model = view : Model -> Viewer.Details Msg view model = { title = toTitle - , body = \_-> - [ h1 [] [ text "elm-spa-boilerplate - New Page" ] - , div [] [ text "A new page." ] - ] + , body = + \_ -> + [ h1 [] [ text "elm-spa-boilerplate - New Page" ] + , div [] [ text "A new page." ] + ] } diff --git a/src/Page/PageOne.elm b/src/Page/PageOne.elm index a4d7421..7d7c12d 100644 --- a/src/Page/PageOne.elm +++ b/src/Page/PageOne.elm @@ -1,12 +1,12 @@ -module Page.PageOne exposing (Model, init, update, view, page) +module Page.PageOne exposing (Model, init, page, update, view) import Browser import Html exposing (..) import Html.Attributes exposing (..) -import Session -import Viewer exposing (detailsConfig) import Msg import Page +import Session +import Viewer exposing (detailsConfig) @@ -19,26 +19,33 @@ type alias Model = -- INIT + + init : Model -init = {} +init = + {} + -page : Session.Session -> (Page.Page Model Msg.PageOneMsg, Cmd Msg.PageOneMsg ) +page : Session.Session -> ( Page.Page Model Msg.PageOneMsg, Cmd Msg.PageOneMsg ) page session = - let - model = - {session = session, - page = init, - view = view, - toMsg = Msg.PageOne, - subscriptions = Sub.none, - -- header = Viewer.header, - update = Page.liftupdate update } + let + model = + { session = session + , page = init + , view = view + , toMsg = Msg.PageOne + , subscriptions = Sub.none + , -- header = Viewer.header, + update = Page.liftupdate update + } in - ( Page.Page model, Cmd.none ) + ( Page.Page model, Cmd.none ) -- UPDATE + + update : Msg.PageOneMsg -> Model -> ( Model, Cmd Msg.PageOneMsg ) update msg model = case msg of @@ -52,11 +59,13 @@ update msg model = view : Page.Page Model Msg.PageOneMsg -> Viewer.Details Msg.Msg view model = - {detailsConfig | title = toTitle - , body = \_ -> - [ h1 [] [ text "elm-spa-boilerplate - Page One" ] - , div [] [ text "A beautiful, completely empty page in your application." ] - ] + { detailsConfig + | title = toTitle + , body = + \_ -> + [ h1 [] [ text "elm-spa-boilerplate - Page One" ] + , div [] [ text "A beautiful, completely empty page in your application." ] + ] } diff --git a/src/Page/PageWithSubpage.elm b/src/Page/PageWithSubpage.elm index 5da6663..da9992c 100644 --- a/src/Page/PageWithSubpage.elm +++ b/src/Page/PageWithSubpage.elm @@ -1,12 +1,12 @@ -module Page.PageWithSubpage exposing (Model, init, update, view, page) +module Page.PageWithSubpage exposing (Model, init, page, update, view) import Browser import Html exposing (..) import Html.Attributes exposing (..) -import Session -import Viewer exposing (detailsConfig) import Msg exposing (PageWithSubpageMsg) import Page +import Session +import Viewer exposing (detailsConfig) @@ -29,23 +29,25 @@ init : String -> Model init subpage = Model subpage -page : Session.Session -> String -> (Page.Page Model PageWithSubpageMsg, Cmd PageWithSubpageMsg ) + +page : Session.Session -> String -> ( Page.Page Model PageWithSubpageMsg, Cmd PageWithSubpageMsg ) page session subpage = - let - model = - {session = session, - page = init subpage, - view = view, - toMsg = Msg.PageWithSubpage, - subscriptions = Sub.none, - -- header = Viewer.header, - update = Page.liftupdate update} + let + model = + { session = session + , page = init subpage + , view = view + , toMsg = Msg.PageWithSubpage + , subscriptions = Sub.none + , -- header = Viewer.header, + update = Page.liftupdate update + } in - (Page.Page model, Cmd.none ) + ( Page.Page model, Cmd.none ) --- UPDATE +-- UPDATE update : PageWithSubpageMsg -> Model -> ( Model, Cmd PageWithSubpageMsg ) @@ -61,21 +63,23 @@ update msg model = view : Page.Page Model PageWithSubpageMsg -> Viewer.Details Msg.Msg view (Page.Page model) = - { detailsConfig | title = toTitle model.page - , body = \_ -> - [ h1 [] [ text "elm-spa-boilerplate - Page With Subpage" ] - , div [ class "content" ] - [ h3 [] [ text "This is a page that can handle subpaths in its routing." ] - , h3 [] [ text <| "The current subpath is : /" ++ model.page.subpage ] - , div [] [ text "The subpath could be anything, or a specific type, like a string or integer. You can have many levels of subpaths if you wanted!" ] - , div [] - [ text " This demo accepts a single level subpath that can be any string. For example, " - , a [ href "/pagewithsubpage/xyz" ] [ text "/pagewithsubpage/xyz" ] + { detailsConfig + | title = toTitle model.page + , body = + \_ -> + [ h1 [] [ text "elm-spa-boilerplate - Page With Subpage" ] + , div [ class "content" ] + [ h3 [] [ text "This is a page that can handle subpaths in its routing." ] + , h3 [] [ text <| "The current subpath is : /" ++ model.page.subpage ] + , div [] [ text "The subpath could be anything, or a specific type, like a string or integer. You can have many levels of subpaths if you wanted!" ] + , div [] + [ text " This demo accepts a single level subpath that can be any string. For example, " + , a [ href "/pagewithsubpage/xyz" ] [ text "/pagewithsubpage/xyz" ] + ] + , div [] [ a [ href "/pagewithsubpage/a-wonderful-subpath" ] [ text "click here to go to a subpath" ] ] + , div [] [ a [ href "/pagewithsubpage/i-love-elm" ] [ text "click here to go to another subpath" ] ] + ] ] - , div [] [ a [ href "/pagewithsubpage/a-wonderful-subpath" ] [ text "click here to go to a subpath" ] ] - , div [] [ a [ href "/pagewithsubpage/i-love-elm" ] [ text "click here to go to another subpath" ] ] - ] - ] } diff --git a/src/Page/Question.elm b/src/Page/Question.elm index 0575293..22a9e2e 100644 --- a/src/Page/Question.elm +++ b/src/Page/Question.elm @@ -1,17 +1,17 @@ -module Page.Question exposing (..) +module Page.Question exposing (Model, RelatedData, init, page, relatedData, toTitle, update, view, viewCodingQuestion, viewCodingQuestions, viewInputTypeSelection, viewSettings) import Dict import Html exposing (Html, p, text) +import Material.Button as Button import Material.FormField as FormField import Material.LayoutGrid exposing (cell, inner, layoutGrid) +import Material.List as List +import Material.List.Item as ListItem exposing (ListItem) import Material.Radio as Radio import Material.Slider as Slider -import Material.TextField as TextField import Material.Switch as Switch +import Material.TextField as TextField import Material.Typography as Typography exposing (typography) -import Material.List as List -import Material.List.Item as ListItem exposing (ListItem) -import Material.Button as Button import Maybe.Extra import Msg import Page exposing (Page(..)) @@ -20,8 +20,8 @@ import Time exposing (Posix) import Type.Database as Db import Type.Database.InputType as IT import Type.Database.TypeMatching as Match -import Type.IO.Setter as Updater import Type.IO.Internal as Id exposing (Id, box, unbox) +import Type.IO.Setter as Updater import Viewer exposing (detailsConfig) @@ -33,7 +33,7 @@ type alias Model = , list : Maybe (Id IT.InputType String) , codingQuestionaryID : Maybe (Id Db.CodingQuestionary String) , codingQuestionary : Maybe (Db.Timestamp Db.CodingQuestionary) - , codingQuestions : List (String, Db.Timestamp Db.CodingQuestion) + , codingQuestions : List ( String, Db.Timestamp Db.CodingQuestion ) } @@ -51,14 +51,20 @@ init db id = (Maybe.map box cid) (Maybe.map Tuple.second coding_questionary) coding_questions - - cid = (Maybe.map Tuple.first coding_questionary) - coding_questionary = (Dict.filter (\cqid cq -> cq.value.question == id) db.coding_questionnaries) - |> Dict.toList - |> List.sortBy (\(cqid, cq) -> cq.created) - |> List.head - coding_questions = Dict.filter (\cqqid cqq -> Just cqq.value.coding_questionary == Maybe.map box cid ) db.coding_questions - |> Dict.toList + + cid = + Maybe.map Tuple.first coding_questionary + + coding_questionary = + Dict.filter (\cqid cq -> cq.value.question == id) db.coding_questionnaries + |> Dict.toList + |> List.sortBy (\( cqid, cq ) -> cq.created) + |> List.head + + coding_questions = + Dict.filter (\cqqid cqq -> Just cqq.value.coding_questionary == Maybe.map box cid) db.coding_questions + |> Dict.toList + q = Dict.get (unbox id) db.questions |> Maybe.map .value @@ -94,6 +100,7 @@ page session id = , view = view , toMsg = identity , subscriptions = Sub.none + -- , header = Viewer.header , update = update @@ -527,26 +534,28 @@ viewInputTypeSelection model ( id, _ ) = ] ] + viewCodingQuestions : Model -> List (Html Msg.Msg) viewCodingQuestions model = let - enabled = case model.codingQuestionary of - Just cq -> - cq.value.enabled == True - _ -> - False - + enabled = + case model.codingQuestionary of + Just cq -> + cq.value.enabled == True + + _ -> + False in - [FormField.formField + [ FormField.formField (FormField.config |> FormField.setLabel (Just "Enable Coding") ) [ Switch.switch (Switch.config - |> Switch.setChecked (enabled) - |> Switch.setOnChange ( - case (model.codingQuestionaryID, model.codingQuestionary) of - (Just cqid, Just cq) -> + |> Switch.setChecked enabled + |> Switch.setOnChange + (case ( model.codingQuestionaryID, model.codingQuestionary ) of + ( Just cqid, Just cq ) -> Match.setField { kind = Db.CodingQuestionaryType , attribute = "enabled" @@ -554,7 +563,8 @@ viewCodingQuestions model = , id = cqid , value = not cq.value.enabled } - _ -> + + _ -> Msg.CRUD <| Msg.CreateRandom Db.CodingQuestionaryType [ \x -> @@ -565,7 +575,8 @@ viewCodingQuestions model = , id = box x , value = unbox model.id } - , \x -> Match.setField + , \x -> + Match.setField { kind = Db.CodingQuestionaryType , attribute = "enabled" , setter = Updater.BoolMsg @@ -573,28 +584,30 @@ viewCodingQuestions model = , value = True } ] - - ) - ) ] + ) + ) + ] , case List.map viewCodingQuestion model.codingQuestions of first :: rest -> List.list List.config - first - rest + first + rest + _ -> - case model.codingQuestionaryID of + case model.codingQuestionaryID of Just _ -> text "No Question yet!" + Nothing -> - Html.div [][] + Html.div [] [] , case model.codingQuestionaryID of Just cid -> Button.unelevated - (Button.config - |> Button.setIcon (Just <| Button.icon "add") - |> Button.setOnClick ( - --Just <| - Msg.CRUD <| + (Button.config + |> Button.setIcon (Just <| Button.icon "add") + |> Button.setOnClick + --Just <| + (Msg.CRUD <| Msg.CreateRandom Db.CodingQuestionType [ \x -> Match.setField @@ -605,17 +618,20 @@ viewCodingQuestions model = , value = unbox cid } ] - )) - "Add" - Nothing -> - Html.div [][] + ) + ) + "Add" + + Nothing -> + Html.div [] [] ] -viewCodingQuestion : (String, Db.Timestamp Db.CodingQuestion) -> ListItem Msg.Msg -viewCodingQuestion (id, cquestion) = - (ListItem.listItem (ListItem.config |> ListItem.setOnClick (Msg.Follow Db.CodingQuestionType id)) + +viewCodingQuestion : ( String, Db.Timestamp Db.CodingQuestion ) -> ListItem Msg.Msg +viewCodingQuestion ( id, cquestion ) = + ListItem.listItem (ListItem.config |> ListItem.setOnClick (Msg.Follow Db.CodingQuestionType id)) [ text cquestion.value.text ] - ) + viewSettings : Db.Database -> Id Db.Question String -> Model -> ( Id IT.InputType String, Maybe IT.InputType ) -> List (Html Msg.Msg) viewSettings db id model ( itid, mbit ) = @@ -688,11 +704,14 @@ viewSettings db id model ( itid, mbit ) = [ text <| "Min Length: " ++ (Maybe.withDefault "0" <| Maybe.map String.fromInt short.minLength) , Slider.slider (Slider.config - |> (\x -> - case (Maybe.map toFloat short.minLength) of - Just minLength -> Slider.setValue minLength x - Nothing -> x - ) + |> (\x -> + case Maybe.map toFloat short.minLength of + Just minLength -> + Slider.setValue minLength x + + Nothing -> + x + ) -- |> Slider.setMax (Maybe.map toFloat short.maxLength) |> Slider.setOnInput (\x -> @@ -710,11 +729,14 @@ viewSettings db id model ( itid, mbit ) = [ text <| "Max Length: " ++ (Maybe.withDefault "100" <| Maybe.map String.fromInt short.maxLength) , Slider.slider (Slider.config - |> (\x -> - case (Maybe.map toFloat short.maxLength) of - Just minLength -> Slider.setValue minLength x - Nothing -> x - ) + |> (\x -> + case Maybe.map toFloat short.maxLength of + Just minLength -> + Slider.setValue minLength x + + Nothing -> + x + ) -- |> Slider.setMin (Maybe.map toFloat short.minLength) |> Slider.setOnInput (\x -> @@ -733,9 +755,8 @@ viewSettings db id model ( itid, mbit ) = _ -> [ text "No Config found" ] - else - if model.long == Just itid then - case Maybe.map .value <| Maybe.andThen (\x -> Dict.get (unbox x) db.input_types) model.long of + else if model.long == Just itid then + case Maybe.map .value <| Maybe.andThen (\x -> Dict.get (unbox x) db.input_types) model.long of Just (IT.LongAnswer long) -> [ TextField.filled (TextField.config @@ -786,11 +807,14 @@ viewSettings db id model ( itid, mbit ) = [ text <| "Min Length: " ++ (Maybe.withDefault "0" <| Maybe.map String.fromInt long.minLength) , Slider.slider (Slider.config - |> (\x -> - case (Maybe.map toFloat long.minLength) of - Just minLength -> Slider.setValue minLength x - Nothing -> x - ) + |> (\x -> + case Maybe.map toFloat long.minLength of + Just minLength -> + Slider.setValue minLength x + + Nothing -> + x + ) -- |> Slider.setMax (Maybe.map toFloat short.maxLength) |> Slider.setOnInput (\x -> @@ -808,11 +832,14 @@ viewSettings db id model ( itid, mbit ) = [ text <| "Max Length: " ++ (Maybe.withDefault "100" <| Maybe.map String.fromInt long.maxLength) , Slider.slider (Slider.config - |> (\x -> - case (Maybe.map toFloat long.maxLength) of - Just minLength -> Slider.setValue minLength x - Nothing -> x - ) + |> (\x -> + case Maybe.map toFloat long.maxLength of + Just minLength -> + Slider.setValue minLength x + + Nothing -> + x + ) -- |> Slider.setMin (Maybe.map toFloat short.minLength) |> Slider.setOnInput (\x -> @@ -830,24 +857,25 @@ viewSettings db id model ( itid, mbit ) = _ -> [ text "No Config found" ] - else - if model.list == Just itid then - case Maybe.map .value <| Maybe.andThen (\x -> Dict.get (unbox x) db.input_types) model.list of - Just (IT.List list) -> - [ text "Boxes or Radio?" - , FormField.formField - (FormField.config - |> FormField.setLabel (Just "Radio Button") - ) - [ Radio.radio Radio.config ] - , FormField.formField - (FormField.config - |> FormField.setLabel (Just "Checkbox") - ) - [ Radio.radio Radio.config ] - ] - _ -> - [ text "No Config found"] - else - [text "You have not selected an Input type yet." ] + else if model.list == Just itid then + case Maybe.map .value <| Maybe.andThen (\x -> Dict.get (unbox x) db.input_types) model.list of + Just (IT.List list) -> + [ text "Boxes or Radio?" + , FormField.formField + (FormField.config + |> FormField.setLabel (Just "Radio Button") + ) + [ Radio.radio Radio.config ] + , FormField.formField + (FormField.config + |> FormField.setLabel (Just "Checkbox") + ) + [ Radio.radio Radio.config ] + ] + + _ -> + [ text "No Config found" ] + + else + [ text "You have not selected an Input type yet." ] diff --git a/src/Page/Questionary.elm b/src/Page/Questionary.elm index 381d70f..53dfb67 100644 --- a/src/Page/Questionary.elm +++ b/src/Page/Questionary.elm @@ -1,8 +1,9 @@ -module Page.Questionary exposing (Model, defaultFokus, init, page, update, view) +module Page.Questionary exposing (Fokus, Item, Model, defaultFokus, init, page, update, view) --import Browser import Dict +import DnDList import Html exposing (Html, div, p, text) import Html.Attributes exposing (style) import Html.Events exposing (onClick) @@ -12,34 +13,32 @@ import Material.Button as Button import Material.Card as Card exposing (actions, block, primaryAction) import Material.Checkbox as Checkbox import Material.Fab as Fab +import Material.Icon as Icon import Material.IconButton as IconButton import Material.LayoutGrid as LG exposing (cell, inner, layoutGrid) import Material.List as MList exposing (list) import Material.List.Item as MLItem exposing (graphic, listItem) +import Material.Menu as Menu import Material.Radio as Radio import Material.Select as Select import Material.Select.Item as SelectItem import Material.TextArea as TextArea import Material.TextField as TextField import Material.Typography as Typography -import Material.Menu as Menu -import Material.Icon as Icon import Msg import Page exposing (Page(..)) import Session import Svg.Attributes exposing (x) +import Task import Time exposing (Posix) import Type.Database as Db import Type.Database.InputType as IT import Type.Database.TypeMatching as Match import Type.IO.Form as Form +import Type.IO.Internal as Id exposing (Id, box, unbox) import Type.IO.Setter as Updater -import Type.IO.Internal as Id exposing (Id, unbox, box) import Viewer exposing (detailsConfig, system) import Viewer.OrderAwareList exposing (OrderAware, orderAwareList) -import DnDList -import Task - @@ -50,8 +49,7 @@ import Task type alias Model = - { - id : Id Db.Questionary String + { id : Id Db.Questionary String , questionary : Maybe (Db.Timestamp Db.Questionary) , focus : Fokus , dnd : DnDList.Model @@ -59,9 +57,12 @@ type alias Model = , menu : Maybe String } + type alias Item = - {id: String - , question: Db.Timestamp Db.Question} + { id : String + , question : Db.Timestamp Db.Question + } + type alias Fokus = { activeQuestion : Maybe String @@ -80,7 +81,8 @@ defaultFokus = init : Id Db.Questionary String -> Fokus -> DnDList.Model -> List Item -> Maybe (Db.Timestamp Db.Questionary) -> Model init id focus dnd questions questionary = - Model id questionary focus dnd questions Nothing + Model id questionary focus dnd questions Nothing + page : Session.Session -> Id Db.Questionary String -> Fokus -> Maybe (List Item) -> DnDList.Model -> ( Page.Page Model Msg.Msg, Cmd Msg.Msg ) page session id focus mbquestions dndmodel = @@ -91,36 +93,42 @@ page session id focus mbquestions dndmodel = , view = view , toMsg = identity , subscriptions = system.subscriptions dndmodel + -- , header = Viewer.header , update = update -- , update = Page.liftupdate update } - dbquestions = Dict.filter (\qid question -> question.value.questionary == id) session.db.questions - |> Dict.toList - |> List.sortBy (\(_, question) -> question.value.index) - |> (List.map (\(a, b)-> Item a b)) - questions = Maybe.withDefault dbquestions mbquestions - questionary = Dict.get (unbox id) session.db.questionnaries - in - ( Page model, Cmd.none ) + dbquestions = + Dict.filter (\qid question -> question.value.questionary == id) session.db.questions + |> Dict.toList + |> List.sortBy (\( _, question ) -> question.value.index) + |> List.map (\( a, b ) -> Item a b) -{- dndSystem : DnDList.System Item Msg.Msg -dndSystem = - let - config = { beforeUpdate = \_ _ list -> list - , movement = DnDList.Vertical - , listen = DnDList.OnDrag - , operation = DnDList.Rotate - } - system = DnDList.create config (Msg.DnDEvent) + questions = + Maybe.withDefault dbquestions mbquestions + + questionary = + Dict.get (unbox id) session.db.questionnaries in - system -} --- UPDATE + ( Page model, Cmd.none ) +{- dndSystem : DnDList.System Item Msg.Msg + dndSystem = + let + config = { beforeUpdate = \_ _ list -> list + , movement = DnDList.Vertical + , listen = DnDList.OnDrag + , operation = DnDList.Rotate + } + system = DnDList.create config (Msg.DnDEvent) + in + system +-} +-- UPDATE update : Msg.Msg -> Page.Page Model Msg.Msg -> ( Page.Page Model Msg.Msg, Cmd Msg.Msg ) @@ -172,63 +180,70 @@ update message (Page model) = { oldmodel | focus = defaultFokus } in ( Page { model | page = newmodel }, Cmd.none ) + Msg.ContextMenu id -> - let - newmodel = - { oldmodel | menu = id } - in - ( Page { model | page = newmodel }, Cmd.none ) - - {- Msg.OnQuestionDrag msg_ -> let - ( dnd, items ) = - system.update msg_ oldmodel.dnd oldmodel.questions - newmodel = { oldmodel | dnd = dnd, questions = items } + newmodel = + { oldmodel | menu = id } in - ( Page { model | page = newmodel } - , Cmd.batch [system.commands dnd {-,changeIndices oldmodel.questions items-}] - ) - Msg.Tock _ -> - (Page model, Cmd.none) -} + ( Page { model | page = newmodel }, Cmd.none ) + + {- Msg.OnQuestionDrag msg_ -> + let + ( dnd, items ) = + system.update msg_ oldmodel.dnd oldmodel.questions + newmodel = { oldmodel | dnd = dnd, questions = items } + in + ( Page { model | page = newmodel } + , Cmd.batch [system.commands dnd {-,changeIndices oldmodel.questions items-}] + ) + Msg.Tock _ -> + (Page model, Cmd.none) + -} Msg.DnDEvent msg_ -> let ( dnd, items ) = system.update msg_ oldmodel.dnd oldmodel.questions - newmodel = { oldmodel | dnd = dnd, questions = items } + + newmodel = + { oldmodel | dnd = dnd, questions = items } in ( Page { model | page = newmodel } - , system.commands dnd + , system.commands dnd ) + _ -> ( Page model, Cmd.none ) changeIndices : List Item -> List Item -> Cmd Msg.Msg -changeIndices old new = +changeIndices old new = List.map2 changeIndex old new - |> List.filterMap identity - |> Match.setManyFields - |> Task.succeed - |> Task.perform identity + |> List.filterMap identity + |> Match.setManyFields + |> Task.succeed + |> Task.perform identity + changeIndex : Item -> Item -> Maybe (Match.FieldConfig Int Db.Question) changeIndex old new = if old.question.value.index == new.question.value.index then Nothing + else - let + let setIndex id index = - { kind = Db.QuestionType - , attribute = "index" - , setter = Updater.IntMsg - , id = box id - , value = index - } + { kind = Db.QuestionType + , attribute = "index" + , setter = Updater.IntMsg + , id = box id + , value = index + } in - Just <| setIndex new.id old.question.value.index + Just <| setIndex new.id old.question.value.index @@ -243,7 +258,6 @@ view (Page.Page model) = mbInfos = relatedData model.page.id db - in case mbInfos of Just infos -> @@ -274,9 +288,9 @@ view (Page.Page model) = , user = model.session.user , body = \_ -> - [ layoutGrid [ Typography.typography] + [ layoutGrid [ Typography.typography ] [ inner [] <| - [ cell [LG.span12] + [ cell [ LG.span12 ] [ Html.h1 [ Typography.headline5 ] [ editableText model.page.focus.titleFocused @@ -299,14 +313,13 @@ view (Page.Page model) = ] ] --++ List.map (\x -> cell [LG.span10Desktop, LG.span8Tablet] [ viewQuestionCard db model.page.focus.activeQuestion x ]) infos.questions - ++ [ cell [LG.span12] - [ - inner [] [ - cell [LG.span2Desktop,LG.span1Tablet][] - , cell [LG.span8Desktop,LG.span6Tablet] <| - [viewQuestionList model.page db infos infos.questions] - --viewDraggableQuestionList model.page - + ++ [ cell [ LG.span12 ] + [ inner [] + [ cell [ LG.span2Desktop, LG.span1Tablet ] [] + , cell [ LG.span8Desktop, LG.span6Tablet ] <| + [ viewQuestionList model.page db infos infos.questions ] + + --viewDraggableQuestionList model.page ] ] ] @@ -409,36 +422,40 @@ editableText active activator deactivator value callback = -- ] -- ] + + viewDraggableQuestionList : Model -> List (Html Msg.Msg) viewDraggableQuestionList model = - [ (case List.indexedMap (itemView model.dnd) model.questions of - first :: rest -> - MList.list MList.config - first - rest - _ -> - Html.text " ") - - , ghostView model.dnd model.questions + [ case List.indexedMap (itemView model.dnd) model.questions of + first :: rest -> + MList.list MList.config + first + rest + + _ -> + Html.text " " + , ghostView model.dnd model.questions ] - -- let - -- questions = List.indexedMap (itemView model.dnd) model.questions - -- in - -- case questions of - - -- first :: rest -> - -- [list - -- (MList.config - -- |> MList.setTwoLine True - -- --|> MList.setNonInteractive True - -- ) - -- first - -- rest - -- , ghostView model.dnd model.questions - -- ] - - -- _ -> - -- [text "NoItem"] + + + +-- let +-- questions = List.indexedMap (itemView model.dnd) model.questions +-- in +-- case questions of +-- first :: rest -> +-- [list +-- (MList.config +-- |> MList.setTwoLine True +-- --|> MList.setNonInteractive True +-- ) +-- first +-- rest +-- , ghostView model.dnd model.questions +-- ] +-- _ -> +-- [text "NoItem"] + itemView : DnDList.Model -> Int -> Item -> MLItem.ListItem Msg.Msg itemView dnd index item = @@ -446,55 +463,64 @@ itemView dnd index item = itemId : String itemId = "id-" ++ item.id + --system = dndSystem in case system.info dnd of Just { dragIndex } -> if dragIndex /= index then - MLItem.listItem - (MLItem.config - |> MLItem.setAttributes (Html.Attributes.id itemId :: system.dropEvents index itemId)) + MLItem.listItem + (MLItem.config + |> MLItem.setAttributes (Html.Attributes.id itemId :: system.dropEvents index itemId) + ) [ Html.text item.id ] else MLItem.listItem - (MLItem.config - |> MLItem.setAttributes [ Html.Attributes.id itemId ]) + (MLItem.config + |> MLItem.setAttributes [ Html.Attributes.id itemId ] + ) [ Html.text "[---------]" ] Nothing -> MLItem.listItem - (MLItem.config - |> MLItem.setAttributes (Html.Attributes.id itemId :: system.dragEvents index itemId)) - [ Html.text item.id ] - {- let - itemId : String - itemId = - "id-" ++ item.id - in - case dndSystem.info dnd of - Just { dragIndex } -> - if dragIndex /= index then - listItem - (MLItem.config - |> MLItem.setAttributes (Html.Attributes.id itemId :: dndSystem.dropEvents index itemId) - |> MLItem.setOnClick (Msg.Follow Db.QuestionType item.id) + (MLItem.config + |> MLItem.setAttributes (Html.Attributes.id itemId :: system.dragEvents index itemId) ) - [ MLItem.text [] {primary = [Html.text item.id ], secondary = [] }, MLItem.meta [] [ Icon.icon [] "star" ]] + [ Html.text item.id ] - else - listItem - (MLItem.config |> MLItem.setAttributes [ Html.Attributes.id itemId ] - ) - [ MLItem.text [] {primary = [ Html.text "[---------]" ], secondary = [] } ] - Nothing -> - listItem - (MLItem.config - |> MLItem.setAttributes [Html.Attributes.id itemId] - |> MLItem.setOnClick (Msg.Follow Db.QuestionType item.id) - ) - [ MLItem.text [] {primary = [Html.text item.id ], secondary = [] }, MLItem.meta [] [ Icon.icon (dndSystem.dragEvents index itemId) "star" ] ] -} + +{- let + itemId : String + itemId = + "id-" ++ item.id + in + case dndSystem.info dnd of + Just { dragIndex } -> + if dragIndex /= index then + listItem + (MLItem.config + |> MLItem.setAttributes (Html.Attributes.id itemId :: dndSystem.dropEvents index itemId) + |> MLItem.setOnClick (Msg.Follow Db.QuestionType item.id) + ) + [ MLItem.text [] {primary = [Html.text item.id ], secondary = [] }, MLItem.meta [] [ Icon.icon [] "star" ]] + + else + listItem + (MLItem.config |> MLItem.setAttributes [ Html.Attributes.id itemId ] + ) + [ MLItem.text [] {primary = [ Html.text "[---------]" ], secondary = [] } ] + + Nothing -> + listItem + (MLItem.config + |> MLItem.setAttributes [Html.Attributes.id itemId] + |> MLItem.setOnClick (Msg.Follow Db.QuestionType item.id) + ) + [ MLItem.text [] {primary = [Html.text item.id ], secondary = [] }, MLItem.meta [] [ Icon.icon (dndSystem.dragEvents index itemId) "star" ] ] +-} + ghostView : DnDList.Model -> List Item -> Html.Html Msg.Msg ghostView dnd items = @@ -511,14 +537,11 @@ ghostView dnd items = |> MList.setTwoLine True |> MList.setInteractive False ) - (listItem - (MLItem.config |> MLItem.setAttributes (system.ghostStyles dnd) + (listItem + (MLItem.config |> MLItem.setAttributes (system.ghostStyles dnd)) + [ MLItem.text [] { primary = [ Html.text item.id ], secondary = [] } ] ) - [ MLItem.text [] {primary = [ Html.text item.id ], secondary = [] } ]) - [] - - - + [] Nothing -> Html.text "" @@ -550,85 +573,88 @@ viewQuestionListItem model db { id, value, previous, next } = --downMsg = Match.swapFields Db.QuestionType "index" Updater.IntMsg ( post.id, id ) ( post.value.index, value.index ) in listItem - (MLItem.config {- |> MLItem.setOnClick (Msg.Follow Db.QuestionType id)-}) + (MLItem.config {- |> MLItem.setOnClick (Msg.Follow Db.QuestionType id) -}) <| - [ MLItem.text [onClick <| Msg.Follow Db.QuestionType (unbox id)] + [ MLItem.text [ onClick <| Msg.Follow Db.QuestionType (unbox id) ] { primary = [ Html.text value.text ] - , secondary = [ Html.text <| Maybe.withDefault (unbox value.input_type) <| Maybe.map (\it -> IT.toString it.value) <|Dict.get (unbox value.input_type) db.input_types ] + , secondary = [ Html.text <| Maybe.withDefault (unbox value.input_type) <| Maybe.map (\it -> IT.toString it.value) <| Dict.get (unbox value.input_type) db.input_types ] } , MLItem.meta [] - [ - Html.div [Menu.surfaceAnchor][ - IconButton.iconButton + [ Html.div [ Menu.surfaceAnchor ] + [ IconButton.iconButton (IconButton.config |> IconButton.setOnClick - (Msg.Questionary <| Msg.ContextMenu <| Just <| unbox id)) - (IconButton.icon "more_vert")] - , Menu.menu + (Msg.Questionary <| Msg.ContextMenu <| Just <| unbox id) + ) + (IconButton.icon "more_vert") + ] + , Menu.menu (Menu.config |> Menu.setOpen (model.menu == Just (unbox id)) |> Menu.setOnClose (Msg.Questionary <| Msg.ContextMenu <| Nothing) ) (MLItem.listItem MLItem.config - [ text "Menu item" ] - ) - [ - MLItem.listItem MLItem.config - [ text "Menu item" ] - + [ text "Menu item" ] + ) + [ MLItem.listItem MLItem.config + [ text "Menu item" ] ] ] ] - {- ++ (case ( previous, next ) of - ( Just prev, Just post ) -> - [ MLItem.meta [] - [ IconButton.iconButton - (IconButton.config - |> IconButton.setOnClick - (Match.swapFields Db.QuestionType "index" Updater.IntMsg ( prev.id, id ) ( prev.value.index, value.index )) - ) - (IconButton.icon "arrow_upward") - , IconButton.iconButton - (IconButton.config - |> IconButton.setOnClick - (Match.swapFields Db.QuestionType "index" Updater.IntMsg ( post.id, id ) ( post.value.index, value.index )) - ) - (IconButton.icon "arrow_downward") - ] - ] - ( Just prev, Nothing ) -> - [ MLItem.meta [] - [ IconButton.iconButton - (IconButton.config - |> IconButton.setOnClick - (Match.swapFields Db.QuestionType "index" Updater.IntMsg ( prev.id, id ) ( prev.value.index, value.index )) - ) - (IconButton.icon "arrow_upward") - ] - ] - ( Nothing, Just post ) -> - [ MLItem.meta [] - [ IconButton.iconButton - (IconButton.config - |> IconButton.setOnClick - (Match.swapFields Db.QuestionType "index" Updater.IntMsg ( post.id, id ) ( post.value.index, value.index )) - ) - (IconButton.icon "arrow_downward") - ] - ] - _ -> - [] - ) -} +{- ++ (case ( previous, next ) of + ( Just prev, Just post ) -> + [ MLItem.meta [] + [ IconButton.iconButton + (IconButton.config + |> IconButton.setOnClick + (Match.swapFields Db.QuestionType "index" Updater.IntMsg ( prev.id, id ) ( prev.value.index, value.index )) + ) + (IconButton.icon "arrow_upward") + , IconButton.iconButton + (IconButton.config + |> IconButton.setOnClick + (Match.swapFields Db.QuestionType "index" Updater.IntMsg ( post.id, id ) ( post.value.index, value.index )) + ) + (IconButton.icon "arrow_downward") + ] + ] + + ( Just prev, Nothing ) -> + [ MLItem.meta [] + [ IconButton.iconButton + (IconButton.config + |> IconButton.setOnClick + (Match.swapFields Db.QuestionType "index" Updater.IntMsg ( prev.id, id ) ( prev.value.index, value.index )) + ) + (IconButton.icon "arrow_upward") + ] + ] + + ( Nothing, Just post ) -> + [ MLItem.meta [] + [ IconButton.iconButton + (IconButton.config + |> IconButton.setOnClick + (Match.swapFields Db.QuestionType "index" Updater.IntMsg ( post.id, id ) ( post.value.index, value.index )) + ) + (IconButton.icon "arrow_downward") + ] + ] + + _ -> + [] + ) +-} viewQuestionCard : Db.Database -> Maybe (Id Db.Question String) -> OrderAware Db.Question -> Html Msg.Msg viewQuestionCard db mbCur { id, value, previous, next } = let setMsg x callback = - Match.setField + Match.setField { kind = Db.QuestionType , attribute = "input_type" , setter = \y -> Updater.Custom y callback @@ -673,7 +699,7 @@ viewQuestionCard db mbCur { id, value, previous, next } = [] , block <| Html.div [ Html.Attributes.style "padding" "1rem" ] - [ {-viewInputTypeActive question.input_type <| setMsg (IT.toString question.input_type) -}] + [{- viewInputTypeActive question.input_type <| setMsg (IT.toString question.input_type) -}] ] , actions = Just <| @@ -714,7 +740,7 @@ viewQuestionCard db mbCur { id, value, previous, next } = [ text question.text ] , block <| Html.div [ Html.Attributes.style "padding" "1rem" ] - [ {-viewInputTypePassive question.input_type-} ] + [{- viewInputTypePassive question.input_type -}] ] , actions = Just <| @@ -855,7 +881,7 @@ type alias RelatedData = , study : ( Id Db.Study String, Maybe Db.Study ) , questions : List (OrderAware Db.Question) , created : Posix - , creator : (Id Db.User String, Maybe Db.User ) + , creator : ( Id Db.User String, Maybe Db.User ) , updated : Posix , max_index : Maybe Int } @@ -869,7 +895,7 @@ relatedData id db = questions = List.sortBy (\( _, y ) -> y.index) <| List.filter (\( _, y ) -> y.questionary == id) <| - List.map (\( x, y ) -> (box x, y.value )) <| + List.map (\( x, y ) -> ( box x, y.value )) <| Dict.toList db.questions questionary = @@ -890,8 +916,6 @@ relatedData id db = Nothing - - viewStudy : ( Id Db.Study String, Maybe Db.Study ) -> Maybe (Id Db.User String) -> String viewStudy ( id, mbStudy ) cur = Maybe.map .name mbStudy @@ -902,7 +926,7 @@ viewList : List ( String, a ) -> (String -> msg) -> Html msg viewList elements onClick = let mlist = - List.map (\( x, _ ) -> listItem (MLItem.config {- |> MLItem.setOnClick (onClick x)-}) [ MLItem.graphic [] [ identicon "100%" x ], text x ]) elements + List.map (\( x, _ ) -> listItem (MLItem.config {- |> MLItem.setOnClick (onClick x) -}) [ MLItem.graphic [] [ identicon "100%" x ], text x ]) elements in case mlist of f :: r -> @@ -937,6 +961,6 @@ wideTextForm label value callback = |> TextField.setValue (Just value) |> TextField.setOnInput callback |> TextField.setLabel label - --|> TextField.setFullwidth True + --|> TextField.setFullwidth True --|> TextField.setOutlined ) diff --git a/src/Page/Study.elm b/src/Page/Study.elm index 5e1cc79..b8b9df7 100644 --- a/src/Page/Study.elm +++ b/src/Page/Study.elm @@ -3,25 +3,25 @@ module Page.Study exposing (Model, init, page, update, view) --import Browser import Dict exposing (Dict) +import File.Download as Download import Html exposing (Html, div, p, text) import Identicon exposing (identicon) import Material.Button as Button exposing (unelevated) -import Material.LayoutGrid as LG exposing (layoutGrid, cell, inner) -import Material.List as MList exposing (list) -import Material.List.Item as MLItem exposing (listItem, graphic) -import Material.Typography as Typography import Material.Icon as Icon import Material.IconButton as IconButton -import File.Download as Download +import Material.LayoutGrid as LG exposing (cell, inner, layoutGrid) +import Material.List as MList exposing (list) +import Material.List.Item as MLItem exposing (graphic, listItem) +import Material.Typography as Typography import Msg import Page exposing (Page(..)) import Session import Time exposing (Posix) import Type.Database as Db -import Type.Database.TypeMatching as Match import Type.Database.Aquisition as Aq exposing (..) -import Type.IO.Setter as Updater +import Type.Database.TypeMatching as Match import Type.IO.Internal as Id exposing (Id, box, unbox) +import Type.IO.Setter as Updater import Viewer exposing (detailsConfig) import Viewer.EditableText as EditableText @@ -45,22 +45,26 @@ type alias Model = init : Id Db.Study String -> Bool -> Model init = - Model - {- - { active = False - , activator = Msg.Study <| Msg.StudyNameEdit Msg.GetFocus - , deactivator = Msg.Study <| Msg.StudyNameEdit Msg.LooseFocus - , callback = \y -> Match.setField - { kind = Db.StudyType - , attribute = "name" - , setter = Updater.StringMsg - , id = model.page.id - , value = y - }} - -} + Model + + + +{- + { active = False + , activator = Msg.Study <| Msg.StudyNameEdit Msg.GetFocus + , deactivator = Msg.Study <| Msg.StudyNameEdit Msg.LooseFocus + , callback = \y -> Match.setField + { kind = Db.StudyType + , attribute = "name" + , setter = Updater.StringMsg + , id = model.page.id + , value = y + }} +-} + page : Session.Session -> Id Db.Study String -> Bool -> ( Page.Page Model Msg.Msg, Cmd Msg.Msg ) -page session id focus= +page session id focus = let model = { session = session @@ -68,6 +72,7 @@ page session id focus= , view = view , toMsg = identity , subscriptions = Sub.none + -- , header = Viewer.header , update = update @@ -90,21 +95,28 @@ update message (Page model) = case msg_ of Msg.GetFocus -> let - old_page = model.page - new_page = {old_page | nameFocus = True} + old_page = + model.page + + new_page = + { old_page | nameFocus = True } in - - ( Page {model| page = new_page}, Cmd.none ) + ( Page { model | page = new_page }, Cmd.none ) + Msg.LooseFocus -> let - old_page = model.page - new_page = {old_page | nameFocus = False} + old_page = + model.page + + new_page = + { old_page | nameFocus = False } in - - ( Page {model| page = new_page}, Cmd.none ) + ( Page { model | page = new_page }, Cmd.none ) + Msg.ExportStudy id -> ( Page model, Download.string "export.csv" "text/csv" <| exportStudy (box id) model.session.db ) - _ -> + + _ -> ( Page model, Cmd.none ) @@ -124,49 +136,58 @@ view (Page.Page model) = econf = { active = model.page.nameFocus , activator = Msg.Study <| Msg.StudyNameEdit Msg.GetFocus - , deactivator = \_ -> (Msg.Study <| Msg.StudyNameEdit Msg.LooseFocus) - , callback = \z -> Match.setField - { kind = Db.StudyType - , attribute = "name" - , setter = Updater.StringMsg - , id = model.page.id - , value = z - }} + , deactivator = \_ -> Msg.Study <| Msg.StudyNameEdit Msg.LooseFocus + , callback = + \z -> + Match.setField + { kind = Db.StudyType + , attribute = "name" + , setter = Updater.StringMsg + , id = model.page.id + , value = z + } + } in case mbInfos of Just infos -> { detailsConfig | title = toTitle model.page - , actions = [("get_app", Msg.Study <| Msg.ExportStudy <| unbox infos.id)] + , actions = [ ( "get_app", Msg.Study <| Msg.ExportStudy <| unbox infos.id ) ] , user = model.session.user - , body = \_ -> - [ layoutGrid [ Typography.typography ] - [ inner[] - [ cell [] - [ Html.h1 [ Typography.headline5 ] [ {-text "Study: ",-} EditableText.text - econf - [] infos.title ] - , p [] [ text <| "Description:" ++ infos.description ] - , p [] [ text <| "Leader: " ++ viewLeader infos.leader model.session.user ] - , p [][ unelevated + , body = + \_ -> + [ layoutGrid [ Typography.typography ] + [ inner [] + [ cell [] + [ Html.h1 [ Typography.headline5 ] + [ {- text "Study: ", -} + EditableText.text + econf + [] + infos.title + ] + , p [] [ text <| "Description:" ++ infos.description ] + , p [] [ text <| "Leader: " ++ viewLeader infos.leader model.session.user ] + , p [] + [ unelevated + (Button.config + |> Button.setIcon (Just <| Button.icon "add") + |> Button.setOnClick (Msg.FollowSubpage Db.StudyType (unbox model.page.id) [ "code" ] []) + -- --Just <| + -- ) + ) + "StartCoding" + ] + ] + , cell [] + [ Html.h1 [ Typography.headline5 ] [ text "Events" ] + , viewList infos.events (Msg.Follow Db.EventType) .name + , unelevated (Button.config |> Button.setIcon (Just <| Button.icon "add") - |> Button.setOnClick (Msg.FollowSubpage Db.StudyType (unbox model.page.id) ["code"][]) - -- --Just <| - - -- ) - ) - "StartCoding"] - ] - , cell [] - [ Html.h1 [ Typography.headline5 ] [ text "Events" ] - , viewList infos.events (Msg.Follow Db.EventType) .name - , unelevated - (Button.config - |> Button.setIcon (Just <| Button.icon "add") - |> Button.setOnClick ( - --Just <| - Msg.CRUD <| + |> Button.setOnClick + --Just <| + (Msg.CRUD <| Msg.CreateRandom Db.EventType [ \x -> Match.setField @@ -177,18 +198,19 @@ view (Page.Page model) = , value = unbox infos.id } ] - )) - "Add" - ] - , cell [] - [ Html.h1 [ Typography.headline5 ] [ text "Questionnaries" ] - , viewList infos.questionnaries (Msg.Follow Db.QuestionaryType) .name - , unelevated - (Button.config - |> Button.setIcon (Just <| Button.icon "add") - |> Button.setOnClick ( - --Just <| - Msg.CRUD <| + ) + ) + "Add" + ] + , cell [] + [ Html.h1 [ Typography.headline5 ] [ text "Questionnaries" ] + , viewList infos.questionnaries (Msg.Follow Db.QuestionaryType) .name + , unelevated + (Button.config + |> Button.setIcon (Just <| Button.icon "add") + |> Button.setOnClick + --Just <| + (Msg.CRUD <| Msg.CreateRandom Db.QuestionaryType [ \x -> Match.setField @@ -199,28 +221,29 @@ view (Page.Page model) = , value = unbox infos.id } ] + ) ) - ) - "Add" + "Add" + ] ] ] ] - ] } Nothing -> { detailsConfig | title = toTitle model.page , user = model.session.user - , body = \_ -> - [ layoutGrid [] - [ inner [] - [ cell [] - [ Html.h1 [ Typography.headline5 ] [ text <| "Study not Found" ] + , body = + \_ -> + [ layoutGrid [] + [ inner [] + [ cell [] + [ Html.h1 [ Typography.headline5 ] [ text <| "Study not Found" ] + ] ] ] ] - ] } @@ -255,7 +278,7 @@ relatedData id db = , title = study.name , leader = ( study.leader, Maybe.map .value <| Dict.get (unbox study.leader) db.users ) , description = study.description - , events = List.filter (\( _, y ) -> y.study == id) <| List.map (\( x, y ) -> (box x, y.value )) <| Dict.toList db.events + , events = List.filter (\( _, y ) -> y.study == id) <| List.map (\( x, y ) -> ( box x, y.value )) <| Dict.toList db.events , questionnaries = List.filter (\( _, y ) -> y.study == id) <| List.map (\( x, y ) -> ( box x, y.value )) <| Dict.toList db.questionnaries , created = Time.millisToPosix timestampedStudy.created , creator = ( timestampedStudy.creator, Maybe.map .value <| Dict.get (unbox timestampedStudy.creator) db.users ) @@ -279,22 +302,24 @@ viewLeader ( id, mbLeader ) cur = viewList : List ( Id a String, a ) -> (String -> msg) -> (a -> String) -> Html msg viewList elements onClick nameGetter = let - mlist = List.map (\( x, y ) -> listItem (MLItem.config |> MLItem.setOnClick (onClick (unbox x)) ) [ graphic [] [ identicon "100%" (unbox x) ], text <| nameGetter y ]) elements + mlist = + List.map (\( x, y ) -> listItem (MLItem.config |> MLItem.setOnClick (onClick (unbox x))) [ graphic [] [ identicon "100%" (unbox x) ], text <| nameGetter y ]) elements in - case mlist of - f :: r -> - list MList.config f r - _ -> - list MList.config + case mlist of + f :: r -> + list MList.config f r - (listItem MLItem.config [ text "Nothing here, create one?" ]) - [] + _ -> + list MList.config + (listItem MLItem.config [ text "Nothing here, create one?" ]) + [] toTitle : Model -> String toTitle _ = "Home ⧽ Study" + type alias SerializableStudyDatapoint = { event : String , question : String @@ -304,29 +329,32 @@ type alias SerializableStudyDatapoint = , coder : String } + exportStudy : Id Db.Study String -> Db.Database -> String exportStudy id db = let - datapoints = Aquisition SerializableStudyDatapoint id - |> start (Value .study) db.events (Value .name) - |> move (Value .study) db.questionnaries (Raw Tuple.first) - |> add (Value .questionary) db.questions (Value .text) - -- |> addAttrList (Value .questionary) .questions (Value .input_ty) db (\_ -> ["Implement Me!"]) - |> move (Value .questionary) db.questions (Raw Tuple.first) - |> add (Value .question) db.answers (Value .value) - --|> moveReferenceList (Value .question) .answers (Raw Tuple.first) db - |> move (Value .question) db.coding_questionnaries (Raw Tuple.first) - |> add (Value .coding_questionary) db.coding_questions (Value .text) - |> move(Value .coding_questionary) db.coding_questions (Raw Tuple.first) - |> add (Value .coding_question) db.coding_answers (Value .value) - |> move (Value .coding_question) db.coding_answers (Raw Tuple.first) - |> move (Raw Tuple.first ) db.coding_answers (Raw (\(x,y) -> y.creator)) - |> add (Raw (\(x,y) -> y.creator)) db.users (Value (\x -> Maybe.withDefault "" x.name)) - |> end + datapoints = + Aquisition SerializableStudyDatapoint id + |> start (Value .study) db.events (Value .name) + |> move (Value .study) db.questionnaries (Raw Tuple.first) + |> add (Value .questionary) db.questions (Value .text) + -- |> addAttrList (Value .questionary) .questions (Value .input_ty) db (\_ -> ["Implement Me!"]) + |> move (Value .questionary) db.questions (Raw Tuple.first) + |> add (Value .question) db.answers (Value .value) + --|> moveReferenceList (Value .question) .answers (Raw Tuple.first) db + |> move (Value .question) db.coding_questionnaries (Raw Tuple.first) + |> add (Value .coding_questionary) db.coding_questions (Value .text) + |> move (Value .coding_questionary) db.coding_questions (Raw Tuple.first) + |> add (Value .coding_question) db.coding_answers (Value .value) + |> move (Value .coding_question) db.coding_answers (Raw Tuple.first) + |> move (Raw Tuple.first) db.coding_answers (Raw (\( x, y ) -> y.creator)) + |> add (Raw (\( x, y ) -> y.creator)) db.users (Value (\x -> Maybe.withDefault "" x.name)) + |> end in - List.map serializeStudyDatapoint datapoints + List.map serializeStudyDatapoint datapoints |> String.join "\n" + serializeStudyDatapoint : SerializableStudyDatapoint -> String serializeStudyDatapoint data = - String.join ";" [data.event,data.coder,data.question,data.answer,data.coding_question,data.coding_answer] \ No newline at end of file + String.join ";" [ data.event, data.coder, data.question, data.answer, data.coding_question, data.coding_answer ] diff --git a/src/Page/Top.elm b/src/Page/Top.elm index e96d948..565be80 100644 --- a/src/Page/Top.elm +++ b/src/Page/Top.elm @@ -10,23 +10,23 @@ import Html.Events import Identicon exposing (identicon) import Json.Decode import Material.Button as Button -import Material.Card as Card exposing (card, actions, block) +import Material.Card as Card exposing (actions, block, card) +import Material.Icon as Icon import Material.IconButton as IconButton -import Material.LayoutGrid as LG exposing (layoutGrid, cell) +import Material.LayoutGrid as LG exposing (cell, layoutGrid) import Material.List as MList import Material.List.Item as MLItem import Material.TabBar as TabBar import Material.Theme as Theme import Material.Typography as Typography -import Material.Icon as Icon import Msg import Page import Ports import Session import Type.Database as Db import Type.Database.TypeMatching as Match -import Type.IO.Setter as Updater import Type.IO.Internal as Id exposing (Id, box, unbox) +import Type.IO.Setter as Updater import Url.Builder import Utils exposing (..) import Viewer exposing (detailsConfig) @@ -63,8 +63,8 @@ page session = , view = view , toMsg = identity , -- header = Viewer.header, - subscriptions = Sub.none, - update = update + subscriptions = Sub.none + , update = update } in ( Page.Page model, Cmd.none ) @@ -76,12 +76,12 @@ page session = update : Msg.Msg -> Page.Page Model Msg.Msg -> ( Page.Page Model Msg.Msg, Cmd Msg.Msg ) update message (Page.Page model) = - let - session = - model.session - in case message of Msg.Top msg -> + let + session = + model.session + in case msg of Msg.NoOp -> ( Page.Page model, Cmd.none ) @@ -125,8 +125,6 @@ update message (Page.Page model) = in ( Page.Page { model | session = newSession }, Ports.clearLocalStorage () ) - - -- Msg.ChooseTab tab -> -- let -- oldPage = @@ -156,24 +154,26 @@ view (Page.Page model) = { detailsConfig | title = toTitle , top = True - , body = \_ -> - case model.session.user of - Just user -> - let - studies = - studyOverview user (Page.Page model) - in - if List.length studies > 0 then - [ layoutGrid [] <| [LG.inner [] <| - List.map (\x -> cell [] [ x ]) studies - ]] - - else - [ text "Create" - , Button.text - (Button.config - |> Button.setOnClick ( - + , body = + \_ -> + case model.session.user of + Just user -> + let + studies = + studyOverview user (Page.Page model) + in + if List.length studies > 0 then + [ layoutGrid [] <| + [ LG.inner [] <| + List.map (\x -> cell [] [ x ]) studies + ] + ] + + else + [ text "Create" + , Button.text + (Button.config + |> Button.setOnClick (Msg.CRUD (Msg.CreateRandom Db.StudyType [ \x -> @@ -189,26 +189,24 @@ view (Page.Page model) = ) ) ) - ) - - "Create" - ] + "Create" + ] - -- [tabbedView model.page] - -- let - -- relevant_codings = Db.database - -- in - -- [ - -- layoutGrid [] - -- [ Html.h2 [Typography.headline6] [text "Please choose your Coding:"] - -- , layoutGridCell [ LG.span4 ] [ viewCodingCard user model.session.db ] ] - -- ] - --[ layoutGridCell [][] - --] - Nothing -> - [ layoutGrid [] <| - [text "ye should not get here"] - ] + -- [tabbedView model.page] + -- let + -- relevant_codings = Db.database + -- in + -- [ + -- layoutGrid [] + -- [ Html.h2 [Typography.headline6] [text "Please choose your Coding:"] + -- , layoutGridCell [ LG.span4 ] [ viewCodingCard user model.session.db ] ] + -- ] + --[ layoutGridCell [][] + --] + Nothing -> + [ layoutGrid [] <| + [ text "ye should not get here" ] + ] , user = model.session.user } @@ -256,8 +254,6 @@ studyCard id study = -- ] - - viewCodingCard : String -> Db.Database -> Html Msg.Msg viewCodingCard user db = card Card.config @@ -301,8 +297,8 @@ viewCodingCard user db = "Visit" ] , icons = - [ Card.icon IconButton.config - <| IconButton.icon "favorite" + [ Card.icon IconButton.config <| + IconButton.icon "favorite" ] } } diff --git a/src/Page/User.elm b/src/Page/User.elm index 04d67bc..6c38e3f 100644 --- a/src/Page/User.elm +++ b/src/Page/User.elm @@ -1,12 +1,13 @@ -module Page.User exposing (Model, init, update, view, page) +module Page.User exposing (Model, init, page, update, view) import Browser import Html exposing (..) import Html.Attributes exposing (..) -import Session -import Viewer exposing (detailsConfig) import Msg exposing (UserMsg) import Page exposing (Page(..)) +import Session +import Viewer exposing (detailsConfig) + {- @@ -16,7 +17,7 @@ import Page exposing (Page(..)) type alias Model = - { user_id: Maybe Int + { user_id : Maybe Int } @@ -28,23 +29,25 @@ init : Maybe Int -> Model init user_id = Model user_id -page : Session.Session -> Maybe Int -> (Page.Page Model UserMsg, Cmd UserMsg ) + +page : Session.Session -> Maybe Int -> ( Page.Page Model UserMsg, Cmd UserMsg ) page session user_id = - let - model = - {session = session, - page = init user_id, - view = view, - toMsg = Msg.User, - subscriptions = Sub.none, - -- header = Viewer.header, - update = Page.liftupdate update} + let + model = + { session = session + , page = init user_id + , view = view + , toMsg = Msg.User + , subscriptions = Sub.none + , -- header = Viewer.header, + update = Page.liftupdate update + } in - (Page model, Cmd.none ) + ( Page model, Cmd.none ) --- UPDATE +-- UPDATE update : UserMsg -> Model -> ( Model, Cmd UserMsg ) @@ -60,21 +63,23 @@ update msg model = view : Page Model UserMsg -> Viewer.Details Msg.Msg view (Page model) = - { detailsConfig | title = toTitle model.page - , body = \_ -> - [ h1 [] [ text "elm-spa-boilerplate - Page With Subpage" ] - , div [ class "content" ] - [ h3 [] [ text "This is a page that can handle subpaths in its routing." ] - , h3 [] [ text <| "The current subpath is : /" ++ String.fromInt (Maybe.withDefault -1 model.page.user_id) ] - , div [] [ text "The subpath could be anything, or a specific type, like a string or integer. You can have many levels of subpaths if you wanted!" ] - , div [] - [ text " This demo accepts a single level subpath that can be any string. For example, " - , a [ href "/pagewithsubpage/xyz" ] [ text "/pagewithsubpage/xyz" ] + { detailsConfig + | title = toTitle model.page + , body = + \_ -> + [ h1 [] [ text "elm-spa-boilerplate - Page With Subpage" ] + , div [ class "content" ] + [ h3 [] [ text "This is a page that can handle subpaths in its routing." ] + , h3 [] [ text <| "The current subpath is : /" ++ String.fromInt (Maybe.withDefault -1 model.page.user_id) ] + , div [] [ text "The subpath could be anything, or a specific type, like a string or integer. You can have many levels of subpaths if you wanted!" ] + , div [] + [ text " This demo accepts a single level subpath that can be any string. For example, " + , a [ href "/pagewithsubpage/xyz" ] [ text "/pagewithsubpage/xyz" ] + ] + , div [] [ a [ href "/pagewithsubpage/a-wonderful-subpath" ] [ text "click here to go to a subpath" ] ] + , div [] [ a [ href "/pagewithsubpage/i-love-elm" ] [ text "click here to go to another subpath" ] ] + ] ] - , div [] [ a [ href "/pagewithsubpage/a-wonderful-subpath" ] [ text "click here to go to a subpath" ] ] - , div [] [ a [ href "/pagewithsubpage/i-love-elm" ] [ text "click here to go to another subpath" ] ] - ] - ] } diff --git a/src/Ports.elm b/src/Ports.elm index 095df37..0d563f0 100644 --- a/src/Ports.elm +++ b/src/Ports.elm @@ -1,8 +1,8 @@ -port module Ports exposing (clearLocalStorage, onLocalStorageChange, toLocalStorage, onDbChange, toDb) +port module Ports exposing (clearLocalStorage, onDbChange, onLocalStorageChange, toDb, toLocalStorage) import Json.Encode -import Type.LocalStorage import Type.Database +import Type.LocalStorage @@ -14,6 +14,8 @@ import Type.Database port onLocalStorageChange : (Json.Encode.Value -> msg) -> Sub msg + + port onDbChange : (Json.Encode.Value -> msg) -> Sub msg @@ -22,7 +24,9 @@ port onDbChange : (Json.Encode.Value -> msg) -> Sub msg port toLocalStorage : Type.LocalStorage.LocalStorage -> Cmd msg -port toDb : (Json.Encode.Value) -> Cmd msg + + +port toDb : Json.Encode.Value -> Cmd msg diff --git a/src/Session.elm b/src/Session.elm index ab90d39..8f34131 100644 --- a/src/Session.elm +++ b/src/Session.elm @@ -3,13 +3,13 @@ module Session exposing (Session, init) import Json.Decode import Time import Type.Database as Db -import Type.Flags import Type.Database.TypeMatching as Match +import Type.Flags import Type.IO.Internal exposing (Id) ---import Type.LocalStorage +--import Type.LocalStorage {- The session is used for any data that needs to be shared globally across all pages. All pages have the session in their model. You can use this to store info like credentials. @@ -24,6 +24,7 @@ type alias Session = , height : Int } , user : Maybe (Id Db.User String) + -- , localStorage : Maybe Type.LocalStorage.LocalStorage , db : Db.Database } @@ -43,19 +44,20 @@ init flags = posixTime = Time.millisToPosix flags.timeAppStarted - in case db of Ok storage -> let - user = Match.keys Db.UserType storage - |> \x -> case List.length x of - 1 -> - List.head x - _ -> - Nothing - - + user = + Match.keys Db.UserType storage + |> (\x -> + case List.length x of + 1 -> + List.head x + + _ -> + Nothing + ) in Session posixTime flags.windowSize Nothing storage diff --git a/src/TestDrawer.elm b/src/TestDrawer.elm index bb0ebfc..c6ec754 100644 --- a/src/TestDrawer.elm +++ b/src/TestDrawer.elm @@ -1,32 +1,33 @@ -module TestDrawer exposing (..) +module TestDrawer exposing (main) import Html exposing (text) import Html.Attributes exposing (style) import Material.Drawer.Modal as ModalDrawer exposing ( content - --, permanentDrawer - --, permanentDrawerConfig - --, modalDrawer - --, modalDrawerConfig + --, permanentDrawer + --, permanentDrawerConfig + --, modalDrawer + --, modalDrawerConfig , drawer - --, drawerScrim + --, drawerScrim ) - import Material.List exposing - ( list - , config + ( config + , list ) -import Material.List.Item exposing (listItem, config) +import Material.List.Item exposing (config, listItem) + + main = Html.div [] - [ drawer ModalDrawer.config - -- { - -- | open = True - -- , onClose = Nothing - -- } - [ content [] [] ] - , ModalDrawer.scrim [] [] - , Html.div [] [ text "Main Content" ] - ] \ No newline at end of file + [ drawer ModalDrawer.config + -- { + -- | open = True + -- , onClose = Nothing + -- } + [ content [] [] ] + , ModalDrawer.scrim [] [] + , Html.div [] [ text "Main Content" ] + ] diff --git a/src/Type/Database.elm b/src/Type/Database.elm index b8fb4ba..99e8d8e 100644 --- a/src/Type/Database.elm +++ b/src/Type/Database.elm @@ -1,11 +1,11 @@ -module Type.Database exposing (..) +module Type.Database exposing (Answer, AnswerView, Coder, CoderView, Coding, CodingAnswer, CodingAnswerView, CodingFrame, CodingFrameView, CodingQuestion, CodingQuestionView, CodingQuestionary, CodingQuestionaryView, CodingView, Database, DatabaseView, Event, EventView, InputTypeKind(..), Place, Question, QuestionView, Questionary, QuestionaryView, Row, Study, StudyView, Table, TableView, TestSubject, TestSubjectView, Timestamp, TimestampView, Type(..), User, answer, coder, coding, coding_answer, coding_frame, coding_question, coding_questionary, database, event, place, question, questionary, rows, study, table, test_subject, timestamp, updateEmpty, user) import Dict exposing (..) +import Tuple import Type.Database.InputType as IT import Type.IO exposing (..) import Type.IO.Encoder exposing (Encoder(..)) import Type.IO.Internal as Id exposing (Id) -import Tuple @@ -16,8 +16,10 @@ import Tuple type alias Table a = Dict String (Timestamp a) -type alias Row a = - (Id a String, Timestamp a) + +type alias Row a = + ( Id a String, Timestamp a ) + type alias TableView a = Dict String (TimestampView a) @@ -124,7 +126,7 @@ type alias CoderView = coder : IO Coder Database CoderView msg coder = entity Coder CoderView - |> reference "user" string .user .users Dict.get .value + |> reference "user" string .user .users Dict.get .value type alias Coding = @@ -145,6 +147,7 @@ coding = type alias CodingAnswer = { coding_question : Id CodingQuestion String + --, coding_frame : String , answer : Id Answer String , value : String @@ -153,6 +156,7 @@ type alias CodingAnswer = type alias CodingAnswerView = { coding_question : CodingQuestion + --, coding_frame : CodingFrame , answer : Answer , value : String @@ -346,6 +350,7 @@ type alias TestSubject = , infos : Dict String String } + type alias TestSubjectView = { id : String , event : Event @@ -442,8 +447,9 @@ type Type | TestSubjectType | InputTypeType InputTypeKind -type InputTypeKind = - ShortKind + +type InputTypeKind + = ShortKind | LongKind | ListKind @@ -452,7 +458,8 @@ updateEmpty : (a -> a) -> IO a b c msg -> IO a b c msg updateEmpty f prev = { prev | empty = f prev.empty } + rows : Table a -> List (Row a) -rows old = +rows old = Dict.toList old - |> List.map (Tuple.mapFirst Id.box) \ No newline at end of file + |> List.map (Tuple.mapFirst Id.box) diff --git a/src/Type/Database/Aquisition.elm b/src/Type/Database/Aquisition.elm index 5c60af5..3d5c61f 100644 --- a/src/Type/Database/Aquisition.elm +++ b/src/Type/Database/Aquisition.elm @@ -1,11 +1,9 @@ -module Type.Database.Aquisition exposing (..) +module Type.Database.Aquisition exposing (Aquisition, AttributeAccessor(..), add, addAttrList, addAttrSingle, aquire, end, filterBy, move, moveReferenceList, moveReferenceSingle, start, transformAccessor, updateReciever, updateReference) import Dict exposing (Dict) -import Type.Database as Db exposing (Database, Row, Table, Timestamp, Type(..)) +import Type.Database as Db exposing (Database, Row, Table, Timestamp, Type(..), coding_questionary) import Type.Database.TypeMatching as Match import Type.IO.Internal as Id exposing (Id) -import Type.Database exposing (coding_questionary) - type AttributeAccessor a b @@ -13,17 +11,27 @@ type AttributeAccessor a b | Value (a -> b) - type alias Aquisition a b c = { receiver : a , reference : Id b c } -start = addAttrSingle -add = addAttrList -move = moveReferenceList -end = aquire +start = + addAttrSingle + + +add = + addAttrList + + +move = + moveReferenceList + + +end = + aquire + {- |> addAttrList (Value .answer) .coding_question (Value .text) db identity @@ -44,7 +52,7 @@ updateReciever { receiver, reference } val = } -updateReference : Aquisition a b d -> Id c e -> (Aquisition a c e) +updateReference : Aquisition a b d -> Id c e -> Aquisition a c e updateReference { receiver, reference } val = { receiver = receiver, reference = val } @@ -64,14 +72,13 @@ transformAccessor accessor = f - addAttrList : AttributeAccessor c (Id d e) -> Table c -> AttributeAccessor c a -> List (Aquisition (a -> b) d e) -> List (Aquisition b d e) addAttrList attr table selectvalue aquisitions = List.concatMap (addAttrSingle attr table selectvalue) aquisitions addAttrSingle : - AttributeAccessor c (Id d e) + AttributeAccessor c (Id d e) -> Table c -> AttributeAccessor c a -> Aquisition (a -> b) d e @@ -83,16 +90,17 @@ addAttrSingle attr table selectvalue aquisition = selectf = transformAccessor selectvalue - in filterBy attrf table aquisition.reference |> List.map selectf |> List.map (updateReciever aquisition) + filterBy attr table old = table - |> Db.rows - |> List.filter (\x -> attr x == old) + |> Db.rows + |> List.filter (\x -> attr x == old) + moveReferenceList : AttributeAccessor c (Id a f) -> Table c -> AttributeAccessor c (Id b e) -> List (Aquisition d a f) -> List (Aquisition d b e) moveReferenceList attr table selectvalue aquisitions = @@ -101,7 +109,7 @@ moveReferenceList attr table selectvalue aquisitions = moveReferenceSingle : AttributeAccessor c (Id a f) - -> (Table c) + -> Table c -> AttributeAccessor c (Id b e) -> Aquisition d a f -> List (Aquisition d b e) @@ -112,9 +120,7 @@ moveReferenceSingle attr table selectvalue aquisition = selectf = transformAccessor selectvalue - in - filterBy attrf table aquisition.reference + filterBy attrf table aquisition.reference |> List.map selectf |> List.map (updateReference aquisition) - diff --git a/src/Type/Database/InputType.elm b/src/Type/Database/InputType.elm index 7cb161b..4bdf957 100644 --- a/src/Type/Database/InputType.elm +++ b/src/Type/Database/InputType.elm @@ -1,4 +1,4 @@ -module Type.Database.InputType exposing (..) +module Type.Database.InputType exposing (InputType(..), ListConfig, LongAnswerConfig, ShortAnswerConfig, SingleInputType(..), fromString, inputTypeDecoder, inputTypeEncoder, inputTypeForm, inputTypeFuzzer, inputTypeToString, inputTypeUpdater, inputTypes, input_type, listConfig, longAnswerConfig, shortAnswerConfig, singleInputType, singleInputTypeDecoder, singleInputTypeEncoder, singleInputTypeForm, singleInputTypeToString, singleInputTypeUpdater, toString, updateEmpty) import Dict exposing (Dict) import Fuzz @@ -7,24 +7,25 @@ import Json.Encode import Type.IO exposing (..) import Type.IO.Encoder as Encoder exposing (Encoder(..)) import Type.IO.Form as Form exposing (Form) -import Type.IO.ToString as ToString exposing (ToString) import Type.IO.Setter as Updater exposing (Updater) - - +import Type.IO.ToString as ToString exposing (ToString) type InputType = ShortAnswer ShortAnswerConfig | LongAnswer LongAnswerConfig | List ListConfig - -- | DropDown (List String) - -- | LinearScale (Dict Int String) - -- | Matrix SingleInputType (List String) (List String) + + + +-- | DropDown (List String) +-- | LinearScale (Dict Int String) +-- | Matrix SingleInputType (List String) (List String) type SingleInputType - = Radio - | Box + = Radio + | Box type alias ShortAnswerConfig = @@ -45,6 +46,7 @@ shortAnswerConfig = |> attribute "maxLength" (maybe int) .maxLength |> attribute "pattern" (maybe string) .pattern + type alias LongAnswerConfig = { label : Maybe String , placeholder : Maybe String @@ -67,12 +69,13 @@ longAnswerConfig = |> attribute "rows" (maybe int) .rows |> attribute "cols" (maybe int) .cols + singleInputType : IO SingleInputType db SingleInputType msg singleInputType = { decoder = singleInputTypeDecoder , strDecoder = \_ -> singleInputTypeDecoder , encoder = singleInputTypeEncoder - , fuzzer = Fuzz.oneOf [Fuzz.constant Box, Fuzz.constant Radio] + , fuzzer = Fuzz.oneOf [ Fuzz.constant Box, Fuzz.constant Radio ] , toString = singleInputTypeToString , viewer = \_ full -> Just full , empty = Box @@ -81,21 +84,25 @@ singleInputType = , updater = singleInputTypeUpdater } + singleInputTypeDecoder : Json.Decode.Decoder SingleInputType singleInputTypeDecoder = let - helper name = case name of - "radio" -> - Json.Decode.succeed Radio - - "box" -> - Json.Decode.succeed Box - _ -> - Json.Decode.fail <| "I need either radio or box, but i got" ++ name + helper name = + case name of + "radio" -> + Json.Decode.succeed Radio + + "box" -> + Json.Decode.succeed Box + + _ -> + Json.Decode.fail <| "I need either radio or box, but i got" ++ name in - Json.Decode.string + Json.Decode.string |> Json.Decode.andThen helper + singleInputTypeEncoder : Encoder SingleInputType singleInputTypeEncoder = SingleEncoder <| @@ -103,53 +110,56 @@ singleInputTypeEncoder = case value of Box -> Json.Encode.string "box" + Radio -> Json.Encode.string "radio" + singleInputTypeToString : ToString SingleInputType -singleInputTypeToString name value = +singleInputTypeToString name value = case value of Box -> Ok "box" - + Radio -> Ok "radio" + singleInputTypeForm : Form SingleInputType msg singleInputTypeForm name callback kind label f = case kind of Box -> Ok <| f "box" (callback << Form.StringMsg << Just) + Radio -> Ok <| f "radio" (callback << Form.StringMsg << Just) + singleInputTypeUpdater : Updater SingleInputType singleInputTypeUpdater msg val = case msg of Updater.StringMsg "box" -> Ok Box + Updater.StringMsg "radio" -> Ok Radio + _ -> Err Updater.InvalidValue - - type alias ListConfig = - { - singleInput : SingleInputType, - choices : List String + { singleInput : SingleInputType + , choices : List String } listConfig : IO ListConfig db ListConfig msg -listConfig = +listConfig = entity ListConfig ListConfig - |> substruct "singleInput" singleInputType .singleInput - |> attribute "choices" (list string) .choices - |> updateEmpty (\x -> {x | choices = ["Unnamed Choice"]}) - + |> substruct "singleInput" singleInputType .singleInput + |> attribute "choices" (list string) .choices + |> updateEmpty (\x -> { x | choices = [ "Unnamed Choice" ] }) inputTypes : List InputType @@ -158,6 +168,7 @@ inputTypes = , LongAnswer longAnswerConfig.empty , List <| ListConfig Radio [] , List <| ListConfig Box [] + -- , DropDown [] -- , LinearScale Dict.empty -- , Matrix Radio [] [] @@ -174,24 +185,24 @@ toString kind = LongAnswer _ -> "Long Answer" - List {singleInput, choices} -> + List { singleInput, choices } -> case singleInput of Radio -> "Multiple Choice" + Box -> "Boxes" - -- DropDown _ -> - -- "DropDown Menu" - -- LinearScale _ -> - -- "Linear Scale" - -- Matrix Radio _ _ -> - -- "Grid of Multiple Choices" - - -- Matrix Box _ _ -> - -- "Grid of Boxes" +-- DropDown _ -> +-- "DropDown Menu" +-- LinearScale _ -> +-- "Linear Scale" +-- Matrix Radio _ _ -> +-- "Grid of Multiple Choices" +-- Matrix Box _ _ -> +-- "Grid of Boxes" fromString : String -> Maybe InputType @@ -204,23 +215,19 @@ fromString name = Just (LongAnswer longAnswerConfig.empty) "Multiple Choice" -> - Just <| List <| ListConfig Radio ["Unnamed Choice"] + Just <| List <| ListConfig Radio [ "Unnamed Choice" ] "Boxes" -> - Just <| List <| ListConfig Box ["Unnamed Choice"] + Just <| List <| ListConfig Box [ "Unnamed Choice" ] -- "DropDown Menu" -> -- Just <| DropDown [] - -- "Linear Scale" -> -- Just <| LinearScale Dict.empty - -- "Grid of Multiple Choices" -> -- Just <| Matrix Radio [] [] - -- "Grid of Boxes" -> -- Just <| Matrix Box [] [] - _ -> Nothing @@ -244,121 +251,135 @@ input_type = , updater = inputTypeUpdater } + inputTypeDecoder : Json.Decode.Decoder InputType inputTypeDecoder = Json.Decode.oneOf - [ - Json.Decode.map LongAnswer longAnswerConfig.decoder, - Json.Decode.map ShortAnswer shortAnswerConfig.decoder, - Json.Decode.map List listConfig.decoder + [ Json.Decode.map LongAnswer longAnswerConfig.decoder + , Json.Decode.map ShortAnswer shortAnswerConfig.decoder + , Json.Decode.map List listConfig.decoder ] + inputTypeEncoder : Encoder InputType -inputTypeEncoder = +inputTypeEncoder = SingleEncoder <| - \value -> + \value -> case value of ShortAnswer v -> Encoder.collapseEncoder shortAnswerConfig.encoder v + LongAnswer v -> Encoder.collapseEncoder longAnswerConfig.encoder v + List v -> Encoder.collapseEncoder listConfig.encoder v - -inputTypeFuzzer : Fuzz.Fuzzer InputType + +inputTypeFuzzer : Fuzz.Fuzzer InputType inputTypeFuzzer = Fuzz.oneOf - [ - Fuzz.map ShortAnswer shortAnswerConfig.fuzzer, - Fuzz.map LongAnswer longAnswerConfig.fuzzer, - Fuzz.map List listConfig.fuzzer - ] - + [ Fuzz.map ShortAnswer shortAnswerConfig.fuzzer + , Fuzz.map LongAnswer longAnswerConfig.fuzzer + , Fuzz.map List listConfig.fuzzer + ] + + inputTypeToString : ToString InputType inputTypeToString name value = case value of ShortAnswer v -> shortAnswerConfig.toString name v + LongAnswer v -> longAnswerConfig.toString name v + List v -> listConfig.toString name v + inputTypeForm : Form InputType msg inputTypeForm name callback kind = case kind of ShortAnswer v -> shortAnswerConfig.form name callback v - + LongAnswer v -> longAnswerConfig.form name callback v - + List v -> listConfig.form name callback v - + + inputTypeUpdater : Updater InputType inputTypeUpdater msg val = case msg of Updater.Custom kind mbMsg -> case kind of "Short Answer" -> - case (val, mbMsg) of - (ShortAnswer v, Just msg_) -> + case ( val, mbMsg ) of + ( ShortAnswer v, Just msg_ ) -> Result.map ShortAnswer <| shortAnswerConfig.updater msg_ v - (ShortAnswer _, Nothing) -> + + ( ShortAnswer _, Nothing ) -> Ok val - (_, Just msg_) -> + + ( _, Just msg_ ) -> Result.map ShortAnswer <| shortAnswerConfig.updater msg_ shortAnswerConfig.empty - (_, Nothing) -> + + ( _, Nothing ) -> Ok <| ShortAnswer shortAnswerConfig.empty + "Long Answer" -> - case (val, mbMsg) of - (LongAnswer v, Just msg_) -> + case ( val, mbMsg ) of + ( LongAnswer v, Just msg_ ) -> Result.map LongAnswer <| longAnswerConfig.updater msg_ v - (LongAnswer _, Nothing) -> + + ( LongAnswer _, Nothing ) -> Ok val - (_, Just msg_) -> + + ( _, Just msg_ ) -> Result.map LongAnswer <| longAnswerConfig.updater msg_ longAnswerConfig.empty - (_, Nothing) -> + + ( _, Nothing ) -> Ok <| LongAnswer longAnswerConfig.empty + s -> Err <| Updater.CustomError <| "Incorrect string: " ++ s - {- case (kind, val, mbMsg) of - ("Multiple Choice", List v, Just msg_) -> - Result.map List <| listConfig.updater msg_ {v | singleInput = Radio} - ("Multiple Choice", List v, Nothing) -> - Ok <| List {v | singleInput = Radio} - ("Multiple Choice", _, Just msg_) -> - Result.map List <| listConfig.updater msg_ <| ListConfig Radio ["Unnamed Choice"] - ("Multiple Choice", _, Nothing) -> - Ok <| List <| ListConfig Radio ["Unnamed Choice"] - ("Boxes", List v, Just msg_) -> - Result.map List <| listConfig.updater msg_ {v | singleInput = Box} - ("Boxes", List v, Nothing) -> - Ok <| List <| {v |singleInput = Box} - ("Boxes", _, Just msg_) -> - Result.map List <| listConfig.updater msg_ <| ListConfig Box ["Unnamed Choice"] - ("Boxes", _, Nothing) -> - Ok <| List <| ListConfig Box ["Unnamed Choice"] - _ -> - Err Updater.InvalidValue -} + {- case (kind, val, mbMsg) of + ("Multiple Choice", List v, Just msg_) -> + Result.map List <| listConfig.updater msg_ {v | singleInput = Radio} + ("Multiple Choice", List v, Nothing) -> + Ok <| List {v | singleInput = Radio} + ("Multiple Choice", _, Just msg_) -> + Result.map List <| listConfig.updater msg_ <| ListConfig Radio ["Unnamed Choice"] + ("Multiple Choice", _, Nothing) -> + Ok <| List <| ListConfig Radio ["Unnamed Choice"] + ("Boxes", List v, Just msg_) -> + Result.map List <| listConfig.updater msg_ {v | singleInput = Box} + ("Boxes", List v, Nothing) -> + Ok <| List <| {v |singleInput = Box} + ("Boxes", _, Just msg_) -> + Result.map List <| listConfig.updater msg_ <| ListConfig Box ["Unnamed Choice"] + ("Boxes", _, Nothing) -> + Ok <| List <| ListConfig Box ["Unnamed Choice"] + _ -> + Err Updater.InvalidValue + -} Updater.AttributeMsg name msg_ -> case val of ShortAnswer v -> Result.map ShortAnswer <| shortAnswerConfig.updater msg v + LongAnswer v -> Result.map LongAnswer <| longAnswerConfig.updater msg v + List v -> Result.map List <| listConfig.updater msg v - _ -> Err <| Updater.CustomError <| "Tried to update an InputType without using Custom" - - - updateEmpty : (a -> a) -> IO a b c msg -> IO a b c msg diff --git a/src/Type/Database/TypeMatching.elm b/src/Type/Database/TypeMatching.elm index 8108b56..8f8c45e 100644 --- a/src/Type/Database/TypeMatching.elm +++ b/src/Type/Database/TypeMatching.elm @@ -1,4 +1,4 @@ -module Type.Database.TypeMatching exposing (..) +module Type.Database.TypeMatching exposing (DispatchType(..), FieldConfig, FieldUpdateConfig, concatTupleFirst, concatTupleLast, delete, dispatchDb, fields, filterBy, forms, fromString, getField, getTimestampUpdaterMsg, join, keys, new, resolveAttributes, setField, setFieldRaw, setManyFields, setTimestamp, swapFields, toString, toStringPlural, types, updateField) import Dict exposing (..) import Html exposing (Html) @@ -6,11 +6,10 @@ import Msg import Task exposing (perform) import Time exposing (Posix, now, posixToMillis) import Type.Database as Db exposing (..) +import Type.Database.InputType as IT exposing (InputType, input_type) import Type.IO.Form as Form exposing (UpdateMsg(..)) -import Type.IO.Setter as Updater import Type.IO.Internal as Id exposing (Id, unbox) -import Type.Database.InputType exposing (InputType) -import Type.Database.InputType as IT exposing (input_type) +import Type.IO.Setter as Updater types : List Type @@ -71,10 +70,10 @@ fromString name = "user" -> Just UserType - + "input_type" -> Just (InputTypeType ShortKind) - + "test_subject" -> Just TestSubjectType @@ -120,10 +119,10 @@ toString kind = UserType -> "user" - + TestSubjectType -> "test_subject" - + InputTypeType _ -> "input_type" @@ -166,10 +165,10 @@ toStringPlural kind = UserType -> "users" - + TestSubjectType -> "test_subjects" - + InputTypeType _ -> "input_types" @@ -212,10 +211,10 @@ fields kind = UserType -> user.fields - + TestSubjectType -> test_subject.fields - + InputTypeType _ -> input_type.fields @@ -262,7 +261,7 @@ keys kind db = UserType -> g db.users - + TestSubjectType -> g db.test_subjects @@ -325,34 +324,39 @@ forms id kind acc db f = TestSubjectType -> g test_subject db.test_subjects - + InputTypeType _ -> g input_type db.input_types -type DispatchType = - New (Id Db.User String) + +type DispatchType + = New (Id Db.User String) | Delete + new : Id a String -> Type -> Id Db.User String -> Database -> Database -new id kind u db= +new id kind u db = dispatchDb (New u) id kind db + delete : Id a String -> Type -> Database -> Database delete = dispatchDb Delete + dispatchDb : DispatchType -> Id a String -> Type -> Database -> Database dispatchDb dt id kind db = let g table def update = - let - config = - (timestamp def).empty - in - update db <| + update db <| case dt of New u -> + let + config = + (timestamp def).empty + in Dict.insert (unbox id) { config | creator = u } table + Delete -> Dict.remove (unbox id) table in @@ -394,22 +398,28 @@ dispatchDb dt id kind db = g db.users user (\t x -> { t | users = x }) TestSubjectType -> - g db.test_subjects test_subject (\t x -> {t | test_subjects = x}) + g db.test_subjects test_subject (\t x -> { t | test_subjects = x }) InputTypeType it -> case it of ShortKind -> - g db.input_types input_type (\t x -> {t | input_types = x}) + g db.input_types input_type (\t x -> { t | input_types = x }) + LongKind -> - g db.input_types {input_type|empty = IT.LongAnswer IT.longAnswerConfig.empty} (\t x -> {t | input_types = x}) + g db.input_types { input_type | empty = IT.LongAnswer IT.longAnswerConfig.empty } (\t x -> { t | input_types = x }) + ListKind -> - g db.input_types {input_type|empty = IT.List IT.listConfig.empty} (\t x -> {t | input_types = x}) + g db.input_types { input_type | empty = IT.List IT.listConfig.empty } (\t x -> { t | input_types = x }) + + {- getReferenceHolder : (Type, String) -> Database -> List (Type, String) -getReferenceHolder (kind,id) db = - case kind of - AnswerType -> - CodingAnswer -} + getReferenceHolder (kind,id) db = + case kind of + AnswerType -> + CodingAnswer +-} + getField : String -> String -> Type -> Database -> Maybe String getField id fname kind db = @@ -428,62 +438,65 @@ getTimestampUpdaterMsg kind id attribute time = posixToMillis time - setTimestamp : Type -> String -> String -> Cmd Msg.Msg setTimestamp kind id attribute = getTimestampUpdaterMsg kind id attribute |> (\x -> perform x now) + filterBy : (Row b -> Id a c) -> (Database -> Table b) -> Database -> Id a c -> List (Row b) filterBy attr dbgetter db old = dbgetter db - |> Db.rows - |> List.filter (\x -> attr x == old) + |> Db.rows + |> List.filter (\x -> attr x == old) -resolveAttributes : (a -> Id b String) -> (Database -> Table b) -> Database -> Row a -> List (Row a, Row b) -resolveAttributes attr dbgetter db (oldid,fullold) = +resolveAttributes : (a -> Id b String) -> (Database -> Table b) -> Database -> Row a -> List ( Row a, Row b ) +resolveAttributes attr dbgetter db ( oldid, fullold ) = let - f id = dbgetter db - |> Db.rows - |> List.filter (\(cid, _) -> cid == id) + f id = + dbgetter db + |> Db.rows + |> List.filter (\( cid, _ ) -> cid == id) in - (oldid,fullold) - |> (\(id, value) -> ((id, value),(f (attr value.value)))) - |> (\(oldval, list) -> List.map (\newval -> (oldval,newval)) list) - - + ( oldid, fullold ) + |> (\( id, value ) -> ( ( id, value ), f (attr value.value) )) + |> (\( oldval, list ) -> List.map (\newval -> ( oldval, newval )) list) -join : (Row b -> Id a String) -> (Database -> Table b) -> Database -> List (Row a ) -> List ((Row a),(Row b)) +join : (Row b -> Id a String) -> (Database -> Table b) -> Database -> List (Row a) -> List ( Row a, Row b ) join attr dbgetter db old = let - k = List.map (\(id, value) -> id) old + k = + List.map (\( id, value ) -> id) old in old - |> List.map (\(id, value) -> ((id, value),(filterBy attr dbgetter db id))) - |> List.map (\(oldval, list) -> List.map (\newval -> (oldval,newval)) list) - |> List.concat - -concatTupleFirst : (List a, b) -> List (a, b) -concatTupleFirst (l,elem) = - List.map (\x -> (x, elem)) l - -concatTupleLast : (a, List b) -> List (a, b) -concatTupleLast (elem, l) = - List.map (\x -> (elem, x)) l + |> List.map (\( id, value ) -> ( ( id, value ), filterBy attr dbgetter db id )) + |> List.map (\( oldval, list ) -> List.map (\newval -> ( oldval, newval )) list) + |> List.concat + + +concatTupleFirst : ( List a, b ) -> List ( a, b ) +concatTupleFirst ( l, elem ) = + List.map (\x -> ( x, elem )) l + + +concatTupleLast : ( a, List b ) -> List ( a, b ) +concatTupleLast ( elem, l ) = + List.map (\x -> ( elem, x )) l + type alias FieldConfig a b = - { - kind : Type, - attribute : String, - setter : (a -> Updater.Msg), - id : Id b String, - value : a + { kind : Type + , attribute : String + , setter : a -> Updater.Msg + , id : Id b String + , value : a } + setField : FieldConfig a b -> Msg.Msg -setField {kind, attribute, setter, id, value} = +setField { kind, attribute, setter, id, value } = Msg.CRUD <| Msg.Update <| Updater.AttributeMsg (toStringPlural kind) <| @@ -492,30 +505,32 @@ setField {kind, attribute, setter, id, value} = Updater.AttributeMsg attribute <| setter value + setManyFields : List (FieldConfig a b) -> Msg.Msg setManyFields f = List.map setFieldRaw f - |> Msg.UpdateAll - |> Msg.CRUD + |> Msg.UpdateAll + |> Msg.CRUD + setFieldRaw : FieldConfig a b -> Updater.Msg -setFieldRaw {kind, attribute, setter, id, value} = +setFieldRaw { kind, attribute, setter, id, value } = + Updater.AttributeMsg (toStringPlural kind) <| + Updater.DictKeyMsg (unbox id) <| + Updater.AttributeMsg "value" <| + Updater.AttributeMsg attribute <| + setter value - Updater.AttributeMsg (toStringPlural kind) <| - Updater.DictKeyMsg (unbox id) <| - Updater.AttributeMsg "value" <| - Updater.AttributeMsg attribute <| - setter value type alias FieldUpdateConfig a = - { - kind : Type, - attribute : String, - setter : ((a -> a) -> Updater.Msg), - id : String + { kind : Type + , attribute : String + , setter : (a -> a) -> Updater.Msg + , id : String } -updateField : FieldUpdateConfig a -> (a -> a)-> Updater.Msg + +updateField : FieldUpdateConfig a -> (a -> a) -> Updater.Msg updateField config updater = Updater.AttributeMsg (toStringPlural config.kind) <| Updater.DictKeyMsg config.id <| @@ -523,21 +538,25 @@ updateField config updater = Updater.AttributeMsg config.attribute <| config.setter updater + + -- go down and get value via update -swapFields : Type -> String -> (a -> Updater.Msg) -> (Id b String, Id b String) -> (a, a) -> Msg.Msg -swapFields kind attribute setter (f_id,s_id) (f_val, s_val) = + +swapFields : Type -> String -> (a -> Updater.Msg) -> ( Id b String, Id b String ) -> ( a, a ) -> Msg.Msg +swapFields kind attribute setter ( f_id, s_id ) ( f_val, s_val ) = Msg.CRUD <| Msg.UpdateAll - [ - setFieldRaw - {kind = kind, attribute = attribute, setter = setter, id = f_id, value = s_val} - , setFieldRaw - {kind = kind, attribute = attribute, setter = setter, id = s_id, value = f_val} + [ setFieldRaw + { kind = kind, attribute = attribute, setter = setter, id = f_id, value = s_val } + , setFieldRaw + { kind = kind, attribute = attribute, setter = setter, id = s_id, value = f_val } ] + + -- swapFields : FieldUpdateConfig a -> FieldUpdateConfig a -> Database -> Database --- swapFields first second db = +-- swapFields first second db = -- let -- firstMsg x = database.updater (updateField first x) db -- secondMsg y = database.updater (updateField second y) db diff --git a/src/Type/Entity.elm b/src/Type/Entity.elm index d641432..966e761 100644 --- a/src/Type/Entity.elm +++ b/src/Type/Entity.elm @@ -1,4 +1,4 @@ -module Type.Entity exposing (..) +module Type.Entity exposing (Encoder, Entity(..), IO, Parser, RecordBuilder, RecordEncoder, TypeBuilder, View, adapt_encoder, adapt_toString, encode, finish, int, int_io, match_encoder, match_model, maybe, new, string) import Dict exposing (Dict) import Html exposing (Html) @@ -35,13 +35,11 @@ int_io = -- int_view = -- { -- entity= Type { - -- }, -- translate = {} -- } - type alias Encoder a = a -> Json.Encode.Value diff --git a/src/Type/Graph.elm b/src/Type/Graph.elm index 0f2c34c..cd5f7fa 100644 --- a/src/Type/Graph.elm +++ b/src/Type/Graph.elm @@ -1,14 +1,16 @@ -module Type.Graph exposing (..) +module Type.Graph exposing (DataView, Decoder) import Dict exposing (Dict) import Json.Decode -type alias Decoder container decoded - = { - container | decode : Json.Decode.Decoder decoded + +type alias Decoder container decoded = + { container + | decode : Json.Decode.Decoder decoded + } + + +type alias DataView container source mediator target = + { container + | view : source -> mediator -> target } - -type alias DataView container source mediator target - = { - container | view : (source -> mediator -> target) - } \ No newline at end of file diff --git a/src/Type/IO.elm b/src/Type/IO.elm index d780313..a31b2e7 100644 --- a/src/Type/IO.elm +++ b/src/Type/IO.elm @@ -1,4 +1,4 @@ -module Type.IO exposing (..) +module Type.IO exposing (DatatypeIO, IO, PartialIO, Reference(..), array, attribute, bool, dict, encode, entity, float, form2update, int, list, map_decoder_maybe, map_maybe_func, maybe, reference, reference_fuzzer, references, result, string, substruct) import Array exposing (Array) import Dict exposing (Dict) @@ -8,9 +8,9 @@ import Json.Encode import Type.IO.Decoder as Decoder exposing (Decoder) import Type.IO.Encoder as Encoder exposing (Encoder) import Type.IO.Form as Form exposing (Form) -import Type.IO.ToString as ToString exposing (ToString) -import Type.IO.Setter as Update exposing (PartialUpdater) import Type.IO.Internal as Id exposing (Id) +import Type.IO.Setter as Update exposing (PartialUpdater) +import Type.IO.ToString as ToString exposing (ToString) import Type.IO.Viewer as Viewer exposing (Viewer) @@ -27,6 +27,7 @@ type alias PartialIO delta full db view msg = , updater : PartialUpdater full delta } + type alias IO kind db view msg = PartialIO kind kind db view msg @@ -220,12 +221,12 @@ reference : -> (db -> f) -- lookup -> (comparable -> f -> Maybe d) -- MaybeGetter -> (d -> a) - -> PartialIO ((Id g comparable) -> b) c db (a -> e) msg -- Old Entity + -> PartialIO (Id g comparable -> b) c db (a -> e) msg -- Old Entity -> PartialIO b c db e msg reference name def getter lookup foreigngetter post parent = { decoder = Decoder.reference name (Json.Decode.map Id.box def.decoder) parent.decoder , strDecoder = \a -> Decoder.reference name (Json.Decode.map Id.box (def.strDecoder a)) (parent.strDecoder a) - , encoder = Encoder.reference name getter def.encoder parent.encoder + , encoder = Encoder.reference name getter def.encoder parent.encoder , toString = ToString.reference name getter def.toString parent.toString , fuzzer = Fuzz.andMap (Fuzz.map Id.box def.fuzzer) parent.fuzzer , viewer = Viewer.reference getter lookup foreigngetter post parent.viewer @@ -250,7 +251,7 @@ references name def getter lookup foreigngetter post parent = , strDecoder = \a -> Decoder.references name (def.strDecoder a) (parent.strDecoder a) , encoder = Encoder.references name getter def.encoder parent.encoder , toString = ToString.references name getter def.toString parent.toString - , fuzzer = Fuzz.andMap (Fuzz.list def.fuzzer) parent.fuzzer + , fuzzer = Fuzz.andMap (Fuzz.list def.fuzzer) parent.fuzzer , viewer = Viewer.references getter lookup foreigngetter post parent.viewer , empty = parent.empty (list def).empty , fields = parent.fields ++ [ name ] @@ -290,59 +291,73 @@ map_maybe_func : (Maybe delta -> target) -> delta -> target map_maybe_func func val = func (Just val) -form2update : Form.UpdateMsg -> Maybe (Update.Msg) + +form2update : Form.UpdateMsg -> Maybe Update.Msg form2update fmsg = case fmsg of Form.IntMsg Nothing -> Nothing + Form.IntMsg (Just val) -> Just (Update.IntMsg val) + Form.StringMsg Nothing -> Nothing + Form.StringMsg (Just val) -> Just (Update.StringMsg val) + Form.FloatMsg Nothing -> Nothing + Form.FloatMsg (Just val) -> Just (Update.FloatMsg val) + Form.BoolMsg _ -> Just (Update.BoolUpdateMsg not) + Form.ListMsg index msg -> case form2update msg of Just msg_ -> Just (Update.ListUpdateMsg index msg_) + Nothing -> Nothing + Form.ArrayMsg index msg -> case form2update msg of Just msg_ -> Just (Update.ArrayUpdateIndexMsg index msg_) + Nothing -> Nothing + Form.MaybeMsg msg -> Just (Update.MaybeUpdateMsg (form2update msg)) + Form.DictMsg key msg -> - case (form2update msg, key) of - (Just msg_, Just key_) -> + case ( form2update msg, key ) of + ( Just msg_, Just key_ ) -> Just (Update.DictKeyMsg key_ msg_) - (_, _) -> + + ( _, _ ) -> Nothing + Form.ResultMsg state msg -> - case (state, form2update msg) of - (Form.ErrForm , Just val) -> + case ( state, form2update msg ) of + ( Form.ErrForm, Just val ) -> Just (Update.ResultErrMsg val) - (Form.OkForm, Just val) -> + + ( Form.OkForm, Just val ) -> Just (Update.ResultOkMsg val) - _ -> + + _ -> Nothing + Form.AttrMsg name msg -> case form2update msg of Just val -> Just (Update.AttributeMsg name val) + Nothing -> Nothing - - - - - \ No newline at end of file diff --git a/src/Type/IO/Decoder.elm b/src/Type/IO/Decoder.elm index 357cbc2..a7f79d2 100644 --- a/src/Type/IO/Decoder.elm +++ b/src/Type/IO/Decoder.elm @@ -1,51 +1,69 @@ -module Type.IO.Decoder exposing (..) +module Type.IO.Decoder exposing (Decoder, array, attribute, bool, decodeDictFromTuples, dict, entity, float, int, list, maybe, reference, references, result, string, substruct) +import Array exposing (Array) +import Dict exposing (Dict) import Json.Decode exposing (Decoder, map, null, nullable, succeed) -import Json.Decode.Pipeline exposing (required) import Json.Decode.Extra -import Dict exposing (Dict) -import Array exposing (Array) +import Json.Decode.Pipeline exposing (required) + type alias Decoder a = Json.Decode.Decoder a + int : Decoder Int -int = Json.Decode.int +int = + Json.Decode.int + string : Decoder String -string = Json.Decode.string +string = + Json.Decode.string + float : Decoder Float -float = Json.Decode.float +float = + Json.Decode.float + bool : Decoder Bool -bool = Json.Decode.bool +bool = + Json.Decode.bool + maybe : Decoder a -> Decoder (Maybe a) -maybe = Json.Decode.nullable +maybe = + Json.Decode.nullable + list : Decoder a -> Decoder (List a) -list = Json.Decode.list +list = + Json.Decode.list + dict : (String -> Decoder comparable) -> Decoder a -> Decoder (Dict comparable a) -dict key value = +dict key value = Json.Decode.keyValuePairs value |> Json.Decode.andThen (decodeDictFromTuples key) - -- let - -- decodeToMaybe : Decoder comparable -> ( String, b ) -> Maybe ( comparable, b ) - -- decodeToMaybe d ( s, obj ) = - -- Json.Decode.decodeString d s - -- |> Result.toMaybe - -- |> Maybe.map (\x -> ( x, obj )) - -- in - -- Json.Decode.keyValuePairs value - -- |> Json.Decode.map (List.filterMap (decodeToMaybe key)) - -- |> Json.Decode.map Dict.fromList + + +-- let +-- decodeToMaybe : Decoder comparable -> ( String, b ) -> Maybe ( comparable, b ) +-- decodeToMaybe d ( s, obj ) = +-- Json.Decode.decodeString d s +-- |> Result.toMaybe +-- |> Maybe.map (\x -> ( x, obj )) +-- in +-- Json.Decode.keyValuePairs value +-- |> Json.Decode.map (List.filterMap (decodeToMaybe key)) +-- |> Json.Decode.map Dict.fromList + + decodeDictFromTuples : - (String -> Decoder comparable) -> - List (String, v) -> - Decoder (Dict comparable v) + (String -> Decoder comparable) + -> List ( String, v ) + -> Decoder (Dict comparable v) decodeDictFromTuples keyDecoder tuples = case tuples of [] -> @@ -62,28 +80,41 @@ decodeDictFromTuples keyDecoder tuples = Ok key -> decodeDictFromTuples keyDecoder rest |> Json.Decode.andThen (Dict.insert key value >> succeed) + Err _ -> Json.Decode.fail (Json.Decode.errorToString error) - result : Decoder err -> Decoder a -> Decoder (Result err a) -result _ val = Json.Decode.map (\x -> Ok x) val +result _ val = + Json.Decode.map (\x -> Ok x) val + array : Decoder a -> Decoder (Array a) -array = Json.Decode.array +array = + Json.Decode.array + entity : a -> Decoder a -entity = Json.Decode.succeed +entity = + Json.Decode.succeed + attribute : String -> Decoder a -> Decoder (a -> b) -> Decoder b -attribute name child parent = parent |> required name child +attribute name child parent = + parent |> required name child + + +reference : String -> Decoder a -> Decoder (a -> b) -> Decoder b +reference = + attribute -reference : String -> Decoder a -> Decoder (a -> b) -> Decoder b -reference = attribute references : String -> Decoder a -> Decoder (List a -> b) -> Decoder b -references name child parent = parent |> required name (Json.Decode.list child) +references name child parent = + parent |> required name (Json.Decode.list child) + substruct : String -> Decoder a -> Decoder (a -> b) -> Decoder b -substruct = attribute \ No newline at end of file +substruct = + attribute diff --git a/src/Type/IO/Encoder.elm b/src/Type/IO/Encoder.elm index 77ffcfa..ef71ecb 100644 --- a/src/Type/IO/Encoder.elm +++ b/src/Type/IO/Encoder.elm @@ -1,4 +1,4 @@ -module Type.IO.Encoder exposing (..) +module Type.IO.Encoder exposing (Encoder(..), array, attribute, bool, collapseEncoder, dict, entity, float, getMaybeOut, int, list, listToSingle, maybe, reference, references, result, string, substruct) import Array exposing (Array) import Dict exposing (Dict) @@ -136,7 +136,7 @@ reference name getter def parent = ListEncoder e -> ( name - , collapseEncoder (ListEncoder e) (Id.unbox(getter x)) + , collapseEncoder (ListEncoder e) (Id.unbox (getter x)) ) ) :: pe @@ -152,15 +152,17 @@ references name getter def parent = ListEncoder pe -> ListEncoder ((\x -> - case def of + case def of SingleEncoder e -> ( name , Json.Encode.list e (getter x) ) + ListEncoder e -> ( name - , Json.Encode.list (collapseEncoder (ListEncoder e)) (getter x)) + , Json.Encode.list (collapseEncoder (ListEncoder e)) (getter x) ) + ) :: pe ) diff --git a/src/Type/IO/Form.elm b/src/Type/IO/Form.elm index ac099b5..41813d6 100644 --- a/src/Type/IO/Form.elm +++ b/src/Type/IO/Form.elm @@ -1,10 +1,10 @@ -module Type.IO.Form exposing (..) +module Type.IO.Form exposing (Error(..), Form, FormAcc, FormFunctor, ResultState(..), UpdateMsg(..), array, attribute, bool, combine_tuple, dict, entity, float, int, list, maybe, parseHeadTail, reference, references, result, string, substruct) import Array exposing (Array) import Dict exposing (Dict) import Html exposing (Html) import Html.Attributes -import Html.Events +import Html.Events import Json.Decode exposing (map) import List.Extra import Material.Checkbox as Checkbox exposing (config) @@ -30,6 +30,7 @@ type ResultState = ErrForm | OkForm + type Error = MaybeWasNothing | ListError @@ -38,25 +39,24 @@ type Error | AttributeNotFound | NotFound + type alias FormAcc full msg = { forms : full -> List (Html.Html msg) } + type alias FormFunctor msg = - (String -> (String -> msg) -> Html msg) - + String -> (String -> msg) -> Html msg + + type alias Form kind msg = String -> (UpdateMsg -> msg) -> kind -> String -> FormFunctor msg -> Result Error (Html.Html msg) - -- view : String -> (UpdateMsg -> msg) -> Form kind msg -> kind -> String -> List (Html.Html msg) -- view name callback form value acc = -- form name callback value acc - - - --|> Maybe.withDefault (Html.text "") @@ -64,15 +64,15 @@ int : Form Int msg int name callback kind label f = Ok <| f (String.fromInt kind) (callback << IntMsg << String.toInt) - -- TextField.textField - -- { textFieldConfig - -- | value = String.fromInt kind - -- , onInput = Just (callback << IntMsg << String.toInt) - -- , label = Just label - -- } - + +-- TextField.textField +-- { textFieldConfig +-- | value = String.fromInt kind +-- , onInput = Just (callback << IntMsg << String.toInt) +-- , label = Just label +-- } -- int : Form Int (TextField.TextFieldConfig msg) msg -- int = -- { config = \callback kind -> @@ -89,15 +89,15 @@ string : Form String msg string name callback kind label f = Ok <| f kind (callback << StringMsg << Just) - -- TextField.textField - -- { textFieldConfig - -- | label = Just label - -- , value = kind - -- , onInput = Just (callback << StringMsg << Just ) - -- } - + +-- TextField.textField +-- { textFieldConfig +-- | label = Just label +-- , value = kind +-- , onInput = Just (callback << StringMsg << Just ) +-- } -- string : Form String (TextField.TextFieldConfig msg) msg -- string = -- { config = \callback kind -> @@ -111,19 +111,18 @@ string name callback kind label f = float : Form Float msg -float name callback kind label f= +float name callback kind label f = Ok <| f (String.fromFloat kind) (callback << FloatMsg << String.toFloat) - -- TextField.textField - -- { textFieldConfig - -- | value = String.fromFloat kind - -- , onInput = Just (callback << FloatMsg << String.toFloat) - -- , label = Just label - -- } - +-- TextField.textField +-- { textFieldConfig +-- | value = String.fromFloat kind +-- , onInput = Just (callback << FloatMsg << String.toFloat) +-- , label = Just label +-- } -- float : Form Float (TextField.TextFieldConfig msg) msg -- float = -- { config = \callback kind -> @@ -151,15 +150,22 @@ bool _ callback kind _ f = Checkbox.indeterminate in Ok <| - f (if kind then "TRUE" else "FALSE") (\x -> callback <| BoolMsg <| Just (x == "TRUE") ) - -- Checkbox.checkbox - -- { checkboxConfig - -- | state = bool2state <| Just kind - -- , onChange = Just (callback BoolMsg) - -- } - + f + (if kind then + "TRUE" + + else + "FALSE" + ) + (\x -> callback <| BoolMsg <| Just (x == "TRUE")) + +-- Checkbox.checkbox +-- { checkboxConfig +-- | state = bool2state <| Just kind +-- , onChange = Just (callback BoolMsg) +-- } -- bool : Form Bool (Checkbox.CheckboxConfig msg) msg -- bool = -- let @@ -188,9 +194,7 @@ maybe old name callback kind acc f = new = Maybe.map (\x -> old name (callback << MaybeMsg) x acc f) kind in - Maybe.withDefault (Err MaybeWasNothing) new - - + Maybe.withDefault (Err MaybeWasNothing) new @@ -206,17 +210,19 @@ maybe old name callback kind acc f = list : Form a msg -> Form (List a) msg -list old name callback kind acc f= +list old name callback kind acc f = let new = - List.indexedMap (\index instance -> old name (callback << ListMsg index) instance rest f) kind - (parsedIndex,rest) = parseHeadTail acc + List.indexedMap (\index instance -> old name (callback << ListMsg index) instance rest f) kind + + ( parsedIndex, rest ) = + parseHeadTail acc in - -- if parsedIndex == "*" then - -- new - -- |> List.concat - -- else - String.toInt parsedIndex + -- if parsedIndex == "*" then + -- new + -- |> List.concat + -- else + String.toInt parsedIndex |> Maybe.andThen (\x -> List.Extra.getAt x new) |> Maybe.withDefault (Err ListError) @@ -258,23 +264,25 @@ dict keySerializer old name callback kind acc f = let new = Dict.map (\key instance -> old name (callback << DictMsg (keySerializer key)) instance rest f) kind - (parsedkey,rest) = parseHeadTail acc + + ( parsedkey, rest ) = + parseHeadTail acc in - -- if parsedkey == "*" then - -- Dict.keys new - -- |> List.filterMap (\x -> Dict.get x new) - -- |> List.concat - -- else - Dict.keys new - |> List.filter - (\x -> - keySerializer x - |> Maybe.map (\y -> y == parsedkey) - |> Maybe.withDefault False - ) - |> List.filterMap (\x -> Dict.get x new) - |> List.head - |> Maybe.withDefault (Err KeyError) + -- if parsedkey == "*" then + -- Dict.keys new + -- |> List.filterMap (\x -> Dict.get x new) + -- |> List.concat + -- else + Dict.keys new + |> List.filter + (\x -> + keySerializer x + |> Maybe.map (\y -> y == parsedkey) + |> Maybe.withDefault False + ) + |> List.filterMap (\x -> Dict.get x new) + |> List.head + |> Maybe.withDefault (Err KeyError) @@ -340,11 +348,10 @@ result : Form err msg -> Form a msg -> Form (Result err a) msg result err val name callback kind acc = case kind of Ok v -> - val name (callback << ResultMsg OkForm) v acc + val name (callback << ResultMsg OkForm) v acc + Err v -> err name (callback << ResultMsg ErrForm) v acc - - @@ -382,17 +389,18 @@ array old name callback kind acc f = let new = Array.indexedMap (\index instance -> old name (callback << ArrayMsg index) instance rest f) kind - (parsedIndex,rest) = parseHeadTail acc + + ( parsedIndex, rest ) = + parseHeadTail acc in - -- if parsedIndex == "*" then - -- new - -- |> Array.toList - -- |> List.concat - -- else - String.toInt parsedIndex + -- if parsedIndex == "*" then + -- new + -- |> Array.toList + -- |> List.concat + -- else + String.toInt parsedIndex |> Maybe.andThen (\x -> Array.get x new) |> Maybe.withDefault (Err ArrayError) - entity : Form a msg @@ -400,74 +408,88 @@ entity name callback kind acc f = Err AttributeNotFound -attribute : String -> (c -> a) -> Form a msg -> Form (c) msg -> Form c msg +attribute : String -> (c -> a) -> Form a msg -> Form c msg -> Form c msg attribute name getter childform parentform label callback kind acc = + let + ( head, tail ) = + parseHeadTail acc + in + if name == head then let - ( head, tail ) = - parseHeadTail acc - newname = (label ++ "." ++ name) + newname = + label ++ "." ++ name in - if name == head then - childform newname (callback< (parentform callback kind).view config - -- , config = - -- { forms = \full -> (parentform callback full).config.forms full ++ [ view (callback << AttrMsg name) childform (getter full) ] - -- } - -- } +-- { view = \config -> (parentform callback kind).view config +-- , config = +-- { forms = \full -> (parentform callback full).config.forms full ++ [ view (callback << AttrMsg name) childform (getter full) ] +-- } +-- } -reference : String -> (c -> Id b a) -> Form a msg -> Form (c) msg -> Form c msg +reference : String -> (c -> Id b a) -> Form a msg -> Form c msg -> Form c msg reference name getter childform parentform label callback kind acc = + let + ( head, tail ) = + parseHeadTail acc + in + if name == head then let - ( head, tail ) = - parseHeadTail acc - newname = (label ++ "." ++ name) + newname = + label ++ "." ++ name in - if name == head then - childform newname (callback< (c -> (List a)) -> Form (List a) msg -> Form (c) msg -> Form c msg +references : String -> (c -> List a) -> Form (List a) msg -> Form c msg -> Form c msg references name getter childform parentform label callback kind acc = let ( head, tail ) = parseHeadTail acc - newname = (label ++ "." ++ name) + + newname = + label ++ "." ++ name in if name == head then - childform newname (callback< (c -> a) -> Form a msg -> Form (c) msg -> Form c msg -substruct name getter childform parentform label callback kind acc = + +substruct : String -> (c -> a) -> Form a msg -> Form c msg -> Form c msg +substruct name getter childform parentform label callback kind acc = + let + ( head, tail ) = + parseHeadTail acc + in + if name == head then let - ( head, tail ) = - parseHeadTail acc - newname = (label ++ "." ++ name) + newname = + label ++ "." ++ name in - if name == head then - childform newname (callback< ( String, String ) @@ -484,4 +506,4 @@ parseHeadTail accessor = |> Maybe.map (String.join ".") |> Maybe.withDefault "" in - ( index, rest ) \ No newline at end of file + ( index, rest ) diff --git a/src/Type/IO/Internal.elm b/src/Type/IO/Internal.elm index 16bbb26..80bd2a0 100644 --- a/src/Type/IO/Internal.elm +++ b/src/Type/IO/Internal.elm @@ -1,10 +1,15 @@ module Type.IO.Internal exposing (Id, box, unbox) -type Id a b = - Id b + +type Id a b + = Id b + box : c -> Id a c -box = Id +box = + Id + unbox : Id a c -> c -unbox (Id v) = v \ No newline at end of file +unbox (Id v) = + v diff --git a/src/Type/IO/Setter.elm b/src/Type/IO/Setter.elm index c0528a8..04b92ed 100644 --- a/src/Type/IO/Setter.elm +++ b/src/Type/IO/Setter.elm @@ -1,12 +1,13 @@ -module Type.IO.Setter exposing (..) +module Type.IO.Setter exposing (Car, Error(..), Msg(..), PartialUpdater, Person, Updater, array, attribute, bool, car1, car2, carUpdater2, dict, entity, errToString, float, int, list, maybe, person_str_updater, reference, references, result, string, substruct, toString, updateWithLong) -import List.Extra -import Result.Extra -import Dict exposing (Dict) import Array exposing (Array) import Array.Extra +import Dict exposing (Dict) +import List.Extra +import Result.Extra import Type.IO.Internal as Id exposing (Id) + type alias Person = { name : String } @@ -22,13 +23,14 @@ type alias Car = , age : Int } + type Msg - = IntMsg (Int) + = IntMsg Int | IntUpdate (Int -> Int) - | StringMsg (String) - | FloatMsg (Float) + | StringMsg String + | FloatMsg Float | BoolUpdateMsg (Bool -> Bool) - | BoolMsg (Bool) + | BoolMsg Bool | AttributeMsg String Msg | MaybeUpdateMsg (Maybe Msg) | MaybeSetMsg (Maybe Msg) @@ -44,92 +46,102 @@ type Msg | ErrorMsg | Custom String (Maybe Msg) -type Error = - Mismatch Msg Msg + +type Error + = Mismatch Msg Msg | IndexOutOfBounds | KeyError | InvalidValue | KeyAlreadyPresent | CustomError String + errToString : Error -> String errToString err = case err of Mismatch got expect -> "The change message didn't match up the structure: Got \"" ++ toString got ++ "\" but expected " ++ toString expect ++ "!" - + IndexOutOfBounds -> "The index was out of the bounds!" - - KeyError -> + + KeyError -> "Didn't find this key in my dict!" - + InvalidValue -> "Cannot update this type with this value." KeyAlreadyPresent -> "Cannot create new value here. There is already a value on this key" - CustomError s -> + CustomError s -> s - - - -updateWithLong : (car -> string) -> String -> Updater string -> Msg -> car -> Result Error string + +updateWithLong : (car -> string) -> String -> Updater string -> Msg -> car -> Result Error string updateWithLong getter name def message car = case message of AttributeMsg searched msg_ -> if name == searched then def msg_ (getter car) - else + + else Ok (getter car) + _ -> Err <| Mismatch message (AttributeMsg name ErrorMsg) type alias PartialUpdater car string = - (Msg -> car -> Result Error string) + Msg -> car -> Result Error string + -type alias Updater a = +type alias Updater a = PartialUpdater a a + int : Updater Int -int msg val = +int msg val = case msg of IntMsg f -> Ok f + IntUpdate f -> Ok <| f val + _ -> Err <| Mismatch msg (IntMsg val) + string : Updater String -string msg val = +string msg val = case msg of StringMsg f -> Ok f - + _ -> Err <| Mismatch msg (StringMsg val) + float : Updater Float -float msg val = +float msg val = case msg of FloatMsg f -> Ok f - + _ -> Err <| Mismatch msg (FloatMsg val) - + + bool : Updater Bool -bool msg val = +bool msg val = case msg of BoolUpdateMsg f -> Ok (f val) - + BoolMsg b -> - Ok (b) + Ok b + _ -> Err <| Mismatch msg (BoolMsg val) @@ -137,24 +149,33 @@ bool msg val = maybe : a -> Updater a -> Updater (Maybe a) maybe empty old msg val = case msg of - MaybeUpdateMsg (Just _)-> + MaybeUpdateMsg (Just _) -> case val of Just v -> - case (old msg v) of + case old msg v of Ok res -> Ok (Just res) + Err e -> Err e + Nothing -> Ok Nothing - MaybeUpdateMsg (Nothing) -> + + MaybeUpdateMsg Nothing -> Ok Nothing + MaybeSetMsg (Just msg_) -> Result.map Just <| old msg_ empty - MaybeSetMsg (Nothing) -> + + MaybeSetMsg Nothing -> Ok Nothing + _ -> Err <| Mismatch msg (MaybeUpdateMsg Nothing) + + + -- TODO: Allow to Set @@ -163,29 +184,33 @@ list empty old msg val = case msg of ListUpdateMsg index msg_ -> List.Extra.getAt index val - |> Result.fromMaybe (IndexOutOfBounds) - |> Result.andThen (old msg_) - |> Result.map (\x -> List.Extra.setAt index x val) - -- |> Maybe.map (old msg_) - -- |> Maybe.map (\x -> List.Extra.setAt index x val) - -- |> Result.fromMaybe (Err IndexOutOfBounds) - -- |> Maybe.withDefault val - + |> Result.fromMaybe IndexOutOfBounds + |> Result.andThen (old msg_) + |> Result.map (\x -> List.Extra.setAt index x val) + + -- |> Maybe.map (old msg_) + -- |> Maybe.map (\x -> List.Extra.setAt index x val) + -- |> Result.fromMaybe (Err IndexOutOfBounds) + -- |> Maybe.withDefault val ListAppendMsg msg_ -> case old msg_ empty of Ok value -> - Ok <| List.append val [value] + Ok <| List.append val [ value ] + Err err -> Err err + ListMixedUpdate index msg_ -> if index >= List.length val then - list empty old msg (val ++ [empty]) + list empty old msg (val ++ [ empty ]) + else list empty old (ListUpdateMsg index msg_) val - + _ -> Err <| Mismatch msg (ListUpdateMsg 0 ErrorMsg) + dict : comparable -> a -> (comparable -> Maybe String) -> Updater comparable -> Updater a -> Updater (Dict comparable a) dict emptyKey emptyValue keySerializer keys values msg val = case msg of @@ -193,155 +218,185 @@ dict emptyKey emptyValue keySerializer keys values msg val = Dict.keys val |> List.filter (\x -> - keySerializer x + keySerializer x |> Maybe.map (\y -> y == parsedkey) |> Maybe.withDefault False ) - |> List.map (\x -> (x, Result.fromMaybe KeyError (Dict.get x val))) - |> List.map (\(x,y) -> (x, Result.andThen (values msg_) y)) - |> List.map (\(x,y) -> - case y of - Ok value -> - Ok (x,value) - - Err err -> - Err err - + |> List.map (\x -> ( x, Result.fromMaybe KeyError (Dict.get x val) )) + |> List.map (\( x, y ) -> ( x, Result.andThen (values msg_) y )) + |> List.map + (\( x, y ) -> + case y of + Ok value -> + Ok ( x, value ) + + Err err -> + Err err ) |> Result.Extra.combine -- |> List.filterMap (\(x,y) -> case y of -- Ok v-> -- (Just (x,v)) - -- _ -> -- Nothing -- ) - |> Result.map Dict.fromList |> Result.map (\x -> Dict.union x val) + DictAddMsg keymsg_ valuemsg_ -> - case (keys keymsg_ emptyKey, values valuemsg_ emptyValue) of - (Err err,_) -> + case ( keys keymsg_ emptyKey, values valuemsg_ emptyValue ) of + ( Err err, _ ) -> Err err - (_, Err err) -> + + ( _, Err err ) -> Err err - (Ok key, Ok value) -> + + ( Ok key, Ok value ) -> if Dict.member key val then Err KeyAlreadyPresent + else Ok <| Dict.insert key value val - + --TODO: Map keys _ -> Err <| Mismatch msg (DictKeyMsg "" ErrorMsg) + result : err -> a -> Updater err -> Updater a -> Updater (Result err a) result emptyErr emptyOk err ok msg val = - case (msg, val) of - (ResultErrMsg msg_, Err error) -> - (err msg_ error) - |> Result.map Err - (ResultOkMsg msg_, Ok value ) -> - (ok msg_ value) - |> Result.map Ok - _ -> + case ( msg, val ) of + ( ResultErrMsg msg_, Err error ) -> + err msg_ error + |> Result.map Err + + ( ResultOkMsg msg_, Ok value ) -> + ok msg_ value + |> Result.map Ok + + _ -> Err <| Mismatch msg (ResultErrMsg ErrorMsg) - + + array : a -> Updater a -> Updater (Array a) array empty old msg val = case msg of ArrayUpdateIndexMsg index msg_ -> Array.get index val - |> Result.fromMaybe IndexOutOfBounds - |> Result.andThen (old msg_) - |> Result.map (\x -> Array.set index x val) + |> Result.fromMaybe IndexOutOfBounds + |> Result.andThen (old msg_) + |> Result.map (\x -> Array.set index x val) + ArrayAppend msg_ -> old msg_ empty - |> Result.map (\x -> Array.push x val) + |> Result.map (\x -> Array.push x val) + _ -> Err <| Mismatch msg (ArrayUpdateIndexMsg 0 ErrorMsg) - -entity: a -> PartialUpdater car a -entity toChange msg car = Ok toChange +entity : a -> PartialUpdater car a +entity toChange msg car = + Ok toChange attribute : String -> (car -> string) -> Updater string -> PartialUpdater car (string -> b) -> PartialUpdater car b attribute name getter def parent msg car = - (parent msg car) - |> Result.map2 (\x y -> y x) (updateWithLong getter name def msg car) + parent msg car + |> Result.map2 (\x y -> y x) (updateWithLong getter name def msg car) + -reference : String -> (car -> Id a comparable) -> Updater comparable -> PartialUpdater car ((Id a comparable) -> b) -> PartialUpdater car b +reference : String -> (car -> Id a comparable) -> Updater comparable -> PartialUpdater car (Id a comparable -> b) -> PartialUpdater car b reference name getter def parent msg car = let - iddef msg_ car_ = def msg_ (Id.unbox car_) - |> Result.map (Id.box) + iddef msg_ car_ = + def msg_ (Id.unbox car_) + |> Result.map Id.box in - (parent msg car) - |> Result.map2 (\x y -> y x) (updateWithLong getter name iddef msg car) + parent msg car + |> Result.map2 (\x y -> y x) (updateWithLong getter name iddef msg car) -references : String -> (car -> (List comparable)) -> comparable -> Updater comparable -> PartialUpdater car ((List comparable) -> b) -> PartialUpdater car b +references : String -> (car -> List comparable) -> comparable -> Updater comparable -> PartialUpdater car (List comparable -> b) -> PartialUpdater car b references name getter empty def = attribute name getter (list empty def) + substruct : String -> (car -> string) -> Updater string -> PartialUpdater car (string -> b) -> PartialUpdater car b -substruct = attribute +substruct = + attribute carUpdater2 : Updater Car carUpdater2 = entity Car - |> attribute "brand" .brand (maybe "" string) - |> reference "model" .model string - |> attribute "age" .age int + |> attribute "brand" .brand (maybe "" string) + |> reference "model" .model string + |> attribute "age" .age int + car1 : Car -car1 = Car Nothing (Id.box "mymodel") 12 +car1 = + Car Nothing (Id.box "mymodel") 12 + car2 : Result Error Car -car2 = carUpdater2 (AttributeMsg "brand" (MaybeUpdateMsg (Just (StringMsg "Hello")))) car1 +car2 = + carUpdater2 (AttributeMsg "brand" (MaybeUpdateMsg (Just (StringMsg "Hello")))) car1 --- first = (updateWith ) +-- first = (updateWith ) -- carUpdater : Msg -> Car -> Car -- carUpdater msg car = - - -- -- Car = (String -> String -> Int -> Car) +-- attribute : (car -> string) -> (string -> other) -> --- attribute : (car -> string) -> (string -> other) -> toString : Msg -> String toString msg = case msg of - IntMsg v -> + IntMsg v -> "(int) " ++ String.fromInt v + IntUpdate _ -> "(int) updating" + StringMsg s -> "(string) " ++ s + FloatMsg f -> "(float) " ++ String.fromFloat f + AttributeMsg a msg_ -> a ++ "->" ++ toString msg_ + MaybeUpdateMsg (Just msg_) -> "Just (update) ->" ++ toString msg_ + MaybeUpdateMsg Nothing -> "Nothing (update)" + MaybeSetMsg (Just msg_) -> "Just (set) ->" ++ toString msg_ - MaybeSetMsg (Nothing) -> + + MaybeSetMsg Nothing -> "Nothing (set)" + Custom name (Just msg_) -> name ++ " (custom) ->" ++ toString msg_ + Custom name Nothing -> name ++ " (custom)" + BoolMsg b -> - "(bool) " ++ if b then - "TRUE" - else - "FALSE" - _ -> "Yet undeclared!" \ No newline at end of file + "(bool) " + ++ (if b then + "TRUE" + + else + "FALSE" + ) + + _ -> + "Yet undeclared!" diff --git a/src/Type/IO/ToString.elm b/src/Type/IO/ToString.elm index f8354a4..67c594e 100644 --- a/src/Type/IO/ToString.elm +++ b/src/Type/IO/ToString.elm @@ -1,19 +1,21 @@ -module Type.IO.ToString exposing (..) +module Type.IO.ToString exposing (Error(..), ToString, array, attribute, bool, dict, entity, float, int, l2s, list, map_array_toString, map_dict_toString, map_list_toString, maybe, parseHeadTail, reference, references, result, string, substruct) +import Array exposing (Array) import Dict exposing (Dict) import List.Extra import Result.Extra -import Array exposing (Array) import Type.IO.Internal as Id exposing (Id, box, unbox) -type Error = - NotFound + +type Error + = NotFound | IndexOutOfBounds Int | NotAnInt String | NoSuchKey String | NoSuchValue | NoSuchSubstruct String + type alias ToString a = String -> a -> Result Error String @@ -47,16 +49,21 @@ bool _ b = maybe : ToString a -> ToString (Maybe a) maybe old name value = case value of - Just v -> + Just v -> old name v - Nothing -> + + Nothing -> Ok "Nothing" - -- Maybe.andThen (old name) + + + +-- Maybe.andThen (old name) l2s : List String -> String -l2s l = - "[ "++ String.join ", " l ++ " ]" +l2s l = + "[ " ++ String.join ", " l ++ " ]" + list : ToString a -> ToString (List a) list old name l = @@ -66,24 +73,27 @@ list old name l = in if name == "*" then List.map (old "*") l - |> Result.Extra.combine - |> Result.map l2s + |> Result.Extra.combine + |> Result.map l2s + else case String.toInt head of Just index -> case List.Extra.getAt index l of Just value -> old rest value + Nothing -> Err (IndexOutOfBounds index) - + Nothing -> Err (NotAnInt head) - - - -- |> Maybe.andThen (\x -> List.Extra.getAt x l) - -- |> Maybe.andThen (old rest) - --map_list_toString old + + + +-- |> Maybe.andThen (\x -> List.Extra.getAt x l) +-- |> Maybe.andThen (old rest) +--map_list_toString old dict : ToString comparable -> ToString a -> ToString (Dict comparable a) @@ -91,27 +101,32 @@ dict keys values name dictionary = let ( head, rest ) = parseHeadTail name - lkey = Dict.keys dictionary - |> List.filter - (\x -> - keys rest x - |> Result.map (\y -> y == head) - |> Result.withDefault False - ) + + lkey = + Dict.keys dictionary + |> List.filter + (\x -> + keys rest x + |> Result.map (\y -> y == head) + |> Result.withDefault False + ) in - case List.head lkey of - Just key -> - case Dict.get key dictionary of - Just value -> - values rest value - - Nothing -> - Err NoSuchValue - Nothing -> - Err (NoSuchKey head) - - -- |> Maybe.andThen (\x -> Dict.get x dictionary) - -- |> Maybe.andThen (values rest) + case List.head lkey of + Just key -> + case Dict.get key dictionary of + Just value -> + values rest value + + Nothing -> + Err NoSuchValue + + Nothing -> + Err (NoSuchKey head) + + + +-- |> Maybe.andThen (\x -> Dict.get x dictionary) +-- |> Maybe.andThen (values rest) result : ToString err -> ToString val -> ToString (Result err val) @@ -137,20 +152,24 @@ attribute name def getter parent = ( head, tail ) = parseHeadTail acc in - if name == head then + if name == head then def tail (getter value) - else - if acc == "*" then - def "*" (getter value) + else if acc == "*" then + def "*" (getter value) |> Result.map (\x -> name ++ ":" ++ x ++ "\n") - |> Result.map (\x -> case parent acc value of - Ok s -> - x ++ s - Err _ -> - x) - else - parent acc value + |> Result.map + (\x -> + case parent acc value of + Ok s -> + x ++ s + + Err _ -> + x + ) + + else + parent acc value reference : String -> (c -> Id a comparable) -> ToString comparable -> ToString c -> ToString c @@ -163,17 +182,22 @@ reference name getter def parent = if name == head then def acc (Id.unbox (getter value)) - else - if acc == "*" then - def "*" (Id.unbox (getter value)) + else if acc == "*" then + def "*" (Id.unbox (getter value)) |> Result.map (\x -> name ++ ":" ++ x ++ "\n") - |> Result.map (\x -> case parent acc value of - Ok s -> - x ++ s - Err _ -> - x) - else - parent acc value + |> Result.map + (\x -> + case parent acc value of + Ok s -> + x ++ s + + Err _ -> + x + ) + + else + parent acc value + references : String -> (c -> List comparable) -> ToString comparable -> ToString c -> ToString c references name getter def parent = @@ -183,25 +207,28 @@ references name getter def parent = parseHeadTail acc in if name == head || name == "*" then - (list def) tail <| (getter value) + list def tail <| getter value else parent acc value + substruct : String -> ToString a -> (c -> a) -> ToString c -> ToString c -substruct name struct getter old = \acc value -> - let - ( head, tail ) = - parseHeadTail acc - in - if name == head || name == "*" then - struct tail (getter value) +substruct name struct getter old = + \acc value -> + let + ( head, tail ) = + parseHeadTail acc + in + if name == head || name == "*" then + struct tail (getter value) + + else + old acc value - else - old acc value array : ToString a -> ToString (Array a) -array old name arr = +array old name arr = let ( head, rest ) = parseHeadTail name @@ -211,12 +238,16 @@ array old name arr = case Array.get index arr of Just value -> old rest value + Nothing -> Err (IndexOutOfBounds index) - + Nothing -> Err (NotAnInt head) - -- map_array_toString old + + + +-- map_array_toString old map_list_toString : (String -> kind -> Maybe String) -> String -> List kind -> Maybe String @@ -232,22 +263,23 @@ map_list_toString old s l = parseHeadTail : String -> ( String, String ) parseHeadTail accessor = - let - index = - String.split "." accessor - |> List.head - |> Maybe.withDefault "" - - rest = - String.split "." accessor - |> List.tail - |> Maybe.map (String.join ".") - |> Maybe.withDefault "" - in - if accessor == "*" then - ("*","*") - else - ( index, rest ) + if accessor == "*" then + ( "*", "*" ) + + else + let + rest = + String.split "." accessor + |> List.tail + |> Maybe.map (String.join ".") + |> Maybe.withDefault "" + + index = + String.split "." accessor + |> List.head + |> Maybe.withDefault "" + in + ( index, rest ) map_dict_toString : (String -> Maybe comparable) -> (String -> value -> Maybe String) -> String -> Dict comparable value -> Maybe String @@ -261,10 +293,12 @@ map_dict_toString key_parser value s d = |> Maybe.andThen (value rest) + -- map_result_toString : (String -> kind -> Maybe String) -> String -> Result error kind -> Maybe String -- map_result_toString old s r = -- Debug.todo "" + map_array_toString : (String -> kind -> Maybe String) -> String -> Array kind -> Maybe String map_array_toString old s a = let @@ -273,4 +307,4 @@ map_array_toString old s a = in String.toInt head |> Maybe.andThen (\x -> Array.get x a) - |> Maybe.andThen (old rest) \ No newline at end of file + |> Maybe.andThen (old rest) diff --git a/src/Type/IO/Update.elm b/src/Type/IO/Update.elm index 12ceaf9..d93411d 100644 --- a/src/Type/IO/Update.elm +++ b/src/Type/IO/Update.elm @@ -1,9 +1,9 @@ -module Type.IO.Update exposing (..) +module Type.IO.Update exposing (Car, Msg(..), PartialUpdater, Person, Updater, array, attribute, bool, carUpdater2, dict, entity, float, int, list, maybe, person_str_updater, reference, references, result, string, substruct, updateWithLong) -import List.Extra -import Dict exposing (Dict) import Array exposing (Array) import Array.Extra +import Dict exposing (Dict) +import List.Extra type alias Person = @@ -21,6 +21,7 @@ type alias Car = , age : Int } + type Msg a = IntMsg (Int -> Int) | StringMsg (String -> String) @@ -36,61 +37,68 @@ type Msg a | ArrayMsg Int (Msg a) - -updateWithLong : (car -> string) -> String -> Updater string a -> Msg a -> car -> string +updateWithLong : (car -> string) -> String -> Updater string a -> Msg a -> car -> string updateWithLong getter name def message car = case message of AttributeMsg searched msg_ -> if name == searched then def msg_ (getter car) - else + + else getter car + _ -> getter car type alias PartialUpdater car string a = - (Msg a -> car -> string) + Msg a -> car -> string + -type alias Updater a b = +type alias Updater a b = PartialUpdater a a b + int : Updater Int a -int msg val = +int msg val = case msg of IntMsg f -> f val - + _ -> val + string : Updater String a -string msg val = +string msg val = case msg of StringMsg f -> f val - + _ -> val + float : Updater Float a -float msg val = +float msg val = case msg of FloatMsg f -> f val - + _ -> val - + + bool : Updater Bool a -bool msg val = +bool msg val = case msg of BoolMsg f -> f val - + _ -> val + maybe : Updater a a -> Updater (Maybe a) a maybe old msg val = case msg of @@ -98,18 +106,23 @@ maybe old msg val = case val of Just v -> Just (old msg_ v) - + Nothing -> Nothing + MaybeSetMsg msg_ default -> case msg_ of Just msg__ -> Just (old msg__ default) - + Nothing -> Nothing + _ -> val + + + -- TODO: Allow to Set @@ -118,9 +131,11 @@ list old msg val = case msg of ListMsg index msg_ -> List.Extra.updateAt index (old msg_) val + _ -> val + dict : (comparable -> Maybe String) -> Updater comparable b -> Updater a b -> Updater (Dict comparable a) b dict keySerializer keys values msg val = case msg of @@ -128,79 +143,88 @@ dict keySerializer keys values msg val = Dict.keys val |> List.filter (\x -> - keySerializer x + keySerializer x |> Maybe.map (\y -> y == parsedkey) |> Maybe.withDefault False ) - |> List.map (\x -> (x, Dict.get x val)) - |> List.filterMap (\(x,y) -> case y of - Just v-> - (Just (x,v)) - - _ -> - Nothing - ) - |> List.map (\(x,y) ->(x, values msg_ y)) + |> List.map (\x -> ( x, Dict.get x val )) + |> List.filterMap + (\( x, y ) -> + case y of + Just v -> + Just ( x, v ) + + _ -> + Nothing + ) + |> List.map (\( x, y ) -> ( x, values msg_ y )) |> Dict.fromList |> (\x -> Dict.union x val) + --TODO: Map keys _ -> val + result : Updater err b -> Updater a b -> Updater (Result err a) b result err ok msg val = - case (msg, val) of - (ResultErrMsg msg_, Err error) -> + case ( msg, val ) of + ( ResultErrMsg msg_, Err error ) -> Err (err msg_ error) - (ResultOkMsg msg_, Ok value ) -> + + ( ResultOkMsg msg_, Ok value ) -> Ok (ok msg_ value) - _ -> val - + + _ -> + val + + array : Updater a b -> Updater (Array a) b array old msg val = case msg of ArrayMsg index msg_ -> Array.Extra.update index (old msg_) val - + _ -> val - -entity: a -> PartialUpdater car a b -entity toChange msg car = toChange +entity : a -> PartialUpdater car a b +entity toChange msg car = + toChange -attribute : String -> (car -> string) -> Updater string c-> PartialUpdater car (string -> b) c -> PartialUpdater car b c +attribute : String -> (car -> string) -> Updater string c -> PartialUpdater car (string -> b) c -> PartialUpdater car b c attribute name getter def parent msg car = - (parent msg car) (updateWithLong getter name def msg car) + parent msg car (updateWithLong getter name def msg car) + + +reference : String -> (car -> comparable) -> Updater comparable a -> PartialUpdater car (comparable -> b) a -> PartialUpdater car b a +reference = + attribute -reference : String -> (car -> comparable) -> Updater comparable a -> PartialUpdater car (comparable -> b) a -> PartialUpdater car b a -reference = attribute -references : String -> (car -> (List comparable)) -> Updater comparable a -> PartialUpdater car ((List comparable) -> b) a -> PartialUpdater car b a +references : String -> (car -> List comparable) -> Updater comparable a -> PartialUpdater car (List comparable -> b) a -> PartialUpdater car b a references name getter def = attribute name getter (list def) + substruct : String -> (car -> string) -> Updater string a -> PartialUpdater car (string -> b) a -> PartialUpdater car b a -substruct = attribute +substruct = + attribute carUpdater2 : Updater Car a carUpdater2 = entity Car - |> attribute "brand" .brand string - |> reference "model" .model string - |> attribute "age" .age int + |> attribute "brand" .brand string + |> reference "model" .model string + |> attribute "age" .age int -- first = (updateWith ) - -- carUpdater : Msg -> Car -> Car -- carUpdater msg car = - - -- -- Car = (String -> String -> Int -> Car) - --- attribute : (car -> string) -> (string -> other) -> \ No newline at end of file +-- attribute : (car -> string) -> (string -> other) -> diff --git a/src/Type/IO/Viewer.elm b/src/Type/IO/Viewer.elm index c280e67..f3c12b2 100644 --- a/src/Type/IO/Viewer.elm +++ b/src/Type/IO/Viewer.elm @@ -1,4 +1,4 @@ -module Type.IO.Viewer exposing (..) +module Type.IO.Viewer exposing (Basic, Viewer, array, attribute, basic, bool, dict, entity, float, int, list, maybe, reference, references, result, string, substruct) import Array exposing (Array) import Dict exposing (Dict) diff --git a/src/Type/IOTest.elm b/src/Type/IOTest.elm index 1b43c81..faa28c4 100644 --- a/src/Type/IOTest.elm +++ b/src/Type/IOTest.elm @@ -1,4 +1,4 @@ -module Type.IOTest exposing (..) +module Type.IOTest exposing (Car, CarView, Chef, ChefView, Db, DbView, Person, PersonView, Timestamp, car, chef, db1, flip, person, timestamp) import Dict exposing (Dict) import Type.IO exposing (..) @@ -15,34 +15,40 @@ type alias CarView = , name : String } + flip : (a -> b -> c) -> b -> a -> c -flip f second first = f first second +flip f second first = + f first second -{- timestapedlense : Db -> String -> Maybe (Person) -timestapedlense = \db arg -> Dict.get arg (.people db) --- |> Maybe.map .value -dictlense : Db -> String -> Maybe ( Person) -dictlense = \db arg -> Dict.get arg (.people db) -} -{- genericlense : (Db -> Dict String a) -> (Db -> String -> Maybe a) -genericlense mapper = \db arg -> Dict.get arg (mapper db) +{- timestapedlense : Db -> String -> Maybe (Person) + timestapedlense = \db arg -> Dict.get arg (.people db) + -- |> Maybe.map .value -evermoregenericlense : (Db -> b) -> (comparable -> b -> Maybe a) -> (Db -> comparable -> Maybe a) -evermoregenericlense fromDb toValue = \db arg -> toValue arg (fromDb db) + dictlense : Db -> String -> Maybe ( Person) + dictlense = \db arg -> Dict.get arg (.people db) +-} +{- genericlense : (Db -> Dict String a) -> (Db -> String -> Maybe a) + genericlense mapper = \db arg -> Dict.get arg (mapper db) -mostgenericlense : (Db -> b) -> (b -> comparable -> Maybe a) -> (a -> c) -> (Db -> comparable -> Maybe c) -mostgenericlense fromDb toFlag toValue = \db arg -> toFlag (fromDb db) arg - |> Maybe.map toValue -} + evermoregenericlense : (Db -> b) -> (comparable -> b -> Maybe a) -> (Db -> comparable -> Maybe a) + evermoregenericlense fromDb toValue = \db arg -> toValue arg (fromDb db) + mostgenericlense : (Db -> b) -> (b -> comparable -> Maybe a) -> (a -> c) -> (Db -> comparable -> Maybe c) + mostgenericlense fromDb toFlag toValue = \db arg -> toFlag (fromDb db) arg + |> Maybe.map toValue +-} {- dict2lense : Db -> String -> Maybe ( Person) -dict2lense = evermoregenericlense .people Dict.get - -timpestaped2lense : Db -> String -> Maybe Person -timpestaped2lense = mostgenericlense .people (flip Dict.get) identity -} + dict2lense = evermoregenericlense .people Dict.get + timpestaped2lense : Db -> String -> Maybe Person + timpestaped2lense = mostgenericlense .people (flip Dict.get) identity +-} {- l : (Db -> b) -> (b -> comparable -> Maybe a) -> (a -> c) -> (Db -> comparable -> Maybe c) -l = mostgenericlense -} + l = mostgenericlense +-} + car : IO Car Db CarView car = @@ -94,17 +100,19 @@ type alias Db = , cars : Dict String (Timestamp Car) } + type alias DbView = - { - people : Dict String PersonView, - cars : Dict String CarView + { people : Dict String PersonView + , cars : Dict String CarView } + db1 : IO Db Db DbView -db1 = +db1 = entity Db DbView - |> substruct "people" (dict string (timestamp person)) .people - |> substruct "cars" (dict string (timestamp car)) .cars + |> substruct "people" (dict string (timestamp person)) .people + |> substruct "cars" (dict string (timestamp car)) .cars + type alias Timestamp a = { created : Int @@ -113,21 +121,21 @@ type alias Timestamp a = , value : a } + timestamp : IO a db b -> IO (Timestamp a) db b -timestamp other = +timestamp other = let - t = + t = entity Timestamp Timestamp - |> attribute "created" int .created - |> attribute "modified" int .modified - |> attribute "accessed" int .accessed - |> substruct "value" other .value - in - { - decoder = t.decoder, - encoder = t.encoder, - fuzzer = t.fuzzer, - toString = t.toString, - empty = t.empty, - viewer = \db full -> Maybe.map (\x -> x.value ) (t.viewer db full) - } \ No newline at end of file + |> attribute "created" int .created + |> attribute "modified" int .modified + |> attribute "accessed" int .accessed + |> substruct "value" other .value + in + { decoder = t.decoder + , encoder = t.encoder + , fuzzer = t.fuzzer + , toString = t.toString + , empty = t.empty + , viewer = \db full -> Maybe.map (\x -> x.value) (t.viewer db full) + } diff --git a/src/Type/Par.elm b/src/Type/Par.elm index 90fbd95..bfa062f 100644 --- a/src/Type/Par.elm +++ b/src/Type/Par.elm @@ -1,67 +1,79 @@ -module Type.Par exposing (..) +module Type.Par exposing (Par(..), Parf(..), SParf(..), andThen, apply, applyFirst, applySecond, distribute, fromTuple, inverseMapF, linearize, map, mapTuple, myMap, toTuple) +type Par a + = Par ( a, a ) -type Par a = - Par (a, a) -mapTuple : ((a, a) -> (b, b)) -> Par a -> Par b +mapTuple : (( a, a ) -> ( b, b )) -> Par a -> Par b mapTuple f (Par x) = Par (f x) -fromTuple : (a, a) -> Par a + +fromTuple : ( a, a ) -> Par a fromTuple = Par -toTuple : Par a -> (a, a) + +toTuple : Par a -> ( a, a ) toTuple (Par x) = x -andThen : ((a, a) -> Par b) -> Par a -> Par b + +andThen : (( a, a ) -> Par b) -> Par a -> Par b andThen f (Par x) = f x + distribute : Par (a -> b) -> Par a -> Par b -distribute (Par (f,g)) (Par (x,y)) = - Par (f x, g y) +distribute (Par ( f, g )) (Par ( x, y )) = + Par ( f x, g y ) + inverseMapF : (Par a -> Par b) -> Par (a -> b) inverseMapF f = Debug.todo "" + map : (Par a -> Par b) -> Par a -> Par b map f x = f x - - myMap : Par ((a -> a) -> b) -> (Par a -> Par a) -> Par b -myMap = +myMap = Debug.todo "" -type Parf a = - Parf ((a, a) -> (a, a)) +type Parf a + = Parf (( a, a ) -> ( a, a )) + + + -- Parf (Par a -> Par a) + apply : Parf a -> Par a -> Par a -apply (Parf f) (Par x) = +apply (Parf f) (Par x) = Par (f x) + applyFirst : Parf a -> Par a -> a -applyFirst b c= +applyFirst b c = apply b c - |> \(Par (a, _)) -> a + |> (\(Par ( a, _ )) -> a) + applySecond : Parf a -> Par a -> a -applySecond b c= +applySecond b c = apply b c - |> \(Par (_, a)) -> a + |> (\(Par ( _, a )) -> a) + + +type SParf a + = SParf (( a, a ) -> a) -type SParf a = - SParf ((a, a) -> a) linearize : SParf a -> a -> a -> a linearize (SParf f) x y = - f (x,y) \ No newline at end of file + f ( x, y ) diff --git a/src/Type/Timestamp.elm b/src/Type/Timestamp.elm index 233fba8..529577e 100644 --- a/src/Type/Timestamp.elm +++ b/src/Type/Timestamp.elm @@ -1,11 +1,12 @@ -module Type.Timestamp exposing (Timestamp, Msg(..)) +module Type.Timestamp exposing (Msg(..), Timestamp) +import Fuzz import Json.Decode as Decode import Json.Decode.Pipeline exposing (required) import Json.Encode as Encode exposing (Value) -import Type.IO exposing (..) import Time -import Fuzz +import Type.IO exposing (..) + type alias Timestamp a = { created : Int @@ -14,32 +15,36 @@ type alias Timestamp a = , value : a } + timestamp : IO a db b msg -> IO (Timestamp a) db (Timestamp b) msg -timestamp other = +timestamp other = entity Timestamp Timestamp - |> attribute "created" int .created - |> attribute "modified" int .modified - |> attribute "accessed" int .accessed - |> substruct "value" other .value + |> attribute "created" int .created + |> attribute "modified" int .modified + |> attribute "accessed" int .accessed + |> substruct "value" other .value + + {- -timestamp : IO b db d -> IO (Timestamp b) db (Timestamp b) -timestamp old = - { decoder = Decode.succeed Timestamp - |> required "created" int - |> required "modified" int - |> required "accessed" int - |> required "value" old.decoder - , toString = \name -> Maybe.andThen (old.toString name) - , encoder = map_encoder_maybe old.encoder - , fuzzer = Fuzz.maybe old.fuzzer - , viewer = \db full -> Just full - , empty = Timestamp int.empty int.empty int.empty old.empty - } + timestamp : IO b db d -> IO (Timestamp b) db (Timestamp b) + timestamp old = + { decoder = Decode.succeed Timestamp + |> required "created" int + |> required "modified" int + |> required "accessed" int + |> required "value" old.decoder + , toString = \name -> Maybe.andThen (old.toString name) + , encoder = map_encoder_maybe old.encoder + , fuzzer = Fuzz.maybe old.fuzzer + , viewer = \db full -> Just full + , empty = Timestamp int.empty int.empty int.empty old.empty + } -} + type Msg = All Time.Posix | Created Time.Posix | Modified Time.Posix - | Accessed Time.Posix \ No newline at end of file + | Accessed Time.Posix diff --git a/src/Type/UpdateTest.elm b/src/Type/UpdateTest.elm index 421c368..988ae2d 100644 --- a/src/Type/UpdateTest.elm +++ b/src/Type/UpdateTest.elm @@ -1,4 +1,4 @@ -module Type.UpdateTest exposing (..) +module Type.UpdateTest exposing (Car, CarBuilder, CarView, Chef, ChefBuilder, ChefView, Db, DbBuilder, DbView, Foo, FooBuilder, Person, PersonBuilder, PersonView, Timestamp, car, chef, db1, flip, foo, person, timestamp) import Dict exposing (Dict) import Type.IO.Update exposing (..) @@ -15,65 +15,74 @@ type alias CarView = , name : String } + type alias CarBuilder = String -> String -> Car + flip : (a -> b -> c) -> b -> a -> c -flip f second first = f first second +flip f second first = + f first second -{- timestapedlense : Db -> String -> Maybe (Person) -timestapedlense = \db arg -> Dict.get arg (.people db) --- |> Maybe.map .value -dictlense : Db -> String -> Maybe ( Person) -dictlense = \db arg -> Dict.get arg (.people db) -} -{- genericlense : (Db -> Dict String a) -> (Db -> String -> Maybe a) -genericlense mapper = \db arg -> Dict.get arg (mapper db) +{- timestapedlense : Db -> String -> Maybe (Person) + timestapedlense = \db arg -> Dict.get arg (.people db) + -- |> Maybe.map .value -evermoregenericlense : (Db -> b) -> (comparable -> b -> Maybe a) -> (Db -> comparable -> Maybe a) -evermoregenericlense fromDb toValue = \db arg -> toValue arg (fromDb db) + dictlense : Db -> String -> Maybe ( Person) + dictlense = \db arg -> Dict.get arg (.people db) +-} +{- genericlense : (Db -> Dict String a) -> (Db -> String -> Maybe a) + genericlense mapper = \db arg -> Dict.get arg (mapper db) -mostgenericlense : (Db -> b) -> (b -> comparable -> Maybe a) -> (a -> c) -> (Db -> comparable -> Maybe c) -mostgenericlense fromDb toFlag toValue = \db arg -> toFlag (fromDb db) arg - |> Maybe.map toValue -} + evermoregenericlense : (Db -> b) -> (comparable -> b -> Maybe a) -> (Db -> comparable -> Maybe a) + evermoregenericlense fromDb toValue = \db arg -> toValue arg (fromDb db) + mostgenericlense : (Db -> b) -> (b -> comparable -> Maybe a) -> (a -> c) -> (Db -> comparable -> Maybe c) + mostgenericlense fromDb toFlag toValue = \db arg -> toFlag (fromDb db) arg + |> Maybe.map toValue +-} {- dict2lense : Db -> String -> Maybe ( Person) -dict2lense = evermoregenericlense .people Dict.get - -timpestaped2lense : Db -> String -> Maybe Person -timpestaped2lense = mostgenericlense .people (flip Dict.get) identity -} + dict2lense = evermoregenericlense .people Dict.get + timpestaped2lense : Db -> String -> Maybe Person + timpestaped2lense = mostgenericlense .people (flip Dict.get) identity +-} {- l : (Db -> b) -> (b -> comparable -> Maybe a) -> (a -> c) -> (Db -> comparable -> Maybe c) -l = mostgenericlense -} + l = mostgenericlense +-} + car : PartialUpdater Car (String -> String -> Car) Car car = entity Car - |> attribute "owner" string .owner + |> attribute "owner" string .owner |> attribute "name" string .name type alias Foo = { foo : Person } + + + -- is: ((Person -> Foo) -> Person -> Foo) :-> e = Person, c = Foo --- +-- -- expects : ((List String -> Person) -> c): -> e = PersonBuilder -- (((List String -> Person) -> Foo) -> (List String -> Person) -> Foo) ==> expand person + type alias FooBuilder = PersonBuilder -> Foo - -foo : PartialUpdater Foo (FooBuilder) Foo -foo = +foo : PartialUpdater Foo FooBuilder Foo +foo = entity Foo |> substruct "foo" person .foo - type alias Person = { cars : List String } @@ -83,14 +92,15 @@ type alias PersonView = { cars : List Car } -type alias PersonBuilder = + +type alias PersonBuilder = List String -> Person -person : PartialUpdater Person (PersonBuilder) Person + +person : PartialUpdater Person PersonBuilder Person person = entity Person - |> references "cars" string .cars - + |> references "cars" string .cars type alias Chef = @@ -106,7 +116,8 @@ type alias ChefView = , employees : List Person } -type alias ChefBuilder = + +type alias ChefBuilder = PersonBuilder -> String -> List String -> Chef @@ -119,25 +130,27 @@ chef = type alias Db = - { people : Dict String (Person) - , cars : Dict String (Car) + { people : Dict String Person + , cars : Dict String Car } + type alias DbView = - { - people : Dict String PersonView, - cars : Dict String CarView + { people : Dict String PersonView + , cars : Dict String CarView } + type alias DbBuilder = - Dict String (PersonBuilder) -> Dict String CarBuilder -> Db + Dict String PersonBuilder -> Dict String CarBuilder -> Db -db1 : PartialUpdater Db (DbBuilder) Db -db1 = +db1 : PartialUpdater Db DbBuilder Db +db1 = entity Db - |> substruct "people" (dict (\x -> Just x) string person) .people - |> substruct "cars" (dict (\x -> Just x) string car) .cars + |> substruct "people" (dict (\x -> Just x) string person) .people + |> substruct "cars" (dict (\x -> Just x) string car) .cars + type alias Timestamp a = { created : Int @@ -146,21 +159,21 @@ type alias Timestamp a = , value : a } + timestamp : PartialUpdater a b a -> PartialUpdater (Timestamp a) (b -> Timestamp a) (Timestamp a) -timestamp other = +timestamp other = let - t = + t = entity Timestamp - |> attribute "created" int .created - |> attribute "modified" int .modified - |> attribute "accessed" int .accessed - |> substruct "value" other .value - in - { - decoder = t.decoder, - encoder = t.encoder, - fuzzer = t.fuzzer, - toString = t.toString, - empty = t.empty, - viewer = \db full -> Maybe.map (\x -> x.value ) (t.viewer db full) - } \ No newline at end of file + |> attribute "created" int .created + |> attribute "modified" int .modified + |> attribute "accessed" int .accessed + |> substruct "value" other .value + in + { decoder = t.decoder + , encoder = t.encoder + , fuzzer = t.fuzzer + , toString = t.toString + , empty = t.empty + , viewer = \db full -> Maybe.map (\x -> x.value) (t.viewer db full) + } diff --git a/src/Utils.elm b/src/Utils.elm index 5e0a3c4..dec92d0 100644 --- a/src/Utils.elm +++ b/src/Utils.elm @@ -1,6 +1,6 @@ module Utils exposing (genericTitle, logo, viewLink) -import Html exposing (Html, a, li, text ) +import Html exposing (Html, a, li, text) import Html.Attributes exposing (..) import Svg import Svg.Attributes as SA @@ -12,6 +12,7 @@ import Svg.Attributes as SA -} -- Title that is appended to every page. + genericTitle : String genericTitle = " - Elm SPA Boilerplate" diff --git a/src/Viewer.elm b/src/Viewer.elm index 6f9d7f3..4a091ae 100644 --- a/src/Viewer.elm +++ b/src/Viewer.elm @@ -31,13 +31,12 @@ import Time exposing (Posix) import Type.Database as Db import Type.Database.TypeMatching as Match import Type.IO.Form as Form -import Type.IO.Internal exposing (box, unbox) +import Type.IO.Internal exposing (Id, box, unbox) import Type.IO.Setter as Updater import Utils import Viewer.Desktop as Desktop import Viewer.Handset as Handset import Viewer.Tablet as Tablet -import Type.IO.Internal exposing (Id, box, unbox) @@ -79,8 +78,9 @@ update msg model = NewUsername text -> { model | new_username = text } - - OpenDialog -> model + + OpenDialog -> + model @@ -113,13 +113,12 @@ view session msg details h time = { title = details.title ++ Utils.genericTitle , body = viewSnackbar h - :: (let - device = - Device.fromPixel session.windowSize.width session.windowSize.height - in - case session.user of + :: (case session.user of Just userid -> let + device = + Device.fromPixel session.windowSize.width session.windowSize.height + username = Dict.get (unbox userid) session.db.users |> Maybe.map .value @@ -525,8 +524,8 @@ wideTextForm label value callback = |> TextField.setValue (Just value) |> TextField.setOnInput callback |> TextField.setLabel label - --|> TextField.outlined True TODO: Uncomment - --|> TextField.setFullwidth True + --|> TextField.outlined True TODO: Uncomment + --|> TextField.setFullwidth True ) @@ -585,7 +584,7 @@ userDialog open users new_username time = } ] ) - + uList : List (MLItem.ListItem Msg.Msg) uList = List.indexedMap (\index ( id, user ) -> @@ -606,23 +605,22 @@ userDialog open users new_username time = ] ) <| - List.map (Tuple.mapFirst box) <| - List.reverse <| - List.sortBy (\( _, b ) -> b.last_login) users + List.map (Tuple.mapFirst box) <| + List.reverse <| + List.sortBy (\( _, b ) -> b.last_login) users in - Html.div [][ - (Button.text - (Button.config - |> Button.setOnClick (Msg.Viewer OpenDrawer) - ) - "Login") + Html.div [] + [ Button.text + (Button.config + |> Button.setOnClick (Msg.Viewer OpenDrawer) + ) + "Login" , Dialog.fullscreen (Dialog.config |> Dialog.setOpen open |> Dialog.setScrimCloses False ) - { - title = "Select an account" + { title = "Select an account" , content = case uList of f :: rest -> diff --git a/src/Viewer/Desktop.elm b/src/Viewer/Desktop.elm index ec90d63..b960ad5 100644 --- a/src/Viewer/Desktop.elm +++ b/src/Viewer/Desktop.elm @@ -1,63 +1,69 @@ -module Viewer.Desktop exposing (..) +module Viewer.Desktop exposing (viewLandscape, viewPortrait) -import Html exposing (Html,text,div) +import Html exposing (Html, div, text) import Html.Attributes exposing (style) +import Material.Drawer.Permanent as Drawer exposing (config, drawer) +import Material.TopAppBar as TopAppBar exposing (config, prominent) import Viewer.Internal as I -import Material.TopAppBar as TopAppBar exposing (prominent, config) -import Material.Drawer.Permanent as Drawer exposing (drawer, config) + viewLandscape : I.ViewerConfig msg -> List (Html msg) viewLandscape config = - [ - I.viewTopAppBar - {topAppBar = prominent - (TopAppBar.config - |> TopAppBar.setDense False - |> TopAppBar.setFixed True - ) - , navButton = Just {icon = config.navButtonIcon, message = config.navButtonCallback} + [ I.viewTopAppBar + { topAppBar = + prominent + (TopAppBar.config + |> TopAppBar.setDense False + |> TopAppBar.setFixed True + ) + , navButton = Just { icon = config.navButtonIcon, message = config.navButtonCallback } , title = Maybe.withDefault "Landscape Desktop" config.title , search = Nothing , user = config.user , actions = config.actions } - , div [TopAppBar.prominentFixedAdjust, style "display" "flex" - , style "flex-flow" "row nowrap"] - [I.viewDrawer - {drawer = Drawer.drawer - (Drawer.config |> Drawer.setAttributes [ style "z-index" "1" ]) + , div + [ TopAppBar.prominentFixedAdjust + , style "display" "flex" + , style "flex-flow" "row nowrap" + ] + [ I.viewDrawer + { drawer = + Drawer.drawer + (Drawer.config |> Drawer.setAttributes [ style "z-index" "1" ]) , drawerTitle = text config.drawerTitle , drawerSubtitle = config.drawerSubtitle , content = config.drawerContent - } - , div [][config.body] + } + , div [] [ config.body ] ] + --, Drawer.content [][ config.body ] ] - + viewPortrait : I.ViewerConfig msg -> List (Html msg) viewPortrait config = - [ - I.viewTopAppBar - {topAppBar = prominent - (TopAppBar.config - |> TopAppBar.setDense False - |> TopAppBar.setFixed True - ) - , navButton = Just {icon = config.navButtonIcon, message = config.navButtonCallback} + [ I.viewTopAppBar + { topAppBar = + prominent + (TopAppBar.config + |> TopAppBar.setDense False + |> TopAppBar.setFixed True + ) + , navButton = Just { icon = config.navButtonIcon, message = config.navButtonCallback } , title = Maybe.withDefault "Portrait Desktop" config.title , search = Nothing , user = config.user , actions = config.actions } - , div [TopAppBar.prominentFixedAdjust] - [I.viewDrawer - {drawer = Drawer.drawer (Drawer.config |> Drawer.setAttributes [ style "z-index" "1" ]) + , div [ TopAppBar.prominentFixedAdjust ] + [ I.viewDrawer + { drawer = Drawer.drawer (Drawer.config |> Drawer.setAttributes [ style "z-index" "1" ]) , drawerTitle = text config.drawerTitle , drawerSubtitle = config.drawerSubtitle , content = config.drawerContent - } + } ] - , Drawer.content [] [config.body] - ] \ No newline at end of file + , Drawer.content [] [ config.body ] + ] diff --git a/src/Viewer/EditableText.elm b/src/Viewer/EditableText.elm index 409f694..da05355 100644 --- a/src/Viewer/EditableText.elm +++ b/src/Viewer/EditableText.elm @@ -1,11 +1,10 @@ -module Viewer.EditableText exposing (..) +module Viewer.EditableText exposing (Config, text) -import Html exposing (Html, Attribute) +import Html exposing (Attribute, Html, div) +import Html.Events exposing (onBlur, onClick) import Material.TextField as TextField -import Html exposing (div) -import Html.Events exposing (onClick) import Msg exposing (EditableTextMsg) -import Html.Events exposing (onBlur) + type alias Config msg = { active : Bool @@ -25,7 +24,6 @@ text c attributes value = (TextField.config |> TextField.setValue (Just value) |> TextField.setOnInput c.callback - |> TextField.setOnChange c.deactivator |> TextField.setLabel Nothing -- , fullwidth = True @@ -38,4 +36,4 @@ text c attributes value = -- list {listConfig | nonInteractive = True } -- [ listItem {listItemConfig | onClick = Just activator} -- [ - div ((onClick <| c.activator) :: (onBlur <| c.deactivator "") :: attributes) [ Html.text value ] \ No newline at end of file + div ((onClick <| c.activator) :: (onBlur <| c.deactivator "") :: attributes) [ Html.text value ] diff --git a/src/Viewer/Handset.elm b/src/Viewer/Handset.elm index 3d9bc93..c671cfa 100644 --- a/src/Viewer/Handset.elm +++ b/src/Viewer/Handset.elm @@ -1,92 +1,97 @@ -module Viewer.Handset exposing (..) +module Viewer.Handset exposing (viewLandscape, viewPortrait) -import Html exposing (Html,text,div) -import Viewer.Internal as I -import Material.TopAppBar as TopAppBar exposing (short, config) +import Html exposing (Html, div, text) +import Html.Attributes exposing (style) import Material.Drawer.Modal as Drawer exposing (config, scrim) -import Material.Typography as Typography import Material.List as MList exposing (config) import Material.List.Item as MLItem exposing (config) -import Html.Attributes exposing (style) +import Material.TopAppBar as TopAppBar exposing (config, short) +import Material.Typography as Typography +import Viewer.Internal as I viewLandscape : I.ViewerConfig msg -> List (Html msg) viewLandscape config = - [ - I.viewDrawer - {drawer = Drawer.drawer - (Drawer.config - |> Drawer.setOpen config.drawerOpen - |> Drawer.setOnClose config.closeDrawer) + [ I.viewDrawer + { drawer = + Drawer.drawer + (Drawer.config + |> Drawer.setOpen config.drawerOpen + |> Drawer.setOnClose config.closeDrawer + ) , drawerTitle = text config.drawerTitle , drawerSubtitle = config.drawerSubtitle , content = config.drawerContent - } + } , scrim [] [] - , Drawer.content [][ - I.viewTopAppBar - {topAppBar = TopAppBar.short - (TopAppBar.config - |> TopAppBar.setDense True - |> TopAppBar.setFixed False) - , navButton = Just {icon = config.navButtonIcon, message = config.navButtonCallback} + , Drawer.content [] + [ I.viewTopAppBar + { topAppBar = + TopAppBar.short + (TopAppBar.config + |> TopAppBar.setDense True + |> TopAppBar.setFixed False + ) + , navButton = Just { icon = config.navButtonIcon, message = config.navButtonCallback } , title = Maybe.withDefault "Landscape Handset" config.title , search = Nothing , user = config.user , actions = config.actions } ] - , div [TopAppBar.denseFixedAdjust][config.body] + , div [ TopAppBar.denseFixedAdjust ] [ config.body ] ] + viewPortrait : I.ViewerConfig msg -> List (Html msg) viewPortrait config = if config.drawerOpen then - [ - -- I.viewDrawer - -- {drawer = Drawer.modalDrawer {modalDrawerConfig | open = config.drawerOpen - -- , onClose = config.closeDrawer - -- } - -- , drawerTitle = config.drawerTitle - -- , drawerSubtitle = config.drawerSubtitle - -- , content = config.drawerContent - -- } - -- , drawerScrim [][] - -- , div [Drawer.appContent][ - I.viewTopAppBar - {topAppBar = TopAppBar.short - (TopAppBar.config - |> TopAppBar.setDense True - |> TopAppBar.setFixed False) - , navButton = Just {icon = "arrow_back", message = config.closeDrawer} + [ -- I.viewDrawer + -- {drawer = Drawer.modalDrawer {modalDrawerConfig | open = config.drawerOpen + -- , onClose = config.closeDrawer + -- } + -- , drawerTitle = config.drawerTitle + -- , drawerSubtitle = config.drawerSubtitle + -- , content = config.drawerContent + -- } + -- , drawerScrim [][] + -- , div [Drawer.appContent][ + I.viewTopAppBar + { topAppBar = + TopAppBar.short + (TopAppBar.config + |> TopAppBar.setDense True + |> TopAppBar.setFixed False + ) + , navButton = Just { icon = "arrow_back", message = config.closeDrawer } , title = config.drawerTitle , search = Nothing , user = config.user , actions = config.actions } - - , div [TopAppBar.denseFixedAdjust][ - MList.list MList.config - ( MLItem.listItem MLItem.config [ text "Line item" ]) - [ MLItem.listItem MLItem.config [ text "Line item" ] - ] + , div [ TopAppBar.denseFixedAdjust ] + [ MList.list MList.config + (MLItem.listItem MLItem.config [ text "Line item" ]) + [ MLItem.listItem MLItem.config [ text "Line item" ] + ] --Html.h1 [Typography.headline6][config.drawerSubtitle] + ] ] - ] + else - [ - I.viewTopAppBar - {topAppBar = TopAppBar.short - (TopAppBar.config - |> TopAppBar.setDense True - |> TopAppBar.setFixed False) - , navButton = Just {icon = config.navButtonIcon, message = config.navButtonCallback} + [ I.viewTopAppBar + { topAppBar = + TopAppBar.short + (TopAppBar.config + |> TopAppBar.setDense True + |> TopAppBar.setFixed False + ) + , navButton = Just { icon = config.navButtonIcon, message = config.navButtonCallback } , title = Maybe.withDefault "Portrait Handset" config.title , search = Nothing , user = config.user , actions = config.actions } - - , div [TopAppBar.denseFixedAdjust][config.body] - ] \ No newline at end of file + , div [ TopAppBar.denseFixedAdjust ] [ config.body ] + ] diff --git a/src/Viewer/Internal.elm b/src/Viewer/Internal.elm index 4765eb4..39ddf47 100644 --- a/src/Viewer/Internal.elm +++ b/src/Viewer/Internal.elm @@ -1,84 +1,88 @@ -module Viewer.Internal exposing (..) +module Viewer.Internal exposing (CardConfig, DrawerConfig, NavButtonConfig, SearchConfig, TopAppBarConfig, ViewerConfig, defaultCardConfig, navButton, viewCard, viewDrawer, viewTopAppBar) -import Html exposing (Html,text,div) +import Html exposing (Html, div, text) import Html.Attributes -import Time exposing (Posix) +import Html.Events import Identicon exposing (identicon) import Material.Button as Button exposing (config) -import Material.TopAppBar as TopAppBar exposing (config) -import Material.IconButton as IconButton exposing (customIcon,iconButton, config) +import Material.Card as Card exposing (config, primaryAction) +import Material.Drawer.Modal as Drawer +import Material.Icon as Icon exposing (icon) +import Material.IconButton as IconButton exposing (config, customIcon, iconButton) import Material.TextField as TextField exposing (config) import Material.TextField.Icon as TextFieldIcon -import Material.Icon as Icon exposing (icon) -import Material.Card as Card exposing (config, primaryAction) import Material.Theme as Theme -import Material.Drawer.Modal as Drawer +import Material.TopAppBar as TopAppBar exposing (config) import Material.Typography as Typography -import Html.Events +import Time exposing (Posix) + + -- -- External -- + type alias ViewerConfig msg = - { - title : Maybe String, - openDrawer : msg, - body : Html msg, - user : Maybe (Html Never), - drawerOpen : Bool, - closeDrawer : msg - , drawerTitle : String - , drawerSubtitle : Html msg - , drawerContent : Html msg - , navButtonIcon : String - , navButtonCallback : msg - , actions : List (String, msg) + { title : Maybe String + , openDrawer : msg + , body : Html msg + , user : Maybe (Html Never) + , drawerOpen : Bool + , closeDrawer : msg + , drawerTitle : String + , drawerSubtitle : Html msg + , drawerContent : Html msg + , navButtonIcon : String + , navButtonCallback : msg + , actions : List ( String, msg ) } + + -- -- TOP APP BAR -- + + type alias TopAppBarConfig msg = - { - topAppBar : List (Html msg) -> Html msg - , navButton : Maybe (NavButtonConfig msg) - , title : String - , search : Maybe (SearchConfig msg) - , actions : List (String, msg) - , user : Maybe (Html Never) + { topAppBar : List (Html msg) -> Html msg + , navButton : Maybe (NavButtonConfig msg) + , title : String + , search : Maybe (SearchConfig msg) + , actions : List ( String, msg ) + , user : Maybe (Html Never) } + type alias NavButtonConfig msg = - { - icon : String, - message : msg + { icon : String + , message : msg } + type alias SearchConfig msg = - { - search : String, - callback : String -> msg + { search : String + , callback : String -> msg } + viewTopAppBar : TopAppBarConfig msg -> Html msg viewTopAppBar config = - config.topAppBar [ TopAppBar.row [] - [ - TopAppBar.section [ TopAppBar.alignStart ] - [ Maybe.map (navButton) config.navButton - |> Maybe.withDefault (div [][]) - , Html.span - [ TopAppBar.title - - --, Html.Attributes.style "text-transform" "uppercase" - --, Html.Attributes.style "font-weight" "400" - --, Typography.headline5 - ] - [ text config.title ] + [ TopAppBar.section [ TopAppBar.alignStart ] + [ Maybe.map navButton config.navButton + |> Maybe.withDefault (div [] []) + , Html.span + [ TopAppBar.title + + --, Html.Attributes.style "text-transform" "uppercase" + --, Html.Attributes.style "font-weight" "400" + --, Typography.headline5 ] + [ text config.title ] + ] , TopAppBar.section [ TopAppBar.alignEnd ] <| [ case config.search of Nothing -> @@ -87,78 +91,85 @@ viewTopAppBar config = Just s -> TextField.filled <| (TextField.config - |> TextField.setTrailingIcon (Just <| TextFieldIcon.icon "search") - |> TextField.setValue (Just <| s.search) - |> TextField.setAttributes [Theme.surface] - |> TextField.setOnInput s.callback - - -- { textFieldConfig - -- | trailingIcon = TextField.textFieldIcon iconConfig "search" - -- , value = s.search - - -- --, outlined = True - -- , additionalAttributes = [ Theme.surface ] - -- , onInput = Just s.callback - -- } + |> TextField.setTrailingIcon (Just <| TextFieldIcon.icon "search") + |> TextField.setValue (Just <| s.search) + |> TextField.setAttributes [ Theme.surface ] + |> TextField.setOnInput s.callback + -- { textFieldConfig + -- | trailingIcon = TextField.textFieldIcon iconConfig "search" + -- , value = s.search + -- --, outlined = True + -- , additionalAttributes = [ Theme.surface ] + -- , onInput = Just s.callback + -- } ) ] - ++ List.map (\(iconName, callback) -> + ++ List.map + (\( iconName, callback ) -> + IconButton.iconButton + (IconButton.config + |> IconButton.setAttributes + [ TopAppBar.actionItem ] + |> IconButton.setOnClick callback + ) + (IconButton.icon iconName) + ) + config.actions + ++ [ case config.user of + Nothing -> + div [] [] + + Just s -> IconButton.iconButton (IconButton.config - |> IconButton.setAttributes - [ TopAppBar.actionItem ] - |> IconButton.setOnClick callback + |> IconButton.setAttributes [ TopAppBar.actionItem ] + ) + (IconButton.customIcon Html.i + [] + [ s ] ) - (IconButton.icon iconName) - ) config.actions ++ - [ case config.user of - Nothing -> - div [] [] - Just s -> - IconButton.iconButton - (IconButton.config - |> IconButton.setAttributes [ TopAppBar.actionItem ] ) - (IconButton.customIcon Html.i [] - [s]) - - - -- customIconButton - -- { iconButtonConfig | additionalAttributes = [ TopAppBar.actionItem ] } - -- [ s ] - ] + -- customIconButton + -- { iconButtonConfig | additionalAttributes = [ TopAppBar.actionItem ] } + -- [ s ] + ] ] ] + navButton : NavButtonConfig msg -> Html msg navButton config = IconButton.iconButton - ( - IconButton.config - |> IconButton.setAttributes [TopAppBar.navigationIcon] + (IconButton.config + |> IconButton.setAttributes [ TopAppBar.navigationIcon ] |> IconButton.setOnClick config.message ) - <| IconButton.icon config.icon - -- iconButton - -- { iconButtonConfig - -- | additionalAttributes = [ TopAppBar.navigationIcon ] - -- , onClick = config.message - -- } - -- config.icon + <| + IconButton.icon config.icon + + +-- iconButton +-- { iconButtonConfig +-- | additionalAttributes = [ TopAppBar.navigationIcon ] +-- , onClick = config.message +-- } +-- config.icon -- -- DRAWER -- + + type alias DrawerConfig msg = - { - drawer : List (Html msg) -> Html msg - , drawerTitle : Html msg - , drawerSubtitle : Html msg - , content : Html msg + { drawer : List (Html msg) -> Html msg + , drawerTitle : Html msg + , drawerSubtitle : Html msg + , content : Html msg } + viewDrawer : DrawerConfig msg -> Html msg -viewDrawer config = +viewDrawer config = config.drawer -- Drawer.dismissibleDrawer -- { dismissibleDrawerConfig @@ -168,61 +179,70 @@ viewDrawer config = -- [ TopAppBar.fixedAdjust -- ] -- } - [ Drawer.header [] - [Html.h3 [ Drawer.title ] [ config.drawerTitle] - , Html.h6 [ Drawer.subtitle ] [ config.drawerSubtitle ] - ] - -- drawerHeader [] - -- [ Maybe.map (identicon "100%") detail.user - -- |> Maybe.withDefault (div [] []) - -- ] - , config.content - -- drawerContent [] [] + [ Drawer.header [] + [ Html.h3 [ Drawer.title ] [ config.drawerTitle ] + , Html.h6 [ Drawer.subtitle ] [ config.drawerSubtitle ] ] - -- , div [ Drawer.appContent, Typography.typography ] - -- [body] + -- drawerHeader [] + -- [ Maybe.map (identicon "100%") detail.user + -- |> Maybe.withDefault (div [] []) + -- ] + , config.content + + -- drawerContent [] [] + ] + + + +-- , div [ Drawer.appContent, Typography.typography ] +-- [body] -- -- CARD --- +-- + + defaultCardConfig : CardConfig msg -defaultCardConfig = - { - id = "", - title= "", - primaryAction = Nothing +defaultCardConfig = + { id = "" + , title = "" + , primaryAction = Nothing } + type alias CardConfig msg = - { - id : String, - title: String, - primaryAction : Maybe msg + { id : String + , title : String + , primaryAction : Maybe msg } + viewCard : CardConfig msg -> Html msg -viewCard config = +viewCard config = let - primod x = case config.primaryAction of - Just pA -> - Card.primaryAction [Html.Events.onClick pA] x - Nothing -> - x + primod : List (Card.Block msg) -> List (Card.Block msg) + primod x = + case config.primaryAction of + Just pA -> + Card.primaryAction [ Html.Events.onClick pA ] x + + Nothing -> + x in - Card.card - - Card.config - { - blocks = primod [ - Card.block <| - div - [Html.Attributes.style "margin-left" "auto" - , Html.Attributes.style "margin-right" "auto" - , Html.Attributes.style "padding-top" "1rem" - , Html.Attributes.style "width" "25%"] - [identicon "100%" config.id] - , Card.block <| - Html.div [ Html.Attributes.style "padding" "1rem" ] + Card.card + Card.config + { blocks = + primod + [ Card.block <| + div + [ Html.Attributes.style "margin-left" "auto" + , Html.Attributes.style "margin-right" "auto" + , Html.Attributes.style "padding-top" "1rem" + , Html.Attributes.style "width" "25%" + ] + [ identicon "100%" config.id ] + , Card.block <| + Html.div [ Html.Attributes.style "padding" "1rem" ] [ Html.h2 [ Typography.headline6 , Html.Attributes.style "margin" "0" @@ -235,69 +255,70 @@ viewCard config = ] [ text "Some interesting Subtitle" ] ] - , Card.block <| - Html.div + , Card.block <| + Html.div [ Html.Attributes.style "padding" "0 1rem 0.5rem 1rem" , Typography.body2 , Theme.textSecondaryOnBackground ] [ Html.p [] [ text "Description" ] ] ] - , actions = Just <| Card.actions + , actions = + Just <| + Card.actions { buttons = - [ Card.button Button.config - "Visit" - ] - , icons = - [ Card.icon IconButton.config - <| IconButton.icon "favorite" - ] - } - - } - - -- Card.card cardConfig - -- { blocks = Card.cardPrimaryAction {cardPrimaryActionConfig | onClick = config.primaryAction} - -- [ Card.cardBlock <| - -- div [Html.Attributes.style "margin-left" "auto" - -- , Html.Attributes.style "margin-right" "auto" - -- , Html.Attributes.style "padding-top" "1rem" - -- , Html.Attributes.style "width" "25%"] - -- [identicon "100%" config.id] - -- , Card.cardBlock <| - -- Html.div [ Html.Attributes.style "padding" "1rem" ] - -- [ Html.h2 - -- [ Typography.headline6 - -- , Html.Attributes.style "margin" "0" - -- ] - -- [ text <| "Coding: "++ config.id ] - -- , Html.h3 - -- [ Typography.subtitle2 - -- , Theme.textSecondaryOnBackground - -- , Html.Attributes.style "margin" "0" - -- ] - -- [ text "Some interesting Subtitle" ] - -- ] - -- , Card.cardBlock <| - -- Html.div - -- [ Html.Attributes.style "padding" "0 1rem 0.5rem 1rem" - -- , Typography.body2 - -- , Theme.textSecondaryOnBackground - -- ] - -- [ Html.p [] [ text "Description" ] ] - -- ] - -- , actions = - -- Just <| - -- Card.cardActions - -- { buttons = - -- [ Card.cardActionButton buttonConfig - -- "Visit" - -- ] - -- , icons = - -- [ Card.cardActionIcon iconButtonConfig - -- "favorite" - -- ] - -- } - -- } + [ Card.button Button.config + "Visit" + ] + , icons = + [ Card.icon IconButton.config <| + IconButton.icon "favorite" + ] + } + } + +-- Card.card cardConfig +-- { blocks = Card.cardPrimaryAction {cardPrimaryActionConfig | onClick = config.primaryAction} +-- [ Card.cardBlock <| +-- div [Html.Attributes.style "margin-left" "auto" +-- , Html.Attributes.style "margin-right" "auto" +-- , Html.Attributes.style "padding-top" "1rem" +-- , Html.Attributes.style "width" "25%"] +-- [identicon "100%" config.id] +-- , Card.cardBlock <| +-- Html.div [ Html.Attributes.style "padding" "1rem" ] +-- [ Html.h2 +-- [ Typography.headline6 +-- , Html.Attributes.style "margin" "0" +-- ] +-- [ text <| "Coding: "++ config.id ] +-- , Html.h3 +-- [ Typography.subtitle2 +-- , Theme.textSecondaryOnBackground +-- , Html.Attributes.style "margin" "0" +-- ] +-- [ text "Some interesting Subtitle" ] +-- ] +-- , Card.cardBlock <| +-- Html.div +-- [ Html.Attributes.style "padding" "0 1rem 0.5rem 1rem" +-- , Typography.body2 +-- , Theme.textSecondaryOnBackground +-- ] +-- [ Html.p [] [ text "Description" ] ] +-- ] +-- , actions = +-- Just <| +-- Card.cardActions +-- { buttons = +-- [ Card.cardActionButton buttonConfig +-- "Visit" +-- ] +-- , icons = +-- [ Card.cardActionIcon iconButtonConfig +-- "favorite" +-- ] +-- } +-- } diff --git a/src/Viewer/OrderAwareList.elm b/src/Viewer/OrderAwareList.elm index 83dc0b0..42a3855 100644 --- a/src/Viewer/OrderAwareList.elm +++ b/src/Viewer/OrderAwareList.elm @@ -1,4 +1,4 @@ -module Viewer.OrderAwareList exposing (..) +module Viewer.OrderAwareList exposing (OrderAware, orderAwareList, prePost) import Type.IO.Internal exposing (Id) @@ -35,6 +35,7 @@ prePost prev xs = orderAwareList : List ( Id a String, a ) -> List (OrderAware a) orderAwareList old = let + mapToValue : Maybe (Id a String, a) -> Maybe { id : Id a String, value:a} mapToValue a = case a of Just ( id, val ) -> diff --git a/src/Viewer/Tablet.elm b/src/Viewer/Tablet.elm index 7f20b10..4951819 100644 --- a/src/Viewer/Tablet.elm +++ b/src/Viewer/Tablet.elm @@ -1,87 +1,95 @@ -module Viewer.Tablet exposing (..) +module Viewer.Tablet exposing (viewLandscape, viewPortrait) -import Html exposing (Html,text,div) +import Html exposing (Html, div, text) import Html.Attributes exposing (style) -import Viewer.Internal as I -import Material.TopAppBar as TopAppBar import Material.Drawer.Dismissible as DDrawer import Material.Drawer.Modal as MDrawer +import Material.TopAppBar as TopAppBar +import Viewer.Internal as I + viewLandscape : I.ViewerConfig msg -> List (Html msg) viewLandscape config = - [ - I.viewTopAppBar - {topAppBar = TopAppBar.regular + [ I.viewTopAppBar + { topAppBar = + TopAppBar.regular (TopAppBar.config |> TopAppBar.setDense True - |> TopAppBar.setFixed True) - , navButton = Just {icon = config.navButtonIcon, message = config.navButtonCallback} - , title = Maybe.withDefault "Landscape Tablet" config.title - , search = Nothing - , user = config.user - , actions = config.actions - }, - div [TopAppBar.denseFixedAdjust][ - I.viewDrawer - {drawer = DDrawer.drawer - (DDrawer.config - |> DDrawer.setOpen config.drawerOpen - |> DDrawer.setOnClose config.closeDrawer - |> DDrawer.setAttributes [ style "z-index" "1" ]) + |> TopAppBar.setFixed True + ) + , navButton = Just { icon = config.navButtonIcon, message = config.navButtonCallback } + , title = Maybe.withDefault "Landscape Tablet" config.title + , search = Nothing + , user = config.user + , actions = config.actions + } + , div [ TopAppBar.denseFixedAdjust ] + [ I.viewDrawer + { drawer = + DDrawer.drawer + (DDrawer.config + |> DDrawer.setOpen config.drawerOpen + |> DDrawer.setOnClose config.closeDrawer + |> DDrawer.setAttributes [ style "z-index" "1" ] + ) , drawerTitle = text config.drawerTitle , drawerSubtitle = config.drawerSubtitle , content = config.drawerContent } - , DDrawer.content [] [ - config.body + , DDrawer.content [] + [ config.body ] - ] + ] ] + viewPortrait : I.ViewerConfig msg -> List (Html msg) viewPortrait config = - - -- [ topAppBar topAppBarConfig - -- [ TopAppBar.row [] - -- [ TopAppBar.section [ TopAppBar.alignStart ] - -- [ Html.span [ TopAppBar.title ] - -- [ text "Title" ] - -- ] - -- ] - -- ] - -- , Drawer.modalDrawer - -- { modalDrawerConfig - -- | open = True - -- , onClose = config.closeDrawer - -- , additionalAttributes = [] - -- } - -- [ Drawer.drawerContent [TopAppBar.fixedAdjust] [] ] - -- , drawerScrim [] [] - -- , Html.div [Drawer.appContent] [ config.body ] - -- ] - [ - I.viewDrawer - {drawer = MDrawer.drawer (MDrawer.config - |> MDrawer.setOpen config.drawerOpen - |> MDrawer.setOnClose config.closeDrawer) + -- [ topAppBar topAppBarConfig + -- [ TopAppBar.row [] + -- [ TopAppBar.section [ TopAppBar.alignStart ] + -- [ Html.span [ TopAppBar.title ] + -- [ text "Title" ] + -- ] + -- ] + -- ] + -- , Drawer.modalDrawer + -- { modalDrawerConfig + -- | open = True + -- , onClose = config.closeDrawer + -- , additionalAttributes = [] + -- } + -- [ Drawer.drawerContent [TopAppBar.fixedAdjust] [] ] + -- , drawerScrim [] [] + -- , Html.div [Drawer.appContent] [ config.body ] + -- ] + [ I.viewDrawer + { drawer = + MDrawer.drawer + (MDrawer.config + |> MDrawer.setOpen config.drawerOpen + |> MDrawer.setOnClose config.closeDrawer + ) , drawerTitle = text config.drawerTitle , drawerSubtitle = config.drawerSubtitle , content = config.drawerContent - } + } , MDrawer.scrim [] [] - , Html.div [] [ --MDrawer.content - I.viewTopAppBar - {topAppBar = - TopAppBar.regular - (TopAppBar.config - |> TopAppBar.setDense True - |> TopAppBar.setFixed True) - , navButton = Just {icon = config.navButtonIcon, message = config.navButtonCallback} + , Html.div [] + [ --MDrawer.content + I.viewTopAppBar + { topAppBar = + TopAppBar.regular + (TopAppBar.config + |> TopAppBar.setDense True + |> TopAppBar.setFixed True + ) + , navButton = Just { icon = config.navButtonIcon, message = config.navButtonCallback } , title = Maybe.withDefault "Portrait Tablet" config.title , search = Nothing , user = config.user , actions = config.actions } ] - , div [TopAppBar.fixedAdjust] [config.body] - ] \ No newline at end of file + , div [ TopAppBar.fixedAdjust ] [ config.body ] + ] diff --git a/tests/AquisitionTest.elm b/tests/AquisitionTest.elm index 254e5f5..c403abd 100644 --- a/tests/AquisitionTest.elm +++ b/tests/AquisitionTest.elm @@ -1,34 +1,38 @@ -module AquisitionTest exposing (..) +module AquisitionTest exposing (aquireQuestion, suite) -import Expect import Dict exposing (Dict) +import Expect import Test exposing (..) import Type.Database exposing (..) -import Type.IO exposing (..) -import Type.Database.TypeMatching as Match import Type.Database.Aquisition as Aq exposing (..) -import Type.IO.Internal exposing (Id, unbox, box) +import Type.Database.TypeMatching as Match +import Type.IO exposing (..) +import Type.IO.Internal exposing (Id, box, unbox) + aquireQuestion : Id Answer String -> Database -> String aquireQuestion id db = Aquisition identity id - -- |> start (Value .question) db.questions (Value .text) - |> moveReferenceSingle (Raw Tuple.first) db.answers (Value .question) - |> add (Raw Tuple.first) db.questions (Value .text) - |> aquire - |> List.head - |> Maybe.withDefault "" + -- |> start (Value .question) db.questions (Value .text) + |> moveReferenceSingle (Raw Tuple.first) db.answers (Value .question) + |> add (Raw Tuple.first) db.questions (Value .text) + |> aquire + |> List.head + |> Maybe.withDefault "" + suite : Test -suite = - describe "Main" [ - fuzz string.fuzzer "string" <| +suite = + describe "Main" + [ fuzz string.fuzzer "string" <| \val -> Expect.equal val val , fuzz3 database.fuzzer (timestamp question).fuzzer (timestamp answer).fuzzer "Pathlength 2" <| - \db q a-> - {db | questions = Dict.insert (unbox a.value.question) q db.questions} - |> \x -> {x | answers = Dict.insert "myspecialkey" a x.answers} - |> aquireQuestion (box "myspecialkey") - |> Expect.equal q.value.text - ] \ No newline at end of file + \db q a -> + { db | questions = Dict.insert (unbox a.value.question) q db.questions } + |> (\x -> + { x | answers = Dict.insert "myspecialkey" a x.answers } + |> aquireQuestion (box "myspecialkey") + |> Expect.equal q.value.text + ) + ] diff --git a/tests/Example.elm b/tests/Example.elm index 8b2a5a0..e0c159f 100644 --- a/tests/Example.elm +++ b/tests/Example.elm @@ -1,15 +1,15 @@ -module Example exposing (..) +module Example exposing (suite) import Dict import Expect import Fuzz import Json.Decode import Json.Encode -import Test exposing (..) +import Test exposing (describe, Test, fuzz, fuzz2) import Type.Database exposing (..) import Type.IO exposing (..) -import Type.IO.Setter as Set exposing (Msg(..)) import Type.IO.Internal exposing (box) +import Type.IO.Setter as Set exposing (Msg(..)) suite : Test @@ -120,14 +120,13 @@ suite = |> Json.Decode.decodeValue question.decoder |> Expect.equal (Ok val) ] - , - describe "FullTest" - [ fuzz database.fuzzer "Database" <| - \db -> - encode database.encoder db - |> Json.Decode.decodeValue database.decoder - |> Expect.equal (Ok db) - ] + , describe "FullTest" + [ fuzz database.fuzzer "Database" <| + \db -> + encode database.encoder db + |> Json.Decode.decodeValue database.decoder + |> Expect.equal (Ok db) + ] , describe "SetterTest" [ fuzz2 answer.fuzzer string.fuzzer "Answer: Question" <| \answ question -> diff --git a/tests/Tests.elm b/tests/Tests.elm index edddd25..91dc97b 100644 --- a/tests/Tests.elm +++ b/tests/Tests.elm @@ -1,7 +1,8 @@ -module Tests exposing (..) +module Tests exposing (all) -import Test exposing (..) import Expect +import Test exposing (Test, test, describe) + -- Check out http://package.elm-lang.org/packages/elm-community/elm-test/latest to learn more about testing in Elm! From 0e262c5f842694a847d49a9df903165619bcb107 Mon Sep 17 00:00:00 2001 From: Jerome Bergmann Date: Mon, 11 Apr 2022 18:04:58 +0200 Subject: [PATCH 02/15] Getting some Progress done --- review/src/ReviewConfig.elm | 11 +- src/TestDrawer.elm | 1 + src/Type/Database/Aquisition.elm | 14 +++ src/Type/Database/InputType.elm | 3 +- src/Type/Database/TypeMatching.elm | 11 +- src/Type/Entity.elm | 2 + src/Type/IO/Form.elm | 21 +++- src/Type/IO/Setter.elm | 1 + src/Type/IO/ToString.elm | 3 + src/Type/IOTest.elm | 141 ----------------------- src/Type/Par.elm | 79 ------------- src/Type/Timestamp.elm | 2 +- src/Type/UpdateTest.elm | 179 ----------------------------- src/Utils.elm | 2 +- src/Viewer.elm | 7 ++ src/Viewer/OrderAwareList.elm | 2 +- tests/Example.elm | 2 +- tests/Tests.elm | 2 +- 18 files changed, 67 insertions(+), 416 deletions(-) delete mode 100644 src/Type/IOTest.elm delete mode 100644 src/Type/Par.elm delete mode 100644 src/Type/UpdateTest.elm diff --git a/review/src/ReviewConfig.elm b/review/src/ReviewConfig.elm index 139439b..7802906 100644 --- a/review/src/ReviewConfig.elm +++ b/review/src/ReviewConfig.elm @@ -15,17 +15,17 @@ import NoAlways import NoBooleanCase import NoDebug.Log import NoDebug.TodoOrToString +import NoDeprecated import NoDuplicatePorts -import NoUnsafePorts import NoEmptyText -import NoUnusedPorts -import NoDeprecated import NoExposingEverything import NoImportingEverything import NoMissingTypeAnnotation import NoMissingTypeAnnotationInLetIn import NoMissingTypeExpose import NoPrematureLetComputation +import NoUnsafePorts +import NoUnusedPorts import Review.Rule exposing (Rule) @@ -42,10 +42,11 @@ config = , NoExposingEverything.rule , NoDeprecated.rule NoDeprecated.defaults , NoImportingEverything.rule [] - |> Review.Rule.ignoreErrorsForDirectories [ "tests/"] + |> Review.Rule.ignoreErrorsForDirectories [ "tests/" ] , NoMissingTypeAnnotation.rule , NoMissingTypeAnnotationInLetIn.rule - |> Review.Rule.ignoreErrorsForDirectories [ "tests/"] + |> Review.Rule.ignoreErrorsForDirectories [ "tests/" ] + |> Review.Rule.ignoreErrorsForFiles [ "src/Type/Database/TypeMatching.elm" ] , NoMissingTypeExpose.rule , NoPrematureLetComputation.rule ] diff --git a/src/TestDrawer.elm b/src/TestDrawer.elm index c6ec754..5575f9a 100644 --- a/src/TestDrawer.elm +++ b/src/TestDrawer.elm @@ -20,6 +20,7 @@ import Material.List import Material.List.Item exposing (config, listItem) +main : Html.Html msg main = Html.div [] [ drawer ModalDrawer.config diff --git a/src/Type/Database/Aquisition.elm b/src/Type/Database/Aquisition.elm index 3d5c61f..3f53ae2 100644 --- a/src/Type/Database/Aquisition.elm +++ b/src/Type/Database/Aquisition.elm @@ -17,18 +17,27 @@ type alias Aquisition a b c = } +start : + AttributeAccessor c (Id d e) + -> Table c + -> AttributeAccessor c a + -> Aquisition (a -> b) d e + -> List (Aquisition b d e) start = addAttrSingle +add : AttributeAccessor c (Id d e) -> Table c -> AttributeAccessor c a -> List (Aquisition (a -> b) d e) -> List (Aquisition b d e) add = addAttrList +move : AttributeAccessor c (Id a f) -> Table c -> AttributeAccessor c (Id b e) -> List (Aquisition d a f) -> List (Aquisition d b e) move = moveReferenceList +end : List (Aquisition a b c) -> List a end = aquire @@ -85,9 +94,11 @@ addAttrSingle : -> List (Aquisition b d e) addAttrSingle attr table selectvalue aquisition = let + attrf : Row c -> Id d e attrf = transformAccessor attr + selectf : Row c -> a selectf = transformAccessor selectvalue in @@ -96,6 +107,7 @@ addAttrSingle attr table selectvalue aquisition = |> List.map (updateReciever aquisition) +filterBy : (Row a -> Id b c) -> Table a -> Id b c -> List (Row a) filterBy attr table old = table |> Db.rows @@ -115,9 +127,11 @@ moveReferenceSingle : -> List (Aquisition d b e) moveReferenceSingle attr table selectvalue aquisition = let + attrf : Row c -> Id a f attrf = transformAccessor attr + selectf : Row c -> Id b e selectf = transformAccessor selectvalue in diff --git a/src/Type/Database/InputType.elm b/src/Type/Database/InputType.elm index 4bdf957..24b2fb5 100644 --- a/src/Type/Database/InputType.elm +++ b/src/Type/Database/InputType.elm @@ -4,7 +4,7 @@ import Dict exposing (Dict) import Fuzz import Json.Decode import Json.Encode -import Type.IO exposing (..) +import Type.IO exposing (IO, attribute, entity, int, list, maybe, string, substruct) import Type.IO.Encoder as Encoder exposing (Encoder(..)) import Type.IO.Form as Form exposing (Form) import Type.IO.Setter as Updater exposing (Updater) @@ -88,6 +88,7 @@ singleInputType = singleInputTypeDecoder : Json.Decode.Decoder SingleInputType singleInputTypeDecoder = let + helper : String -> Json.Decode.Decoder SingleInputType helper name = case name of "radio" -> diff --git a/src/Type/Database/TypeMatching.elm b/src/Type/Database/TypeMatching.elm index 8f8c45e..064e715 100644 --- a/src/Type/Database/TypeMatching.elm +++ b/src/Type/Database/TypeMatching.elm @@ -1,12 +1,13 @@ module Type.Database.TypeMatching exposing (DispatchType(..), FieldConfig, FieldUpdateConfig, concatTupleFirst, concatTupleLast, delete, dispatchDb, fields, filterBy, forms, fromString, getField, getTimestampUpdaterMsg, join, keys, new, resolveAttributes, setField, setFieldRaw, setManyFields, setTimestamp, swapFields, toString, toStringPlural, types, updateField) -import Dict exposing (..) +import Dict exposing (Dict) import Html exposing (Html) import Msg import Task exposing (perform) import Time exposing (Posix, now, posixToMillis) -import Type.Database as Db exposing (..) +import Type.Database as Db exposing (Database, InputTypeKind(..), Row, Table, Type(..), answer, coder, coding, coding_answer, coding_frame, coding_question, coding_questionary, database, event, question, questionary, study, test_subject, timestamp, user) import Type.Database.InputType as IT exposing (InputType, input_type) +import Type.IO exposing (IO) import Type.IO.Form as Form exposing (UpdateMsg(..)) import Type.IO.Internal as Id exposing (Id, unbox) import Type.IO.Setter as Updater @@ -222,6 +223,7 @@ fields kind = keys : Type -> Database -> List String keys kind db = let + g : Dict comparable b -> List comparable g = Dict.keys in @@ -280,6 +282,7 @@ forms id kind acc db f = Form.DictMsg (Just id) <| Form.AttrMsg "value" x + --g : IO a Database c Msg.Msg -> Table a -> Result Form.Error (Html.Html Msg.Msg) g def table = Dict.get id table |> Maybe.map (\x -> def.form id m x.value acc f) @@ -347,11 +350,13 @@ delete = dispatchDb : DispatchType -> Id a String -> Type -> Database -> Database dispatchDb dt id kind db = let + --g : Table a -> IO a Database c msg -> (Database -> Table a -> Database) -> Database g table def update = update db <| case dt of New u -> let + --config : Timestamp a config = (timestamp def).empty in @@ -454,6 +459,7 @@ filterBy attr dbgetter db old = resolveAttributes : (a -> Id b String) -> (Database -> Table b) -> Database -> Row a -> List ( Row a, Row b ) resolveAttributes attr dbgetter db ( oldid, fullold ) = let + f : Id b String -> List (Row b) f id = dbgetter db |> Db.rows @@ -467,6 +473,7 @@ resolveAttributes attr dbgetter db ( oldid, fullold ) = join : (Row b -> Id a String) -> (Database -> Table b) -> Database -> List (Row a) -> List ( Row a, Row b ) join attr dbgetter db old = let + k : List (Id a String) k = List.map (\( id, value ) -> id) old in diff --git a/src/Type/Entity.elm b/src/Type/Entity.elm index 966e761..c661cc1 100644 --- a/src/Type/Entity.elm +++ b/src/Type/Entity.elm @@ -275,9 +275,11 @@ match_model : (flag -> mediator -> Maybe a) -> (flag -> mediator -> Maybe (a -> match_model getter old_model = \flag mediator -> let + value : Maybe a value = getter flag mediator + func : Maybe (a -> model) func = old_model flag mediator in diff --git a/src/Type/IO/Form.elm b/src/Type/IO/Form.elm index 41813d6..c400506 100644 --- a/src/Type/IO/Form.elm +++ b/src/Type/IO/Form.elm @@ -138,6 +138,7 @@ float name callback kind label f = bool : Form Bool msg bool _ callback kind _ f = let + bool2state : Maybe Bool -> Checkbox.State bool2state state = case state of Just True -> @@ -191,6 +192,7 @@ bool _ callback kind _ f = maybe : Form a msg -> Form (Maybe a) msg maybe old name callback kind acc f = let + new : Maybe (Result Error (Html msg)) new = Maybe.map (\x -> old name (callback << MaybeMsg) x acc f) kind in @@ -212,8 +214,10 @@ maybe old name callback kind acc f = list : Form a msg -> Form (List a) msg list old name callback kind acc f = let - new = + getnew : Int -> Maybe (Result Error (Html msg)) + getnew my = List.indexedMap (\index instance -> old name (callback << ListMsg index) instance rest f) kind + |> List.Extra.getAt my ( parsedIndex, rest ) = parseHeadTail acc @@ -223,7 +227,7 @@ list old name callback kind acc f = -- |> List.concat -- else String.toInt parsedIndex - |> Maybe.andThen (\x -> List.Extra.getAt x new) + |> Maybe.andThen getnew |> Maybe.withDefault (Err ListError) @@ -262,6 +266,7 @@ list old name callback kind acc f = dict : (comparable -> Maybe String) -> Form a msg -> Form (Dict comparable a) msg dict keySerializer old name callback kind acc f = let + new : Dict comparable (Result Error (Html msg)) new = Dict.map (\key instance -> old name (callback << DictMsg (keySerializer key)) instance rest f) kind @@ -387,8 +392,10 @@ result err val name callback kind acc = array : Form a msg -> Form (Array a) msg array old name callback kind acc f = let - new = + getnew : Int -> Maybe (Result Error (Html.Html msg)) + getnew my = Array.indexedMap (\index instance -> old name (callback << ArrayMsg index) instance rest f) kind + |> Array.get my ( parsedIndex, rest ) = parseHeadTail acc @@ -399,7 +406,7 @@ array old name callback kind acc f = -- |> List.concat -- else String.toInt parsedIndex - |> Maybe.andThen (\x -> Array.get x new) + |> Maybe.andThen getnew |> Maybe.withDefault (Err ArrayError) @@ -416,6 +423,7 @@ attribute name getter childform parentform label callback kind acc = in if name == head then let + newname : String newname = label ++ "." ++ name in @@ -444,6 +452,7 @@ reference name getter childform parentform label callback kind acc = in if name == head then let + newname : String newname = label ++ "." ++ name in @@ -462,6 +471,7 @@ references name getter childform parentform label callback kind acc = ( head, tail ) = parseHeadTail acc + newname : String newname = label ++ "." ++ name in @@ -480,6 +490,7 @@ substruct name getter childform parentform label callback kind acc = in if name == head then let + newname : String newname = label ++ "." ++ name in @@ -495,11 +506,13 @@ substruct name getter childform parentform label callback kind acc = parseHeadTail : String -> ( String, String ) parseHeadTail accessor = let + index : String index = String.split "." accessor |> List.head |> Maybe.withDefault "" + rest : String rest = String.split "." accessor |> List.tail diff --git a/src/Type/IO/Setter.elm b/src/Type/IO/Setter.elm index 04b92ed..2cfb3bb 100644 --- a/src/Type/IO/Setter.elm +++ b/src/Type/IO/Setter.elm @@ -309,6 +309,7 @@ attribute name getter def parent msg car = reference : String -> (car -> Id a comparable) -> Updater comparable -> PartialUpdater car (Id a comparable -> b) -> PartialUpdater car b reference name getter def parent msg car = let + iddef : Msg -> Id a comparable -> Result Error (Id a comparable) iddef msg_ car_ = def msg_ (Id.unbox car_) |> Result.map Id.box diff --git a/src/Type/IO/ToString.elm b/src/Type/IO/ToString.elm index 67c594e..2724f3a 100644 --- a/src/Type/IO/ToString.elm +++ b/src/Type/IO/ToString.elm @@ -102,6 +102,7 @@ dict keys values name dictionary = ( head, rest ) = parseHeadTail name + lkey : List comparable lkey = Dict.keys dictionary |> List.filter @@ -268,12 +269,14 @@ parseHeadTail accessor = else let + rest : String rest = String.split "." accessor |> List.tail |> Maybe.map (String.join ".") |> Maybe.withDefault "" + index : String index = String.split "." accessor |> List.head diff --git a/src/Type/IOTest.elm b/src/Type/IOTest.elm deleted file mode 100644 index faa28c4..0000000 --- a/src/Type/IOTest.elm +++ /dev/null @@ -1,141 +0,0 @@ -module Type.IOTest exposing (Car, CarView, Chef, ChefView, Db, DbView, Person, PersonView, Timestamp, car, chef, db1, flip, person, timestamp) - -import Dict exposing (Dict) -import Type.IO exposing (..) - - -type alias Car = - { owner : String - , name : String - } - - -type alias CarView = - { owner : Person - , name : String - } - - -flip : (a -> b -> c) -> b -> a -> c -flip f second first = - f first second - - - -{- timestapedlense : Db -> String -> Maybe (Person) - timestapedlense = \db arg -> Dict.get arg (.people db) - -- |> Maybe.map .value - - dictlense : Db -> String -> Maybe ( Person) - dictlense = \db arg -> Dict.get arg (.people db) --} -{- genericlense : (Db -> Dict String a) -> (Db -> String -> Maybe a) - genericlense mapper = \db arg -> Dict.get arg (mapper db) - - evermoregenericlense : (Db -> b) -> (comparable -> b -> Maybe a) -> (Db -> comparable -> Maybe a) - evermoregenericlense fromDb toValue = \db arg -> toValue arg (fromDb db) - - mostgenericlense : (Db -> b) -> (b -> comparable -> Maybe a) -> (a -> c) -> (Db -> comparable -> Maybe c) - mostgenericlense fromDb toFlag toValue = \db arg -> toFlag (fromDb db) arg - |> Maybe.map toValue --} -{- dict2lense : Db -> String -> Maybe ( Person) - dict2lense = evermoregenericlense .people Dict.get - - timpestaped2lense : Db -> String -> Maybe Person - timpestaped2lense = mostgenericlense .people (flip Dict.get) identity --} -{- l : (Db -> b) -> (b -> comparable -> Maybe a) -> (a -> c) -> (Db -> comparable -> Maybe c) - l = mostgenericlense --} - - -car : IO Car Db CarView -car = - entity Car CarView - |> reference "owner" string .owner .people Dict.get .value - |> attribute "name" string .name - - -type alias Person = - { cars : List String - } - - -type alias PersonView = - { cars : List Car - } - - -person : IO Person Db PersonView -person = - entity Person PersonView - |> references "cars" string .cars .cars Dict.get .value - - -type alias Chef = - { person : Person - , name : String - , employees : List String - } - - -type alias ChefView = - { person : PersonView - , name : String - , employees : List Person - } - - -chef : IO Chef Db ChefView -chef = - entity Chef ChefView - |> substruct "person" person .person - |> attribute "name" string .name - |> references "employees" string .employees .people Dict.get .value - - -type alias Db = - { people : Dict String (Timestamp Person) - , cars : Dict String (Timestamp Car) - } - - -type alias DbView = - { people : Dict String PersonView - , cars : Dict String CarView - } - - -db1 : IO Db Db DbView -db1 = - entity Db DbView - |> substruct "people" (dict string (timestamp person)) .people - |> substruct "cars" (dict string (timestamp car)) .cars - - -type alias Timestamp a = - { created : Int - , modified : Int - , accessed : Int - , value : a - } - - -timestamp : IO a db b -> IO (Timestamp a) db b -timestamp other = - let - t = - entity Timestamp Timestamp - |> attribute "created" int .created - |> attribute "modified" int .modified - |> attribute "accessed" int .accessed - |> substruct "value" other .value - in - { decoder = t.decoder - , encoder = t.encoder - , fuzzer = t.fuzzer - , toString = t.toString - , empty = t.empty - , viewer = \db full -> Maybe.map (\x -> x.value) (t.viewer db full) - } diff --git a/src/Type/Par.elm b/src/Type/Par.elm deleted file mode 100644 index bfa062f..0000000 --- a/src/Type/Par.elm +++ /dev/null @@ -1,79 +0,0 @@ -module Type.Par exposing (Par(..), Parf(..), SParf(..), andThen, apply, applyFirst, applySecond, distribute, fromTuple, inverseMapF, linearize, map, mapTuple, myMap, toTuple) - - -type Par a - = Par ( a, a ) - - -mapTuple : (( a, a ) -> ( b, b )) -> Par a -> Par b -mapTuple f (Par x) = - Par (f x) - - -fromTuple : ( a, a ) -> Par a -fromTuple = - Par - - -toTuple : Par a -> ( a, a ) -toTuple (Par x) = - x - - -andThen : (( a, a ) -> Par b) -> Par a -> Par b -andThen f (Par x) = - f x - - -distribute : Par (a -> b) -> Par a -> Par b -distribute (Par ( f, g )) (Par ( x, y )) = - Par ( f x, g y ) - - -inverseMapF : (Par a -> Par b) -> Par (a -> b) -inverseMapF f = - Debug.todo "" - - -map : (Par a -> Par b) -> Par a -> Par b -map f x = - f x - - -myMap : Par ((a -> a) -> b) -> (Par a -> Par a) -> Par b -myMap = - Debug.todo "" - - -type Parf a - = Parf (( a, a ) -> ( a, a )) - - - --- Parf (Par a -> Par a) - - -apply : Parf a -> Par a -> Par a -apply (Parf f) (Par x) = - Par (f x) - - -applyFirst : Parf a -> Par a -> a -applyFirst b c = - apply b c - |> (\(Par ( a, _ )) -> a) - - -applySecond : Parf a -> Par a -> a -applySecond b c = - apply b c - |> (\(Par ( _, a )) -> a) - - -type SParf a - = SParf (( a, a ) -> a) - - -linearize : SParf a -> a -> a -> a -linearize (SParf f) x y = - f ( x, y ) diff --git a/src/Type/Timestamp.elm b/src/Type/Timestamp.elm index 529577e..e6e0525 100644 --- a/src/Type/Timestamp.elm +++ b/src/Type/Timestamp.elm @@ -5,7 +5,7 @@ import Json.Decode as Decode import Json.Decode.Pipeline exposing (required) import Json.Encode as Encode exposing (Value) import Time -import Type.IO exposing (..) +import Type.IO exposing (IO, attribute, entity, int, substruct) type alias Timestamp a = diff --git a/src/Type/UpdateTest.elm b/src/Type/UpdateTest.elm deleted file mode 100644 index 988ae2d..0000000 --- a/src/Type/UpdateTest.elm +++ /dev/null @@ -1,179 +0,0 @@ -module Type.UpdateTest exposing (Car, CarBuilder, CarView, Chef, ChefBuilder, ChefView, Db, DbBuilder, DbView, Foo, FooBuilder, Person, PersonBuilder, PersonView, Timestamp, car, chef, db1, flip, foo, person, timestamp) - -import Dict exposing (Dict) -import Type.IO.Update exposing (..) - - -type alias Car = - { owner : String - , name : String - } - - -type alias CarView = - { owner : Person - , name : String - } - - -type alias CarBuilder = - String -> String -> Car - - -flip : (a -> b -> c) -> b -> a -> c -flip f second first = - f first second - - - -{- timestapedlense : Db -> String -> Maybe (Person) - timestapedlense = \db arg -> Dict.get arg (.people db) - -- |> Maybe.map .value - - dictlense : Db -> String -> Maybe ( Person) - dictlense = \db arg -> Dict.get arg (.people db) --} -{- genericlense : (Db -> Dict String a) -> (Db -> String -> Maybe a) - genericlense mapper = \db arg -> Dict.get arg (mapper db) - - evermoregenericlense : (Db -> b) -> (comparable -> b -> Maybe a) -> (Db -> comparable -> Maybe a) - evermoregenericlense fromDb toValue = \db arg -> toValue arg (fromDb db) - - mostgenericlense : (Db -> b) -> (b -> comparable -> Maybe a) -> (a -> c) -> (Db -> comparable -> Maybe c) - mostgenericlense fromDb toFlag toValue = \db arg -> toFlag (fromDb db) arg - |> Maybe.map toValue --} -{- dict2lense : Db -> String -> Maybe ( Person) - dict2lense = evermoregenericlense .people Dict.get - - timpestaped2lense : Db -> String -> Maybe Person - timpestaped2lense = mostgenericlense .people (flip Dict.get) identity --} -{- l : (Db -> b) -> (b -> comparable -> Maybe a) -> (a -> c) -> (Db -> comparable -> Maybe c) - l = mostgenericlense --} - - -car : PartialUpdater Car (String -> String -> Car) Car -car = - entity Car - |> attribute "owner" string .owner - |> attribute "name" string .name - - -type alias Foo = - { foo : Person - } - - - --- is: ((Person -> Foo) -> Person -> Foo) :-> e = Person, c = Foo --- --- expects : ((List String -> Person) -> c): -> e = PersonBuilder --- (((List String -> Person) -> Foo) -> (List String -> Person) -> Foo) ==> expand person - - -type alias FooBuilder = - PersonBuilder -> Foo - - -foo : PartialUpdater Foo FooBuilder Foo -foo = - entity Foo - |> substruct "foo" person .foo - - -type alias Person = - { cars : List String - } - - -type alias PersonView = - { cars : List Car - } - - -type alias PersonBuilder = - List String -> Person - - -person : PartialUpdater Person PersonBuilder Person -person = - entity Person - |> references "cars" string .cars - - -type alias Chef = - { person : Person - , name : String - , employees : List String - } - - -type alias ChefView = - { person : PersonView - , name : String - , employees : List Person - } - - -type alias ChefBuilder = - PersonBuilder -> String -> List String -> Chef - - -chef : PartialUpdater Chef ChefBuilder Chef -chef = - entity Chef - |> substruct "person" person .person - |> attribute "name" string .name - |> references "employees" string .employees .people Dict.get .value - - -type alias Db = - { people : Dict String Person - , cars : Dict String Car - } - - -type alias DbView = - { people : Dict String PersonView - , cars : Dict String CarView - } - - -type alias DbBuilder = - Dict String PersonBuilder -> Dict String CarBuilder -> Db - - -db1 : PartialUpdater Db DbBuilder Db -db1 = - entity Db - |> substruct "people" (dict (\x -> Just x) string person) .people - |> substruct "cars" (dict (\x -> Just x) string car) .cars - - -type alias Timestamp a = - { created : Int - , modified : Int - , accessed : Int - , value : a - } - - -timestamp : PartialUpdater a b a -> PartialUpdater (Timestamp a) (b -> Timestamp a) (Timestamp a) -timestamp other = - let - t = - entity Timestamp - |> attribute "created" int .created - |> attribute "modified" int .modified - |> attribute "accessed" int .accessed - |> substruct "value" other .value - in - { decoder = t.decoder - , encoder = t.encoder - , fuzzer = t.fuzzer - , toString = t.toString - , empty = t.empty - , viewer = \db full -> Maybe.map (\x -> x.value) (t.viewer db full) - } diff --git a/src/Utils.elm b/src/Utils.elm index dec92d0..bb73402 100644 --- a/src/Utils.elm +++ b/src/Utils.elm @@ -1,7 +1,7 @@ module Utils exposing (genericTitle, logo, viewLink) import Html exposing (Html, a, li, text) -import Html.Attributes exposing (..) +import Html.Attributes exposing (href) import Svg import Svg.Attributes as SA diff --git a/src/Viewer.elm b/src/Viewer.elm index 4a091ae..531e87f 100644 --- a/src/Viewer.elm +++ b/src/Viewer.elm @@ -116,9 +116,11 @@ view session msg details h time = :: (case session.user of Just userid -> let + device : Device.DeviceConfig device = Device.fromPixel session.windowSize.width session.windowSize.height + username : Maybe String username = Dict.get (unbox userid) session.db.users |> Maybe.map .value @@ -230,6 +232,7 @@ view session msg details h time = viewDrawerContent : Int -> Html Msg.Msg viewDrawerContent selectedIndex = let + listItemConfig_ : Int -> MLItem.Config Msg.Msg listItemConfig_ index = MLItem.config |> MLItem.setSelected @@ -542,6 +545,7 @@ selectUser users = [ Html.h2 [ Typography.headline6 ] [ Html.text "Please choose your account:" ] , LayoutGrid.cell [] <| let + sList : List (MLItem.ListItem Msg.Msg) sList = List.map (\user -> MLItem.listItem (MLItem.config |> MLItem.setOnClick (Msg.SetUser (box user))) [ MLItem.graphic [] [ identicon "100%" user ], Html.text user ]) users in @@ -571,7 +575,9 @@ selectUser users = userDialog : Bool -> List ( String, Db.User ) -> String -> Maybe Posix -> Html Msg.Msg userDialog open users new_username time = let + addUserWithName : String -> Msg.Msg addUserWithName username = + --\username -> Msg.CRUD (Msg.CreateRandom Db.UserType [ \x -> @@ -584,6 +590,7 @@ userDialog open users new_username time = } ] ) + uList : List (MLItem.ListItem Msg.Msg) uList = List.indexedMap diff --git a/src/Viewer/OrderAwareList.elm b/src/Viewer/OrderAwareList.elm index 42a3855..e8ce5c3 100644 --- a/src/Viewer/OrderAwareList.elm +++ b/src/Viewer/OrderAwareList.elm @@ -35,7 +35,7 @@ prePost prev xs = orderAwareList : List ( Id a String, a ) -> List (OrderAware a) orderAwareList old = let - mapToValue : Maybe (Id a String, a) -> Maybe { id : Id a String, value:a} + mapToValue : Maybe ( Id a String, a ) -> Maybe { id : Id a String, value : a } mapToValue a = case a of Just ( id, val ) -> diff --git a/tests/Example.elm b/tests/Example.elm index e0c159f..b822619 100644 --- a/tests/Example.elm +++ b/tests/Example.elm @@ -5,7 +5,7 @@ import Expect import Fuzz import Json.Decode import Json.Encode -import Test exposing (describe, Test, fuzz, fuzz2) +import Test exposing (Test, describe, fuzz, fuzz2) import Type.Database exposing (..) import Type.IO exposing (..) import Type.IO.Internal exposing (box) diff --git a/tests/Tests.elm b/tests/Tests.elm index 91dc97b..37479aa 100644 --- a/tests/Tests.elm +++ b/tests/Tests.elm @@ -1,7 +1,7 @@ module Tests exposing (all) import Expect -import Test exposing (Test, test, describe) +import Test exposing (Test, describe, test) From a88e2a86fccb1e9ad9336444fb9989285d833379 Mon Sep 17 00:00:00 2001 From: Jerome Bergmann Date: Mon, 11 Apr 2022 18:24:51 +0200 Subject: [PATCH 03/15] pre purge --- review/elm.json | 5 +++++ review/src/ReviewConfig.elm | 23 ++++++++++++++++++++++- src/Page.elm | 6 ++++-- src/Page/User.elm | 6 ++++-- src/Session.elm | 3 +++ src/Type/Database.elm | 23 ++++++++++------------- 6 files changed, 48 insertions(+), 18 deletions(-) diff --git a/review/elm.json b/review/elm.json index a80ff03..7adaf0a 100644 --- a/review/elm.json +++ b/review/elm.json @@ -6,10 +6,13 @@ "elm-version": "0.19.1", "dependencies": { "direct": { + "Arkham/elm-review-no-missing-type-constructor": "1.0.2", + "ContaSystemer/elm-review-no-missing-documentation": "1.0.0", "elm/core": "1.0.5", "jfmengels/elm-review": "2.7.1", "jfmengels/elm-review-common": "1.2.0", "jfmengels/elm-review-debug": "1.0.6", + "jfmengels/elm-review-unused": "1.1.21", "leojpod/review-no-empty-html-text": "1.0.2", "sparksp/elm-review-always": "1.0.5", "sparksp/elm-review-ports": "1.3.1", @@ -17,12 +20,14 @@ "truqu/elm-review-nobooleancase": "1.0.0" }, "indirect": { + "elm/browser": "1.0.2", "elm/html": "1.0.0", "elm/json": "1.1.3", "elm/parser": "1.1.0", "elm/project-metadata-utils": "1.0.2", "elm/random": "1.0.0", "elm/time": "1.0.0", + "elm/url": "1.0.0", "elm/virtual-dom": "1.0.2", "elm-community/list-extra": "8.5.2", "elm-explorations/test": "1.2.2", diff --git a/review/src/ReviewConfig.elm b/review/src/ReviewConfig.elm index 7802906..c5ed403 100644 --- a/review/src/ReviewConfig.elm +++ b/review/src/ReviewConfig.elm @@ -20,12 +20,22 @@ import NoDuplicatePorts import NoEmptyText import NoExposingEverything import NoImportingEverything +import NoMissingDocumentation import NoMissingTypeAnnotation import NoMissingTypeAnnotationInLetIn import NoMissingTypeExpose +import NoMissingTypeConstructor import NoPrematureLetComputation import NoUnsafePorts import NoUnusedPorts +import NoUnused.CustomTypeConstructorArgs +import NoUnused.CustomTypeConstructors +import NoUnused.Dependencies +import NoUnused.Exports +import NoUnused.Modules +import NoUnused.Parameters +import NoUnused.Patterns +import NoUnused.Variables import Review.Rule exposing (Rule) @@ -36,7 +46,7 @@ config = , NoDebug.Log.rule , NoDebug.TodoOrToString.rule , NoDuplicatePorts.rule - , NoUnsafePorts.rule NoUnsafePorts.any + --, NoUnsafePorts.rule NoUnsafePorts.any , NoUnusedPorts.rule , NoEmptyText.rule , NoExposingEverything.rule @@ -49,4 +59,15 @@ config = |> Review.Rule.ignoreErrorsForFiles [ "src/Type/Database/TypeMatching.elm" ] , NoMissingTypeExpose.rule , NoPrematureLetComputation.rule + , NoMissingTypeConstructor.rule + , NoMissingDocumentation.rule + |> Review.Rule.ignoreErrorsForDirectories [ "tests/" ] + , NoUnused.CustomTypeConstructors.rule [] + , NoUnused.CustomTypeConstructorArgs.rule + , NoUnused.Dependencies.rule + , NoUnused.Exports.rule + , NoUnused.Modules.rule + , NoUnused.Parameters.rule + , NoUnused.Patterns.rule + , NoUnused.Variables.rule ] diff --git a/src/Page.elm b/src/Page.elm index bae0a64..ceea27d 100644 --- a/src/Page.elm +++ b/src/Page.elm @@ -1,4 +1,4 @@ -module Page exposing (Page(..), liftupdate, liftview, update, view) +module Page exposing (Page(..), Config, liftupdate, liftview, update, view) import Browser exposing (Document) import Msg @@ -8,7 +8,9 @@ import Viewer type Page a msg - = Page + = Page (Config a msg) + +type alias Config a msg= { session : Session.Session , page : a , view : Page a msg -> Viewer.Details Msg.Msg diff --git a/src/Page/User.elm b/src/Page/User.elm index 6c38e3f..278d2df 100644 --- a/src/Page/User.elm +++ b/src/Page/User.elm @@ -1,8 +1,8 @@ module Page.User exposing (Model, init, page, update, view) import Browser -import Html exposing (..) -import Html.Attributes exposing (..) +import Html exposing (div,text, h1, h3, a) +import Html.Attributes exposing (href, class) import Msg exposing (UserMsg) import Page exposing (Page(..)) import Session @@ -33,6 +33,7 @@ init user_id = page : Session.Session -> Maybe Int -> ( Page.Page Model UserMsg, Cmd UserMsg ) page session user_id = let + model : Page.Config Model UserMsg model = { session = session , page = init user_id @@ -87,5 +88,6 @@ view (Page model) = -- HELPERS +toTitle : Model -> String toTitle model = "Page With Subpage - " ++ String.fromInt (Maybe.withDefault -1 model.user_id) diff --git a/src/Session.elm b/src/Session.elm index 8f34131..b3e21fe 100644 --- a/src/Session.elm +++ b/src/Session.elm @@ -39,15 +39,18 @@ init flags = let -- localStorage = -- Json.Decode.decodeValue Type.LocalStorage.decode flags.localStorage + db : Result Json.Decode.Error Db.Database db = Json.Decode.decodeValue Db.database.decoder flags.db + posixTime : Time.Posix posixTime = Time.millisToPosix flags.timeAppStarted in case db of Ok storage -> let + user : Maybe String user = Match.keys Db.UserType storage |> (\x -> diff --git a/src/Type/Database.elm b/src/Type/Database.elm index 99e8d8e..d6b2585 100644 --- a/src/Type/Database.elm +++ b/src/Type/Database.elm @@ -1,9 +1,9 @@ module Type.Database exposing (Answer, AnswerView, Coder, CoderView, Coding, CodingAnswer, CodingAnswerView, CodingFrame, CodingFrameView, CodingQuestion, CodingQuestionView, CodingQuestionary, CodingQuestionaryView, CodingView, Database, DatabaseView, Event, EventView, InputTypeKind(..), Place, Question, QuestionView, Questionary, QuestionaryView, Row, Study, StudyView, Table, TableView, TestSubject, TestSubjectView, Timestamp, TimestampView, Type(..), User, answer, coder, coding, coding_answer, coding_frame, coding_question, coding_questionary, database, event, place, question, questionary, rows, study, table, test_subject, timestamp, updateEmpty, user) -import Dict exposing (..) +import Dict exposing (Dict) import Tuple import Type.Database.InputType as IT -import Type.IO exposing (..) +import Type.IO exposing (IO, dict, string, entity, substruct, reference, attribute, bool, maybe, int, float) import Type.IO.Encoder exposing (Encoder(..)) import Type.IO.Internal as Id exposing (Id) @@ -403,17 +403,14 @@ type alias TimestampView a = timestamp : IO a Database b msg -> IO (Timestamp a) Database (TimestampView b) msg timestamp other = - let - t = - entity Timestamp TimestampView - |> reference "creator" string .creator .users Dict.get .value - |> attribute "created" int .created - |> attribute "modified" int .modified - |> attribute "accessed" int .accessed - |> attribute "deleted" (maybe int) .deleted - |> substruct "value" other .value - in - t + entity Timestamp TimestampView + |> reference "creator" string .creator .users Dict.get .value + |> attribute "created" int .created + |> attribute "modified" int .modified + |> attribute "accessed" int .accessed + |> attribute "deleted" (maybe int) .deleted + |> substruct "value" other .value + From f78f2432a1c2857df73b50dc89e052aaff7d9bb4 Mon Sep 17 00:00:00 2001 From: Jerome Bergmann Date: Mon, 11 Apr 2022 21:08:46 +0200 Subject: [PATCH 04/15] huge diet --- elm.json | 8 +- review/src/ReviewConfig.elm | 1 + src/Main.elm | 36 +-- src/Msg.elm | 10 +- src/Page.elm | 26 +- src/Page/Admin.elm | 16 +- src/Page/Answer.elm | 7 +- src/Page/Code.elm | 27 +- src/Page/CodingQuestion.elm | 77 +----- src/Page/Event.elm | 31 +-- src/Page/NewPage.elm | 51 +--- src/Page/PageOne.elm | 4 +- src/Page/PageWithSubpage.elm | 3 +- src/Page/Question.elm | 79 +----- src/Page/Questionary.elm | 387 +---------------------------- src/Page/Study.elm | 26 +- src/Page/Top.elm | 104 +------- src/Page/User.elm | 7 +- src/Ports.elm | 1 - src/Session.elm | 14 -- src/TestDrawer.elm | 7 - src/Type/Database.elm | 18 +- src/Type/Database/Aquisition.elm | 8 +- src/Type/Database/InputType.elm | 53 +--- src/Type/Database/TypeMatching.elm | 151 +---------- src/Type/Entity.elm | 166 +------------ src/Type/Flags.elm | 1 - src/Type/Graph.elm | 9 +- src/Type/IO.elm | 17 +- src/Type/IO/Decoder.elm | 5 +- src/Type/IO/Encoder.elm | 2 +- src/Type/IO/Form.elm | 39 +-- src/Type/IO/Setter.elm | 37 +-- src/Type/IO/ToString.elm | 37 +-- src/Type/IO/Update.elm | 26 +- src/Type/IO/Viewer.elm | 8 +- src/Type/LocalStorage.elm | 2 +- src/Type/Timestamp.elm | 8 +- src/Utils.elm | 32 +-- src/Viewer.elm | 208 +--------------- src/Viewer/Desktop.elm | 4 +- src/Viewer/EditableText.elm | 1 - src/Viewer/Handset.elm | 10 +- src/Viewer/Internal.elm | 14 +- src/Viewer/OrderAwareList.elm | 2 +- tests/AquisitionTest.elm | 7 +- 46 files changed, 152 insertions(+), 1635 deletions(-) diff --git a/elm.json b/elm.json index d5499bb..4c7da18 100644 --- a/elm.json +++ b/elm.json @@ -15,12 +15,9 @@ "elm/html": "1.0.0", "elm/json": "1.1.3", "elm/random": "1.0.0", - "elm/svg": "1.0.1", "elm/time": "1.0.0", "elm/url": "1.0.0", "elm-community/array-extra": "2.4.0", - "elm-community/dict-extra": "2.4.0", - "elm-community/json-extra": "4.3.0", "elm-community/list-extra": "8.5.2", "elm-community/maybe-extra": "5.3.0", "elm-community/random-extra": "3.2.0", @@ -35,10 +32,9 @@ "indirect": { "avh4/elm-color": "1.0.0", "elm/bytes": "1.0.8", - "elm/parser": "1.1.0", "elm/regex": "1.0.0", - "elm/virtual-dom": "1.0.2", - "rtfeldman/elm-iso8601-date-strings": "1.1.4" + "elm/svg": "1.0.1", + "elm/virtual-dom": "1.0.2" } }, "test-dependencies": { diff --git a/review/src/ReviewConfig.elm b/review/src/ReviewConfig.elm index c5ed403..a876d8e 100644 --- a/review/src/ReviewConfig.elm +++ b/review/src/ReviewConfig.elm @@ -63,6 +63,7 @@ config = , NoMissingDocumentation.rule |> Review.Rule.ignoreErrorsForDirectories [ "tests/" ] , NoUnused.CustomTypeConstructors.rule [] + |> Review.Rule.ignoreErrorsForDirectories [ "src/Type/IO/" ] , NoUnused.CustomTypeConstructorArgs.rule , NoUnused.Dependencies.rule , NoUnused.Exports.rule diff --git a/src/Main.elm b/src/Main.elm index 1242a72..0c5c2e6 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -1,4 +1,4 @@ -module Main exposing (Model, Page, init, main, subscriptions, update, view) +module Main exposing (Model, Page, main) -- import Page.NewPage as NewPage --import Html exposing (..) @@ -25,7 +25,7 @@ import Page.Study as Study import Page.Top as Top import Page.User as User import Ports -import Random exposing (generate) +import Random import Random.Char exposing (latin) import Random.String exposing (string) import Session @@ -35,12 +35,11 @@ import Type.Database as Db exposing (database) import Type.Database.TypeMatching as Match import Type.Flags import Type.IO exposing (form2update) -import Type.IO.Internal exposing (Id, box, unbox) +import Type.IO.Internal exposing (box) import Type.IO.Setter as Updater import Url import Url.Builder -import Url.Parser as Parser exposing ((), (), query) -import Url.Parser.Query as Query +import Url.Parser as Parser exposing (()) import Viewer @@ -91,9 +90,6 @@ init flags url key = localStorage = Json.Decode.decodeValue Db.database.decoder flags.localStorage - db = - Json.Decode.decodeValue Db.database.decoder flags.db - ( model, cmds ) = routeUrl (urlAdaptHash url) <| Model key (NotFound <| Session.init flags) Viewer.header Nothing @@ -382,11 +378,6 @@ defaultUpdate message ( model, effect ) = ( model, Cmd.none ) -updateAll : List Msg.Msg -> Model -> ( Model, Cmd Msg.Msg ) -updateAll messages model = - chainedUpdateAll messages ( model, Cmd.none ) - - chainedUpdateAll : List Msg.Msg -> ( Model, Cmd Msg.Msg ) -> ( Model, Cmd Msg.Msg ) chainedUpdateAll messages ( model, effect ) = List.foldl chainableUpdate ( model, effect ) messages @@ -761,25 +752,6 @@ updateDbSession model session db = -- ROUTING -- The following functions create the client-side router. Update "parser" and "paths" for each page you add/remove - - -testMethod = - case Url.fromString "http://localhost:3000/event/oLFlGAGBkkaZDCTsnmOA/answer?tsid=a" of - Nothing -> - Nothing - - Just oldUrl -> - let - hashUrl = - { oldUrl | path = Maybe.withDefault "" oldUrl.fragment, fragment = Nothing } - - func x y = - "yes" - in - Parser.parse (Parser.map func (Parser.s paths.event Parser.string Parser.s "answer" Query.custom "tsid" identity)) oldUrl - - - --Parser.parse (Parser.s paths.event Parser.string Answer.parser ) diff --git a/src/Msg.elm b/src/Msg.elm index 01af8db..5b87a66 100644 --- a/src/Msg.elm +++ b/src/Msg.elm @@ -25,7 +25,7 @@ import Material.Snackbar as Snackbar import Time exposing (Posix) import Type.Database as Db exposing (Type) import Type.Database.InputType as IT -import Type.IO.Form exposing (UpdateMsg(..)) +import Type.IO.Form exposing (UpdateMsg) import Type.IO.Internal exposing (Id) import Type.IO.Setter as Updater import Url @@ -111,15 +111,11 @@ type QuestionaryMsg type QuestionMsg - = SetInputType String - | Short ShortMsg - | Long LongMsg - | List ListMsg + = Short ShortMsg type ShortMsg - = ShortLabel String - | ShortPlaceholder String + = ShortPlaceholder String type LongMsg diff --git a/src/Page.elm b/src/Page.elm index ceea27d..aefb20b 100644 --- a/src/Page.elm +++ b/src/Page.elm @@ -1,4 +1,4 @@ -module Page exposing (Page(..), Config, liftupdate, liftview, update, view) +module Page exposing (Config, Page(..), liftupdate, update, view) import Browser exposing (Document) import Msg @@ -10,15 +10,16 @@ import Viewer type Page a msg = Page (Config a msg) -type alias Config a msg= - { session : Session.Session - , page : a - , view : Page a msg -> Viewer.Details Msg.Msg - , toMsg : msg -> Msg.Msg - , subscriptions : Sub msg - , -- header : Viewer.Header, - update : msg -> Page a msg -> ( Page a msg, Cmd msg ) - } + +type alias Config a msg = + { session : Session.Session + , page : a + , view : Page a msg -> Viewer.Details Msg.Msg + , toMsg : msg -> Msg.Msg + , subscriptions : Sub msg + , -- header : Viewer.Header, + update : msg -> Page a msg -> ( Page a msg, Cmd msg ) + } view : Page a msg -> Viewer.Header -> Maybe Posix -> Document Msg.Msg @@ -26,11 +27,6 @@ view (Page model) header = Viewer.view model.session model.toMsg (model.view (Page model)) header -liftview : (a -> Viewer.Details msg) -> Page a msg -> Viewer.Details msg -liftview pview (Page a) = - pview a.page - - update : msg -> Page a msg -> ( Page a msg, Cmd msg ) update msg (Page model) = model.update msg (Page model) diff --git a/src/Page/Admin.elm b/src/Page/Admin.elm index 08fb955..0f31ec4 100644 --- a/src/Page/Admin.elm +++ b/src/Page/Admin.elm @@ -1,16 +1,14 @@ -module Page.Admin exposing (Model, SubPage, init, page, parser, update, url, view) +module Page.Admin exposing (Model, SubPage, page, parser, url) --import Browser import Dict import Html exposing (a, div, h1, h3, li, p, text, ul) import Html.Attributes exposing (class, href) -import Material.Button as Button exposing (config) +import Material.Button as Button import Material.DataTable as DataTable exposing ( cell - , config - , dataTable , row ) import Msg exposing (AdminMsg) @@ -23,7 +21,7 @@ import Type.Database as Db import Type.Database.TypeMatching as Match import Type.IO exposing (form2update) import Type.IO.Form as Form -import Type.IO.Internal exposing (Id, box, unbox) +import Type.IO.Internal exposing (box) import Type.IO.Setter as Update import Type.IO.ToString as ToString import Url.Parser as Parser exposing ((), ()) @@ -278,14 +276,6 @@ toTable keys kind db = edit : Db.Database -> Db.Type -> String -> List (Html.Html Msg.Msg) edit db kind id = - let - msg = - \x -> - Msg.Form <| - Form.AttrMsg (Match.toStringPlural kind) <| - Form.DictMsg (Just id) <| - Form.AttrMsg "value" x - in Match.fields kind |> List.map (\x -> diff --git a/src/Page/Answer.elm b/src/Page/Answer.elm index 5f91078..2c7b5e2 100644 --- a/src/Page/Answer.elm +++ b/src/Page/Answer.elm @@ -1,16 +1,15 @@ -module Page.Answer exposing (Model, RelatedData, demoContent, page, parser, relatedData, toTitle, update, view, viewQuestion) +module Page.Answer exposing (Model, RelatedData, page, parser) --import Html.Keyed as Keyed import Dict import Element exposing (fill, height, padding, px, width) -import Element.Background as Background import Element.Font as Font import Element.Keyed as Keyed import Html exposing (text) import Html.Attributes exposing (style) import List.Extra -import Material.Button as Button exposing (config) +import Material.Button as Button import Material.TextArea as TextArea import Material.TextField as TextField import Msg @@ -19,7 +18,7 @@ import Session import Type.Database as Db import Type.Database.InputType exposing (InputType(..)) import Type.Database.TypeMatching as Match -import Type.IO.Internal as Id exposing (Id, box, unbox) +import Type.IO.Internal exposing (Id, box, unbox) import Type.IO.Setter as Updater import Url.Parser as Parser exposing (()) import Url.Parser.Query as Query diff --git a/src/Page/Code.elm b/src/Page/Code.elm index e4a699c..90f00f6 100644 --- a/src/Page/Code.elm +++ b/src/Page/Code.elm @@ -1,16 +1,15 @@ -module Page.Code exposing (CodingAnswerTemplate, Model, demoContent, init, page, toTitle, update, view, viewCodingQuestion) +module Page.Code exposing (CodingAnswerTemplate, Model, page) --import Html.Keyed as Keyed import Dict import Element exposing (fill, height, padding, px, width) -import Element.Background as Background import Element.Font as Font import Element.Keyed as Keyed import Html exposing (text) import Html.Attributes exposing (style) import List.Extra -import Material.Button as Button exposing (config) +import Material.Button as Button import Material.TextArea as TextArea import Material.TextField as TextField import Msg @@ -19,10 +18,8 @@ import Session import Type.Database as Db exposing (Answer) import Type.Database.InputType exposing (InputType(..)) import Type.Database.TypeMatching as Match -import Type.IO.Internal as Id exposing (Id, box, unbox) +import Type.IO.Internal exposing (Id, box, unbox) import Type.IO.Setter as Updater -import Url.Parser as Parser exposing (()) -import Url.Parser.Query as Query import Viewer exposing (detailsConfig) @@ -56,31 +53,31 @@ init id db = let question2codingQuestionary : ( Id Db.Question String, Db.Timestamp Db.Question ) -> List ( Id Db.CodingQuestionary String, Db.Timestamp Db.CodingQuestionary ) question2codingQuestionary ( qid, value ) = - Dict.filter (\cid cq -> cq.value.question == qid) db.coding_questionnaries + Dict.filter (\_ cq -> cq.value.question == qid) db.coding_questionnaries |> Dict.toList |> List.map (\( cid, other ) -> ( box cid, other )) codingQuestionary2codingQuestion : ( Id Db.CodingQuestionary String, Db.Timestamp Db.CodingQuestionary ) -> List ( Id Db.CodingQuestion String, Db.Timestamp Db.CodingQuestion ) codingQuestionary2codingQuestion ( qid, value ) = - Dict.filter (\cid cq -> cq.value.coding_questionary == qid) db.coding_questions + Dict.filter (\_ cq -> cq.value.coding_questionary == qid) db.coding_questions |> Dict.toList |> List.map (\( cid, other ) -> ( box cid, other )) codingQuestion2input_type ( qid, value ) = - Dict.filter (\itid it -> value.value.input_type == box itid) db.input_types + Dict.filter (\itid _ -> value.value.input_type == box itid) db.input_types |> Dict.toList |> List.map (\( itid, other ) -> ( box itid, other )) answers = - Dict.filter (\eid event -> event.value.study == id) db.events + Dict.filter (\_ event -> event.value.study == id) db.events |> Dict.toList |> List.map (\( eid, event ) -> ( box eid, event )) - |> List.map (\( eid, event ) -> Dict.filter (\aid answer -> answer.value.event == eid) db.answers) + |> List.map (\( eid, _ ) -> Dict.filter (\_ answer -> answer.value.event == eid) db.answers) |> List.map Dict.toList |> List.concat all_coding_answers = - List.map (\( answer_id, answer ) -> ( ( box answer_id, answer ), Dict.filter (\question_id question -> answer.value.question == box question_id) db.questions )) answers + List.map (\( answer_id, answer ) -> ( ( box answer_id, answer ), Dict.filter (\question_id _ -> answer.value.question == box question_id) db.questions )) answers |> List.map (\( answer, questiondict ) -> ( answer, Dict.toList questiondict )) |> List.map (\( answer, questions ) -> List.map (\question -> ( answer, question )) questions) |> List.concat @@ -111,7 +108,7 @@ init id db = present_coding_answers : List ( Id Db.CodingAnswer String, Db.Timestamp Db.CodingAnswer ) present_coding_answers = - Dict.filter (\cai cav -> List.member ( cav.value.answer, cav.value.coding_question ) all_relevant_keys) db.coding_answers + Dict.filter (\_ cav -> List.member ( cav.value.answer, cav.value.coding_question ) all_relevant_keys) db.coding_answers |> Dict.toList |> List.sortBy (\( _, cav ) -> cav.accessed) |> List.map (\( cai, cav ) -> ( box cai, cav )) @@ -146,7 +143,7 @@ init id db = currentQuestion : Maybe CodingAnswerTemplate currentQuestion = case currentAnswer of - Just ( caid, cav ) -> + Just ( _, cav ) -> templates |> List.filter (\{ coding_questionId } -> coding_questionId == cav.value.coding_question) |> List.filter (\{ answerId } -> answerId == cav.value.answer) @@ -297,7 +294,7 @@ view (Page.Page pageM) = Dict.get (unbox answerid) db.answers in case ( mbinput_type, mbanswer, mbcoding_question ) of - ( Just input_type, Just answer, Just coding_question ) -> + ( Just _, Just answer, Just coding_question ) -> Element.layout [ height <| px <| viewportHeight - 48, padding 24 ] <| Element.column [ height fill, width fill ] [ Element.el [ height fill, width fill ] <| viewCodingQuestion db coding_questionid coding_question Nothing answerid model answer diff --git a/src/Page/CodingQuestion.elm b/src/Page/CodingQuestion.elm index fc496bd..644291c 100644 --- a/src/Page/CodingQuestion.elm +++ b/src/Page/CodingQuestion.elm @@ -1,18 +1,13 @@ -module Page.CodingQuestion exposing (Model, RelatedData, init, page, relatedData, toTitle, update, view, viewInputTypeSelection, viewSettings) +module Page.CodingQuestion exposing (Model, RelatedData, page) import Dict import Html exposing (Html, p, text) -import Material.Button as Button import Material.FormField as FormField import Material.LayoutGrid exposing (cell, inner, layoutGrid) -import Material.List as List -import Material.List.Item as ListItem exposing (ListItem) import Material.Radio as Radio import Material.Slider as Slider -import Material.Switch as Switch import Material.TextField as TextField -import Material.Typography as Typography exposing (typography) -import Maybe.Extra +import Material.Typography as Typography import Msg import Page exposing (Page(..)) import Session @@ -20,7 +15,7 @@ import Time exposing (Posix) import Type.Database as Db import Type.Database.InputType as IT import Type.Database.TypeMatching as Match -import Type.IO.Internal as Id exposing (Id, box, unbox) +import Type.IO.Internal exposing (Id, unbox) import Type.IO.Setter as Updater import Viewer exposing (detailsConfig) @@ -93,47 +88,6 @@ page session id = update : Msg.Msg -> Page.Page Model Msg.Msg -> ( Page.Page Model Msg.Msg, Cmd Msg.Msg ) update message (Page model) = - let - oldmodel = - model.page - - updatePage x = - Page { model | page = x } - - setInputTypeDb it = - let - oldsession = - model.session - - newdb n = - { oldsession | db = n } - - olddb = - oldsession.db - - newq n = - newdb { olddb | questions = n } - in - newq <| - Dict.update - (unbox oldmodel.id) - (Maybe.map - (\i -> - let - oldvalue = - i.value - - newvalue n = - { i | value = n } - - newquestion = - { oldvalue | input_type = it } - in - newvalue newquestion - ) - ) - model.session.db.questions - in case message of Msg.Question _ -> ( Page model, Cmd.none ) @@ -275,12 +229,6 @@ relatedData id db = Just timestampedQuestion -> let --coding_questions : List (Id Db.CodingQuestionary String, Db.CodingQuestionary) - coding_questions = - {- List.sortBy (\( _, y ) -> y.index) <| -} - Dict.toList db.coding_questionnaries - |> List.filter (\( _, y ) -> y.value.question == id) - |> List.map (\( x, y ) -> ( box x, y.value )) - question = timestampedQuestion.value in @@ -511,23 +459,6 @@ viewInputTypeSelection model ( id, _ ) = viewSettings : Db.Database -> Id Db.Question String -> Model -> ( Id IT.InputType String, Maybe IT.InputType ) -> List (Html Msg.Msg) viewSettings db id model ( itid, mbit ) = - let - umessage attribute setter value = - Msg.CRUD <| - Msg.Update <| - Updater.AttributeMsg "questions" <| - Updater.DictKeyMsg (unbox id) <| - Updater.AttributeMsg "value" <| - Updater.AttributeMsg "input_type" <| - Updater.AttributeMsg attribute <| - setter value - - moreInfo : String - moreInfo = - Maybe.map (IT.input_type.toString "*") mbit - |> Maybe.andThen Result.toMaybe - |> Maybe.withDefault "" - in if model.short == Just itid then case Maybe.map .value <| Maybe.andThen (\x -> Dict.get (unbox x) db.input_types) model.short of Just (IT.ShortAnswer short) -> @@ -736,7 +667,7 @@ viewSettings db id model ( itid, mbit ) = else if model.list == Just itid then case Maybe.map .value <| Maybe.andThen (\x -> Dict.get (unbox x) db.input_types) model.list of - Just (IT.List list) -> + Just (IT.List _) -> [ text "Boxes or Radio?" , FormField.formField (FormField.config diff --git a/src/Page/Event.elm b/src/Page/Event.elm index 4b21773..9255934 100644 --- a/src/Page/Event.elm +++ b/src/Page/Event.elm @@ -1,18 +1,15 @@ -module Page.Event exposing (Model, init, page, update, view) +module Page.Event exposing (Model, page) --import Browser -import Dict exposing (Dict) -import Html exposing (Html, div, p, text) +import Dict +import Html exposing (Html, p, text) import Identicon exposing (identicon) import Material.Button as Button exposing (unelevated) import Material.DataTable as DataTable -import Material.Icon as Icon import Material.LayoutGrid as LG exposing (cell, inner, layoutGrid) import Material.List as MList exposing (list) import Material.List.Item as MLItem exposing (graphic, listItem) -import Material.Tab as Tab -import Material.TabBar as TabBar import Material.Typography as Typography import Msg import Page exposing (Page(..)) @@ -20,11 +17,9 @@ import Session import Time exposing (Posix) import Type.Database as Db import Type.Database.TypeMatching as Match -import Type.IO.Internal as Id exposing (Id, box, unbox) +import Type.IO.Internal exposing (Id, box, unbox) import Type.IO.Setter as Updater import Url.Builder -import Url.Parser as Parser exposing (()) -import Url.Parser.Query as Query import Viewer exposing (detailsConfig) import Viewer.EditableText as EditableText @@ -110,7 +105,7 @@ update message (Page model) = in ( Page { model | page = new_page }, Cmd.none ) - Msg.AnswerQuestions { questionary, test_subject, event } -> + Msg.AnswerQuestions _ -> ( Page model, Cmd.none ) Msg.EventSwitchTo _ -> @@ -353,8 +348,8 @@ relatedData id db = , created = Time.millisToPosix timestampedEvent.created , creator = ( timestampedEvent.creator, Maybe.map .value <| Dict.get (unbox timestampedEvent.creator) db.users ) , updated = Time.millisToPosix timestampedEvent.modified - , questionnaries = List.map (Tuple.mapFirst box) <| Dict.toList <| Dict.map (\x y -> y.value) <| Dict.filter (\x y -> y.value.study == event.study) db.questionnaries - , test_subjects = List.map (Tuple.mapFirst box) <| Dict.toList <| Dict.map (\x y -> y.value) <| Dict.filter (\x y -> y.value.event == id) db.test_subjects + , questionnaries = List.map (Tuple.mapFirst box) <| Dict.toList <| Dict.map (\_ y -> y.value) <| Dict.filter (\_ y -> y.value.study == event.study) db.questionnaries + , test_subjects = List.map (Tuple.mapFirst box) <| Dict.toList <| Dict.map (\_ y -> y.value) <| Dict.filter (\_ y -> y.value.event == id) db.test_subjects } Nothing -> @@ -414,26 +409,26 @@ viewTable db questionnaries test_subjects event_id = { thead = [ DataTable.row [] <| DataTable.cell [] [ text "Subject" ] - :: List.map (\( x, y ) -> DataTable.cell [] [ text y.name ]) questionnaries + :: List.map (\( _, y ) -> DataTable.cell [] [ text y.name ]) questionnaries --[ DataTable.cell [] [ text "Desert" ] ] ] , tbody = List.map - (\( test_subject_id, test_subject_value ) -> + (\( test_subject_id, _ ) -> DataTable.row [] <| DataTable.cell [] [ text <| String.toUpper <| String.left 4 (unbox test_subject_id) ] :: List.map - (\( questionary_id, questionary_value ) -> + (\( questionary_id, _ ) -> DataTable.cell [] [ let answers = - Dict.filter (\answer_id answer_table -> List.member (unbox answer_table.value.question) q_ids) db.answers - |> Dict.filter (\answer_id answer_table -> answer_table.value.test_subject == test_subject_id) + Dict.filter (\_ answer_table -> List.member (unbox answer_table.value.question) q_ids) db.answers + |> Dict.filter (\_ answer_table -> answer_table.value.test_subject == test_subject_id) |> Dict.toList questions = - Dict.filter (\question_id question_table -> question_table.value.questionary == questionary_id) db.questions + Dict.filter (\_ question_table -> question_table.value.questionary == questionary_id) db.questions |> Dict.toList q_ids = diff --git a/src/Page/NewPage.elm b/src/Page/NewPage.elm index dd18a96..893bda7 100644 --- a/src/Page/NewPage.elm +++ b/src/Page/NewPage.elm @@ -1,31 +1,7 @@ -module Page.NewPage exposing (Model, Msg(..), init, update, view) - -import Browser -import Html exposing (..) -import Html.Attributes exposing (..) -import Session -import Viewer - - +module Page.NewPage exposing (Msg(..)) -- MODEL - - -type alias Model = - { session : Session.Session - } - - - -- INIT - - -init : Session.Session -> ( Model, Cmd Msg ) -init session = - ( Model session, Cmd.none ) - - - -- UPDATE @@ -33,31 +9,6 @@ type Msg = NoOp -update : Msg -> Model -> ( Model, Cmd Msg ) -update msg model = - case msg of - NoOp -> - ( model, Cmd.none ) - - -- VIEW - - -view : Model -> Viewer.Details Msg -view model = - { title = toTitle - , body = - \_ -> - [ h1 [] [ text "elm-spa-boilerplate - New Page" ] - , div [] [ text "A new page." ] - ] - } - - - -- HELPERS - - -toTitle = - "New Page" diff --git a/src/Page/PageOne.elm b/src/Page/PageOne.elm index 7d7c12d..6b48260 100644 --- a/src/Page/PageOne.elm +++ b/src/Page/PageOne.elm @@ -1,8 +1,6 @@ -module Page.PageOne exposing (Model, init, page, update, view) +module Page.PageOne exposing (Model, page) -import Browser import Html exposing (..) -import Html.Attributes exposing (..) import Msg import Page import Session diff --git a/src/Page/PageWithSubpage.elm b/src/Page/PageWithSubpage.elm index da9992c..64b8624 100644 --- a/src/Page/PageWithSubpage.elm +++ b/src/Page/PageWithSubpage.elm @@ -1,6 +1,5 @@ -module Page.PageWithSubpage exposing (Model, init, page, update, view) +module Page.PageWithSubpage exposing (Model, page) -import Browser import Html exposing (..) import Html.Attributes exposing (..) import Msg exposing (PageWithSubpageMsg) diff --git a/src/Page/Question.elm b/src/Page/Question.elm index 22a9e2e..13fab30 100644 --- a/src/Page/Question.elm +++ b/src/Page/Question.elm @@ -1,4 +1,4 @@ -module Page.Question exposing (Model, RelatedData, init, page, relatedData, toTitle, update, view, viewCodingQuestion, viewCodingQuestions, viewInputTypeSelection, viewSettings) +module Page.Question exposing (Model, RelatedData, page) import Dict import Html exposing (Html, p, text) @@ -11,8 +11,7 @@ import Material.Radio as Radio import Material.Slider as Slider import Material.Switch as Switch import Material.TextField as TextField -import Material.Typography as Typography exposing (typography) -import Maybe.Extra +import Material.Typography as Typography import Msg import Page exposing (Page(..)) import Session @@ -20,7 +19,7 @@ import Time exposing (Posix) import Type.Database as Db import Type.Database.InputType as IT import Type.Database.TypeMatching as Match -import Type.IO.Internal as Id exposing (Id, box, unbox) +import Type.IO.Internal exposing (Id, box, unbox) import Type.IO.Setter as Updater import Viewer exposing (detailsConfig) @@ -56,13 +55,13 @@ init db id = Maybe.map Tuple.first coding_questionary coding_questionary = - Dict.filter (\cqid cq -> cq.value.question == id) db.coding_questionnaries + Dict.filter (\_ cq -> cq.value.question == id) db.coding_questionnaries |> Dict.toList - |> List.sortBy (\( cqid, cq ) -> cq.created) + |> List.sortBy (\( _, cq ) -> cq.created) |> List.head coding_questions = - Dict.filter (\cqqid cqq -> Just cqq.value.coding_questionary == Maybe.map box cid) db.coding_questions + Dict.filter (\_ cqq -> Just cqq.value.coding_questionary == Maybe.map box cid) db.coding_questions |> Dict.toList q = @@ -112,47 +111,6 @@ page session id = update : Msg.Msg -> Page.Page Model Msg.Msg -> ( Page.Page Model Msg.Msg, Cmd Msg.Msg ) update message (Page model) = - let - oldmodel = - model.page - - updatePage x = - Page { model | page = x } - - setInputTypeDb it = - let - oldsession = - model.session - - newdb n = - { oldsession | db = n } - - olddb = - oldsession.db - - newq n = - newdb { olddb | questions = n } - in - newq <| - Dict.update - (unbox oldmodel.id) - (Maybe.map - (\i -> - let - oldvalue = - i.value - - newvalue n = - { i | value = n } - - newquestion = - { oldvalue | input_type = it } - in - newvalue newquestion - ) - ) - model.session.db.questions - in case message of Msg.Question _ -> ( Page model, Cmd.none ) @@ -301,12 +259,6 @@ relatedData id db = case Dict.get (unbox id) db.questions of Just timestampedQuestion -> let - coding_questions = - {- List.sortBy (\( _, y ) -> y.index) <| -} - List.filter (\( _, y ) -> y.question == id) <| - List.map (\( x, y ) -> ( x, y.value )) <| - Dict.toList db.coding_questionnaries - question = timestampedQuestion.value in @@ -635,23 +587,6 @@ viewCodingQuestion ( id, cquestion ) = viewSettings : Db.Database -> Id Db.Question String -> Model -> ( Id IT.InputType String, Maybe IT.InputType ) -> List (Html Msg.Msg) viewSettings db id model ( itid, mbit ) = - let - umessage attribute setter value = - Msg.CRUD <| - Msg.Update <| - Updater.AttributeMsg "questions" <| - Updater.DictKeyMsg (unbox id) <| - Updater.AttributeMsg "value" <| - Updater.AttributeMsg "input_type" <| - Updater.AttributeMsg attribute <| - setter value - - moreInfo : String - moreInfo = - Maybe.map (IT.input_type.toString "*") mbit - |> Maybe.andThen Result.toMaybe - |> Maybe.withDefault "" - in if model.short == Just itid then case Maybe.map .value <| Maybe.andThen (\x -> Dict.get (unbox x) db.input_types) model.short of Just (IT.ShortAnswer short) -> @@ -860,7 +795,7 @@ viewSettings db id model ( itid, mbit ) = else if model.list == Just itid then case Maybe.map .value <| Maybe.andThen (\x -> Dict.get (unbox x) db.input_types) model.list of - Just (IT.List list) -> + Just (IT.List _) -> [ text "Boxes or Radio?" , FormField.formField (FormField.config diff --git a/src/Page/Questionary.elm b/src/Page/Questionary.elm index 53dfb67..e4fd949 100644 --- a/src/Page/Questionary.elm +++ b/src/Page/Questionary.elm @@ -1,4 +1,4 @@ -module Page.Questionary exposing (Fokus, Item, Model, defaultFokus, init, page, update, view) +module Page.Questionary exposing (Fokus, Item, Model, defaultFokus, page) --import Browser @@ -7,35 +7,22 @@ import DnDList import Html exposing (Html, div, p, text) import Html.Attributes exposing (style) import Html.Events exposing (onClick) -import Identicon exposing (identicon) -import List.Extra -import Material.Button as Button -import Material.Card as Card exposing (actions, block, primaryAction) -import Material.Checkbox as Checkbox import Material.Fab as Fab -import Material.Icon as Icon import Material.IconButton as IconButton import Material.LayoutGrid as LG exposing (cell, inner, layoutGrid) import Material.List as MList exposing (list) -import Material.List.Item as MLItem exposing (graphic, listItem) +import Material.List.Item as MLItem exposing (listItem) import Material.Menu as Menu -import Material.Radio as Radio -import Material.Select as Select -import Material.Select.Item as SelectItem -import Material.TextArea as TextArea import Material.TextField as TextField import Material.Typography as Typography import Msg import Page exposing (Page(..)) import Session -import Svg.Attributes exposing (x) -import Task import Time exposing (Posix) import Type.Database as Db import Type.Database.InputType as IT import Type.Database.TypeMatching as Match -import Type.IO.Form as Form -import Type.IO.Internal as Id exposing (Id, box, unbox) +import Type.IO.Internal exposing (Id, box, unbox) import Type.IO.Setter as Updater import Viewer exposing (detailsConfig, system) import Viewer.OrderAwareList exposing (OrderAware, orderAwareList) @@ -101,7 +88,7 @@ page session id focus mbquestions dndmodel = } dbquestions = - Dict.filter (\qid question -> question.value.questionary == id) session.db.questions + Dict.filter (\_ question -> question.value.questionary == id) session.db.questions |> Dict.toList |> List.sortBy (\( _, question ) -> question.value.index) |> List.map (\( a, b ) -> Item a b) @@ -216,36 +203,6 @@ update message (Page model) = ( Page model, Cmd.none ) -changeIndices : List Item -> List Item -> Cmd Msg.Msg -changeIndices old new = - List.map2 - changeIndex - old - new - |> List.filterMap identity - |> Match.setManyFields - |> Task.succeed - |> Task.perform identity - - -changeIndex : Item -> Item -> Maybe (Match.FieldConfig Int Db.Question) -changeIndex old new = - if old.question.value.index == new.question.value.index then - Nothing - - else - let - setIndex id index = - { kind = Db.QuestionType - , attribute = "index" - , setter = Updater.IntMsg - , id = box id - , value = index - } - in - Just <| setIndex new.id old.question.value.index - - -- VIEW @@ -295,7 +252,7 @@ view (Page.Page model) = [ editableText model.page.focus.titleFocused (Msg.Questionary <| Msg.QuestionNameEdit <| Msg.GetFocus) - (\x -> Msg.Questionary <| Msg.QuestionNameEdit <| Msg.LooseFocus) + (\_ -> Msg.Questionary <| Msg.QuestionNameEdit <| Msg.LooseFocus) infos.name <| \x -> @@ -422,23 +379,6 @@ editableText active activator deactivator value callback = -- ] -- ] - - -viewDraggableQuestionList : Model -> List (Html Msg.Msg) -viewDraggableQuestionList model = - [ case List.indexedMap (itemView model.dnd) model.questions of - first :: rest -> - MList.list MList.config - first - rest - - _ -> - Html.text " " - , ghostView model.dnd model.questions - ] - - - -- let -- questions = List.indexedMap (itemView model.dnd) model.questions -- in @@ -455,42 +395,6 @@ viewDraggableQuestionList model = -- ] -- _ -> -- [text "NoItem"] - - -itemView : DnDList.Model -> Int -> Item -> MLItem.ListItem Msg.Msg -itemView dnd index item = - let - itemId : String - itemId = - "id-" ++ item.id - - --system = dndSystem - in - case system.info dnd of - Just { dragIndex } -> - if dragIndex /= index then - MLItem.listItem - (MLItem.config - |> MLItem.setAttributes (Html.Attributes.id itemId :: system.dropEvents index itemId) - ) - [ Html.text item.id ] - - else - MLItem.listItem - (MLItem.config - |> MLItem.setAttributes [ Html.Attributes.id itemId ] - ) - [ Html.text "[---------]" ] - - Nothing -> - MLItem.listItem - (MLItem.config - |> MLItem.setAttributes (Html.Attributes.id itemId :: system.dragEvents index itemId) - ) - [ Html.text item.id ] - - - {- let itemId : String itemId = @@ -522,31 +426,6 @@ itemView dnd index item = -} -ghostView : DnDList.Model -> List Item -> Html.Html Msg.Msg -ghostView dnd items = - let - maybeDragItem : Maybe Item - maybeDragItem = - system.info dnd - |> Maybe.andThen (\{ dragIndex } -> items |> List.drop dragIndex |> List.head) - in - case maybeDragItem of - Just item -> - list - (MList.config - |> MList.setTwoLine True - |> MList.setInteractive False - ) - (listItem - (MLItem.config |> MLItem.setAttributes (system.ghostStyles dnd)) - [ MLItem.text [] { primary = [ Html.text item.id ], secondary = [] } ] - ) - [] - - Nothing -> - Html.text "" - - viewQuestionList : Model -> Db.Database -> RelatedData -> List (OrderAware Db.Question) -> Html Msg.Msg viewQuestionList model db infos questions = case questions of @@ -565,13 +444,6 @@ viewQuestionList model db infos questions = viewQuestionListItem : Model -> Db.Database -> OrderAware Db.Question -> MLItem.ListItem Msg.Msg viewQuestionListItem model db { id, value, previous, next } = - let - x = - 1 - - --upMsg = Match.swapFields Db.QuestionType "index" Updater.IntMsg ( prev.id, id ) ( prev.value.index, value.index ) - --downMsg = Match.swapFields Db.QuestionType "index" Updater.IntMsg ( post.id, id ) ( post.value.index, value.index ) - in listItem (MLItem.config {- |> MLItem.setOnClick (Msg.Follow Db.QuestionType id) -}) <| @@ -648,218 +520,8 @@ viewQuestionListItem model db { id, value, previous, next } = [] ) -} - - -viewQuestionCard : Db.Database -> Maybe (Id Db.Question String) -> OrderAware Db.Question -> Html Msg.Msg -viewQuestionCard db mbCur { id, value, previous, next } = - let - setMsg x callback = - Match.setField - { kind = Db.QuestionType - , attribute = "input_type" - , setter = \y -> Updater.Custom y callback - , value = unbox id - , id = box x - } - - question = - value - in - if mbCur == Just id then - Card.card Card.config - { blocks = - [ block <| - Html.div [ Html.Attributes.style "padding" "1rem" ] - [ Result.withDefault (div [] []) <| Match.forms (unbox id) Db.QuestionType "text" db <| wideTextForm Nothing ] - , block <| - Html.div [ Html.Attributes.style "padding" "1rem" ] <| - let - mlist = - List.map - (\x -> - SelectItem.selectItem - (SelectItem.config { value = IT.toString x }) - (IT.toString x) - ) - IT.inputTypes - in - case mlist of - f :: r -> - [ Select.outlined - (Select.config - |> Select.setLabel (Just "Question Type") - |> Select.setSelected (Just (unbox question.input_type)) - |> Select.setOnChange (\x -> setMsg x Nothing) - ) - f - r - ] - - _ -> - [] - , block <| - Html.div [ Html.Attributes.style "padding" "1rem" ] - [{- viewInputTypeActive question.input_type <| setMsg (IT.toString question.input_type) -}] - ] - , actions = - Just <| - actions - { buttons = - [ Card.button Button.config - "Visit" - ] - , icons = - (case previous of - Just prev -> - [ Card.icon (IconButton.config |> IconButton.setOnClick (Match.swapFields Db.QuestionType "index" Updater.IntMsg ( prev.id, id ) ( prev.value.index, value.index ))) - (IconButton.icon "arrow_upward") - ] - - Nothing -> - [] - ) - ++ (case next of - Just post -> - [ Card.icon (IconButton.config |> IconButton.setOnClick (Match.swapFields Db.QuestionType "index" Updater.IntMsg ( post.id, id ) ( post.value.index, value.index ))) - (IconButton.icon "arrow_downward") - ] - - Nothing -> - [] - ) - } - } - - else - Card.card Card.config - { blocks = - Card.primaryAction - [ Html.Events.onClick <| Msg.Questionary <| Msg.CurrentQuestionSelected <| Just (unbox id) ] - [ block <| - div [ Html.Attributes.style "padding" "1rem", Typography.headline6 ] - [ text question.text ] - , block <| - Html.div [ Html.Attributes.style "padding" "1rem" ] - [{- viewInputTypePassive question.input_type -}] - ] - , actions = - Just <| - actions - { buttons = - [ Card.button Button.config - "Visit" - ] - , icons = - (case previous of - Just prev -> - [ Card.icon (IconButton.config |> IconButton.setOnClick (Match.swapFields Db.QuestionType "index" Updater.IntMsg ( prev.id, id ) ( prev.value.index, value.index ))) - (IconButton.icon "arrow_upward") - ] - - Nothing -> - [] - ) - ++ (case next of - Just post -> - [ Card.icon (IconButton.config |> IconButton.setOnClick (Match.swapFields Db.QuestionType "index" Updater.IntMsg ( post.id, id ) ( post.value.index, value.index ))) - (IconButton.icon "arrow_downward") - ] - - Nothing -> - [] - ) - } - } - - -viewInputTypeActive : IT.InputType -> (Maybe Updater.Msg -> Msg.Msg) -> Html Msg.Msg -viewInputTypeActive kind callback = - case kind of - IT.ShortAnswer config -> - TextField.outlined - TextField.config - - IT.LongAnswer config -> - TextArea.filled TextArea.config - - IT.List config -> - let - mlist = - List.indexedMap - (\index x -> - listItem MLItem.config - [ viewSingleInputType config.singleInput - , TextField.outlined - (TextField.config - |> TextField.setValue (Just x) - |> TextField.setOnInput - (\y -> - callback <| - Just - (Updater.AttributeMsg "choices" <| - Updater.ListMixedUpdate index <| - Updater.StringMsg y - ) - ) - |> TextField.setPlaceholder (Just "Add a question") - ) - ] - ) - (config.choices ++ [ "" ]) - in - case mlist of - f :: r -> - list (MList.config |> MList.setInteractive False) f r - - _ -> - Html.text "No entry" - - - -- _ -> -- div [] [] - - -viewInputTypePassive : IT.InputType -> Html msg -viewInputTypePassive kind = - case kind of - IT.ShortAnswer config -> - TextField.outlined TextField.config - - IT.LongAnswer config -> - TextArea.outlined TextArea.config - - IT.List config -> - let - tlist = - List.indexedMap - (\index x -> - listItem MLItem.config - [ viewSingleInputType config.singleInput - , text x - ] - ) - config.choices - in - case tlist of - f :: r -> - list (MList.config |> MList.setInteractive False) f r - - _ -> - Html.text "List is empty" - - -viewSingleInputType : IT.SingleInputType -> Html msg -viewSingleInputType kind = - case kind of - IT.Box -> - Checkbox.checkbox Checkbox.config - - IT.Radio -> - Radio.radio Radio.config - - - -- Db.List Db.Radio _ -> -- "Multiple Choice" -- Db.List Db.Box _ -> @@ -922,45 +584,6 @@ viewStudy ( id, mbStudy ) cur = |> Maybe.withDefault (unbox id) -viewList : List ( String, a ) -> (String -> msg) -> Html msg -viewList elements onClick = - let - mlist = - List.map (\( x, _ ) -> listItem (MLItem.config {- |> MLItem.setOnClick (onClick x) -}) [ MLItem.graphic [] [ identicon "100%" x ], text x ]) elements - in - case mlist of - f :: r -> - list (MList.config |> MList.setInteractive False) f r - - _ -> - list MList.config - (listItem MLItem.config [ text "Nothing here, create one?" ]) - [] - - toTitle : Model -> String toTitle model = Maybe.withDefault "Home ⧽ Questionary" <| Maybe.map (\x -> x.value.name) model.questionary - - -textForm : Maybe String -> Form.FormFunctor msg -textForm label value callback = - TextField.outlined - (TextField.config - |> TextField.setValue (Just value) - |> TextField.setOnInput callback - |> TextField.setLabel label - --|> TextField.setOutlined - ) - - -wideTextForm : Maybe String -> Form.FormFunctor msg -wideTextForm label value callback = - TextField.filled - (TextField.config - |> TextField.setValue (Just value) - |> TextField.setOnInput callback - |> TextField.setLabel label - --|> TextField.setFullwidth True - --|> TextField.setOutlined - ) diff --git a/src/Page/Study.elm b/src/Page/Study.elm index b8b9df7..63662a7 100644 --- a/src/Page/Study.elm +++ b/src/Page/Study.elm @@ -1,15 +1,13 @@ -module Page.Study exposing (Model, init, page, update, view) +module Page.Study exposing (Model, page) --import Browser -import Dict exposing (Dict) +import Dict import File.Download as Download -import Html exposing (Html, div, p, text) +import Html exposing (Html, p, text) import Identicon exposing (identicon) import Material.Button as Button exposing (unelevated) -import Material.Icon as Icon -import Material.IconButton as IconButton -import Material.LayoutGrid as LG exposing (cell, inner, layoutGrid) +import Material.LayoutGrid exposing (cell, inner, layoutGrid) import Material.List as MList exposing (list) import Material.List.Item as MLItem exposing (graphic, listItem) import Material.Typography as Typography @@ -18,9 +16,9 @@ import Page exposing (Page(..)) import Session import Time exposing (Posix) import Type.Database as Db -import Type.Database.Aquisition as Aq exposing (..) +import Type.Database.Aquisition exposing (..) import Type.Database.TypeMatching as Match -import Type.IO.Internal as Id exposing (Id, box, unbox) +import Type.IO.Internal exposing (Id, box, unbox) import Type.IO.Setter as Updater import Viewer exposing (detailsConfig) import Viewer.EditableText as EditableText @@ -41,14 +39,6 @@ type alias Model = -- INIT - - -init : Id Db.Study String -> Bool -> Model -init = - Model - - - {- { active = False , activator = Msg.Study <| Msg.StudyNameEdit Msg.GetFocus @@ -347,8 +337,8 @@ exportStudy id db = |> move (Value .coding_questionary) db.coding_questions (Raw Tuple.first) |> add (Value .coding_question) db.coding_answers (Value .value) |> move (Value .coding_question) db.coding_answers (Raw Tuple.first) - |> move (Raw Tuple.first) db.coding_answers (Raw (\( x, y ) -> y.creator)) - |> add (Raw (\( x, y ) -> y.creator)) db.users (Value (\x -> Maybe.withDefault "" x.name)) + |> move (Raw Tuple.first) db.coding_answers (Raw (\( _, y ) -> y.creator)) + |> add (Raw (\( _, y ) -> y.creator)) db.users (Value (\x -> Maybe.withDefault "" x.name)) |> end in List.map serializeStudyDatapoint datapoints diff --git a/src/Page/Top.elm b/src/Page/Top.elm index 565be80..3a4104f 100644 --- a/src/Page/Top.elm +++ b/src/Page/Top.elm @@ -1,34 +1,17 @@ -module Page.Top exposing (Model, init, page, update, view) +module Page.Top exposing (Model, page) -import Browser -import Browser.Events -import Browser.Navigation import Dict import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events -import Identicon exposing (identicon) -import Json.Decode import Material.Button as Button -import Material.Card as Card exposing (actions, block, card) -import Material.Icon as Icon -import Material.IconButton as IconButton import Material.LayoutGrid as LG exposing (cell, layoutGrid) -import Material.List as MList -import Material.List.Item as MLItem -import Material.TabBar as TabBar -import Material.Theme as Theme -import Material.Typography as Typography import Msg import Page import Ports import Session import Type.Database as Db import Type.Database.TypeMatching as Match -import Type.IO.Internal as Id exposing (Id, box, unbox) +import Type.IO.Internal exposing (Id, box, unbox) import Type.IO.Setter as Updater -import Url.Builder -import Utils exposing (..) import Viewer exposing (detailsConfig) import Viewer.Internal as I exposing (defaultCardConfig) @@ -147,10 +130,6 @@ update message (Page.Page model) = view : Page.Page Model Msg.Msg -> Viewer.Details Msg.Msg view (Page.Page model) = - let - db = - model.session.db - in { detailsConfig | title = toTitle , top = True @@ -220,7 +199,7 @@ studyOverview user (Page.Page model) = db.studies |> Dict.toList |> List.map (\( x, y ) -> ( x, y.value )) - |> List.filter (\( x, y ) -> y.leader == user) + |> List.filter (\( _, y ) -> y.leader == user) -- |> List.map (\(x,y) -> (x, Db.study.viewer db y)) |> List.map (\( x, y ) -> studyCard x y) @@ -252,59 +231,6 @@ studyCard id study = -- } -- { label = "Coding", icon = Nothing } -- ] - - -viewCodingCard : String -> Db.Database -> Html Msg.Msg -viewCodingCard user db = - card Card.config - { blocks = - Card.primaryAction [] - [ block <| - div - [ Html.Attributes.style "margin-left" "auto" - , Html.Attributes.style "margin-right" "auto" - , Html.Attributes.style "padding-top" "1rem" - , Html.Attributes.style "width" "25%" - ] - [ identicon "100%" user ] - , block <| - Html.div [ Html.Attributes.style "padding" "1rem" ] - [ Html.h2 - [ Typography.headline6 - , Html.Attributes.style "margin" "0" - ] - [ text <| "Coding: " ++ user ] - , Html.h3 - [ Typography.subtitle2 - , Theme.textSecondaryOnBackground - , Html.Attributes.style "margin" "0" - ] - [ text "Some interesting Subtitle" ] - ] - , block <| - Html.div - [ Html.Attributes.style "padding" "0 1rem 0.5rem 1rem" - , Typography.body2 - , Theme.textSecondaryOnBackground - ] - [ Html.p [] [ text "Description" ] ] - ] - , actions = - Just <| - actions - { buttons = - [ Card.button Button.config - "Visit" - ] - , icons = - [ Card.icon IconButton.config <| - IconButton.icon "favorite" - ] - } - } - - - -- HELPERS @@ -312,29 +238,5 @@ toTitle = "Home" -highlights = - ul [] - [ li [] [ text "Client-side routing that uses pushState navigation and the forward slash `/` as the path separator." ] - , li [] [ text "Search Engine Optimization (SEO) friendly - unique Title for each page." ] - , li [] [ text "Support for localStorage, with the necessary ports and JS handlers already initalized." ] - , li [] [ text "Support for responsive site design by listening for window size changes and always storing window size in the model." ] - , li [] [ text "Built with webpack." ] - , li [] [ text "Well-commented code!" ] - ] - - -- Custom event listener for the 'Enter' key being pressed - - -onEnter : Msg.TopMsg -> Attribute Msg.TopMsg -onEnter msg = - let - isEnter code = - if code == 13 then - Json.Decode.succeed msg - - else - Json.Decode.fail "not ENTER" - in - Html.Events.on "keydown" (Json.Decode.andThen isEnter Html.Events.keyCode) diff --git a/src/Page/User.elm b/src/Page/User.elm index 278d2df..051e2a1 100644 --- a/src/Page/User.elm +++ b/src/Page/User.elm @@ -1,8 +1,7 @@ -module Page.User exposing (Model, init, page, update, view) +module Page.User exposing (Model, page) -import Browser -import Html exposing (div,text, h1, h3, a) -import Html.Attributes exposing (href, class) +import Html exposing (a, div, h1, h3, text) +import Html.Attributes exposing (class, href) import Msg exposing (UserMsg) import Page exposing (Page(..)) import Session diff --git a/src/Ports.elm b/src/Ports.elm index 0d563f0..6fa9514 100644 --- a/src/Ports.elm +++ b/src/Ports.elm @@ -1,7 +1,6 @@ port module Ports exposing (clearLocalStorage, onDbChange, onLocalStorageChange, toDb, toLocalStorage) import Json.Encode -import Type.Database import Type.LocalStorage diff --git a/src/Session.elm b/src/Session.elm index b3e21fe..a5c7855 100644 --- a/src/Session.elm +++ b/src/Session.elm @@ -3,7 +3,6 @@ module Session exposing (Session, init) import Json.Decode import Time import Type.Database as Db -import Type.Database.TypeMatching as Match import Type.Flags import Type.IO.Internal exposing (Id) @@ -49,19 +48,6 @@ init flags = in case db of Ok storage -> - let - user : Maybe String - user = - Match.keys Db.UserType storage - |> (\x -> - case List.length x of - 1 -> - List.head x - - _ -> - Nothing - ) - in Session posixTime flags.windowSize Nothing storage Err _ -> diff --git a/src/TestDrawer.elm b/src/TestDrawer.elm index 5575f9a..635888f 100644 --- a/src/TestDrawer.elm +++ b/src/TestDrawer.elm @@ -1,7 +1,6 @@ module TestDrawer exposing (main) import Html exposing (text) -import Html.Attributes exposing (style) import Material.Drawer.Modal as ModalDrawer exposing ( content @@ -12,12 +11,6 @@ import Material.Drawer.Modal as ModalDrawer , drawer --, drawerScrim ) -import Material.List - exposing - ( config - , list - ) -import Material.List.Item exposing (config, listItem) main : Html.Html msg diff --git a/src/Type/Database.elm b/src/Type/Database.elm index d6b2585..9fc65b0 100644 --- a/src/Type/Database.elm +++ b/src/Type/Database.elm @@ -1,10 +1,9 @@ -module Type.Database exposing (Answer, AnswerView, Coder, CoderView, Coding, CodingAnswer, CodingAnswerView, CodingFrame, CodingFrameView, CodingQuestion, CodingQuestionView, CodingQuestionary, CodingQuestionaryView, CodingView, Database, DatabaseView, Event, EventView, InputTypeKind(..), Place, Question, QuestionView, Questionary, QuestionaryView, Row, Study, StudyView, Table, TableView, TestSubject, TestSubjectView, Timestamp, TimestampView, Type(..), User, answer, coder, coding, coding_answer, coding_frame, coding_question, coding_questionary, database, event, place, question, questionary, rows, study, table, test_subject, timestamp, updateEmpty, user) +module Type.Database exposing (Answer, AnswerView, Coder, CoderView, Coding, CodingAnswer, CodingAnswerView, CodingFrame, CodingFrameView, CodingQuestion, CodingQuestionView, CodingQuestionary, CodingQuestionaryView, CodingView, Database, DatabaseView, Event, EventView, InputTypeKind(..), Place, Question, QuestionView, Questionary, QuestionaryView, Row, Study, StudyView, Table, TableView, TestSubject, TestSubjectView, Timestamp, TimestampView, Type(..), User, answer, coder, coding, coding_answer, coding_frame, coding_question, coding_questionary, database, event, question, questionary, rows, study, table, test_subject, timestamp, user) import Dict exposing (Dict) import Tuple import Type.Database.InputType as IT -import Type.IO exposing (IO, dict, string, entity, substruct, reference, attribute, bool, maybe, int, float) -import Type.IO.Encoder exposing (Encoder(..)) +import Type.IO exposing (IO, attribute, bool, dict, entity, float, int, maybe, reference, string, substruct) import Type.IO.Internal as Id exposing (Id) @@ -404,13 +403,12 @@ type alias TimestampView a = timestamp : IO a Database b msg -> IO (Timestamp a) Database (TimestampView b) msg timestamp other = entity Timestamp TimestampView - |> reference "creator" string .creator .users Dict.get .value - |> attribute "created" int .created - |> attribute "modified" int .modified - |> attribute "accessed" int .accessed - |> attribute "deleted" (maybe int) .deleted - |> substruct "value" other .value - + |> reference "creator" string .creator .users Dict.get .value + |> attribute "created" int .created + |> attribute "modified" int .modified + |> attribute "accessed" int .accessed + |> attribute "deleted" (maybe int) .deleted + |> substruct "value" other .value diff --git a/src/Type/Database/Aquisition.elm b/src/Type/Database/Aquisition.elm index 3f53ae2..67465ad 100644 --- a/src/Type/Database/Aquisition.elm +++ b/src/Type/Database/Aquisition.elm @@ -1,9 +1,7 @@ -module Type.Database.Aquisition exposing (Aquisition, AttributeAccessor(..), add, addAttrList, addAttrSingle, aquire, end, filterBy, move, moveReferenceList, moveReferenceSingle, start, transformAccessor, updateReciever, updateReference) +module Type.Database.Aquisition exposing (Aquisition, AttributeAccessor(..), add, aquire, end, move, moveReferenceSingle, start) -import Dict exposing (Dict) -import Type.Database as Db exposing (Database, Row, Table, Timestamp, Type(..), coding_questionary) -import Type.Database.TypeMatching as Match -import Type.IO.Internal as Id exposing (Id) +import Type.Database as Db exposing (Row, Table) +import Type.IO.Internal exposing (Id) type AttributeAccessor a b diff --git a/src/Type/Database/InputType.elm b/src/Type/Database/InputType.elm index 24b2fb5..97bace6 100644 --- a/src/Type/Database/InputType.elm +++ b/src/Type/Database/InputType.elm @@ -1,6 +1,5 @@ -module Type.Database.InputType exposing (InputType(..), ListConfig, LongAnswerConfig, ShortAnswerConfig, SingleInputType(..), fromString, inputTypeDecoder, inputTypeEncoder, inputTypeForm, inputTypeFuzzer, inputTypeToString, inputTypeUpdater, inputTypes, input_type, listConfig, longAnswerConfig, shortAnswerConfig, singleInputType, singleInputTypeDecoder, singleInputTypeEncoder, singleInputTypeForm, singleInputTypeToString, singleInputTypeUpdater, toString, updateEmpty) +module Type.Database.InputType exposing (InputType(..), ListConfig, LongAnswerConfig, ShortAnswerConfig, SingleInputType(..), input_type, listConfig, longAnswerConfig, toString) -import Dict exposing (Dict) import Fuzz import Json.Decode import Json.Encode @@ -8,7 +7,7 @@ import Type.IO exposing (IO, attribute, entity, int, list, maybe, string, substr import Type.IO.Encoder as Encoder exposing (Encoder(..)) import Type.IO.Form as Form exposing (Form) import Type.IO.Setter as Updater exposing (Updater) -import Type.IO.ToString as ToString exposing (ToString) +import Type.IO.ToString exposing (ToString) type InputType @@ -163,20 +162,6 @@ listConfig = |> updateEmpty (\x -> { x | choices = [ "Unnamed Choice" ] }) -inputTypes : List InputType -inputTypes = - [ ShortAnswer shortAnswerConfig.empty - , LongAnswer longAnswerConfig.empty - , List <| ListConfig Radio [] - , List <| ListConfig Box [] - - -- , DropDown [] - -- , LinearScale Dict.empty - -- , Matrix Radio [] [] - -- , Matrix Box [] [] - ] - - toString : InputType -> String toString kind = case kind of @@ -186,7 +171,7 @@ toString kind = LongAnswer _ -> "Long Answer" - List { singleInput, choices } -> + List { singleInput } -> case singleInput of Radio -> "Multiple Choice" @@ -204,36 +189,6 @@ toString kind = -- "Grid of Multiple Choices" -- Matrix Box _ _ -> -- "Grid of Boxes" - - -fromString : String -> Maybe InputType -fromString name = - case name of - "Short Answer" -> - Just (ShortAnswer shortAnswerConfig.empty) - - "Long Answer" -> - Just (LongAnswer longAnswerConfig.empty) - - "Multiple Choice" -> - Just <| List <| ListConfig Radio [ "Unnamed Choice" ] - - "Boxes" -> - Just <| List <| ListConfig Box [ "Unnamed Choice" ] - - -- "DropDown Menu" -> - -- Just <| DropDown [] - -- "Linear Scale" -> - -- Just <| LinearScale Dict.empty - -- "Grid of Multiple Choices" -> - -- Just <| Matrix Radio [] [] - -- "Grid of Boxes" -> - -- Just <| Matrix Box [] [] - _ -> - Nothing - - - -- decodeInputType : Json.Decoder.Decoder InputType -- decodeInputType = @@ -368,7 +323,7 @@ inputTypeUpdater msg val = _ -> Err Updater.InvalidValue -} - Updater.AttributeMsg name msg_ -> + Updater.AttributeMsg _ _ -> case val of ShortAnswer v -> Result.map ShortAnswer <| shortAnswerConfig.updater msg v diff --git a/src/Type/Database/TypeMatching.elm b/src/Type/Database/TypeMatching.elm index 064e715..fc121d6 100644 --- a/src/Type/Database/TypeMatching.elm +++ b/src/Type/Database/TypeMatching.elm @@ -1,15 +1,14 @@ -module Type.Database.TypeMatching exposing (DispatchType(..), FieldConfig, FieldUpdateConfig, concatTupleFirst, concatTupleLast, delete, dispatchDb, fields, filterBy, forms, fromString, getField, getTimestampUpdaterMsg, join, keys, new, resolveAttributes, setField, setFieldRaw, setManyFields, setTimestamp, swapFields, toString, toStringPlural, types, updateField) +module Type.Database.TypeMatching exposing (DispatchType(..), FieldConfig, delete, fields, forms, getField, keys, new, setField, setTimestamp, toString, toStringPlural, types) import Dict exposing (Dict) import Html exposing (Html) import Msg import Task exposing (perform) import Time exposing (Posix, now, posixToMillis) -import Type.Database as Db exposing (Database, InputTypeKind(..), Row, Table, Type(..), answer, coder, coding, coding_answer, coding_frame, coding_question, coding_questionary, database, event, question, questionary, study, test_subject, timestamp, user) -import Type.Database.InputType as IT exposing (InputType, input_type) -import Type.IO exposing (IO) -import Type.IO.Form as Form exposing (UpdateMsg(..)) -import Type.IO.Internal as Id exposing (Id, unbox) +import Type.Database as Db exposing (Database, InputTypeKind(..), Type(..), answer, coder, coding, coding_answer, coding_frame, coding_question, coding_questionary, database, event, question, questionary, study, test_subject, timestamp, user) +import Type.Database.InputType as IT exposing (input_type) +import Type.IO.Form as Form exposing (UpdateMsg) +import Type.IO.Internal exposing (Id, unbox) import Type.IO.Setter as Updater @@ -33,55 +32,6 @@ types = ] -fromString : String -> Maybe Type -fromString name = - case name of - "answer" -> - Just AnswerType - - "coder" -> - Just CoderType - - "coding" -> - Just CodingType - - "coding_answer" -> - Just CodingAnswerType - - "coding_frame" -> - Just CodingFrameType - - "coding_question" -> - Just CodingQuestionType - - "coding_questionary" -> - Just CodingQuestionaryType - - "event" -> - Just EventType - - "question" -> - Just QuestionType - - "questionary" -> - Just QuestionaryType - - "study" -> - Just StudyType - - "user" -> - Just UserType - - "input_type" -> - Just (InputTypeType ShortKind) - - "test_subject" -> - Just TestSubjectType - - _ -> - Nothing - - toString : Type -> String toString kind = case kind of @@ -449,50 +399,6 @@ setTimestamp kind id attribute = |> (\x -> perform x now) -filterBy : (Row b -> Id a c) -> (Database -> Table b) -> Database -> Id a c -> List (Row b) -filterBy attr dbgetter db old = - dbgetter db - |> Db.rows - |> List.filter (\x -> attr x == old) - - -resolveAttributes : (a -> Id b String) -> (Database -> Table b) -> Database -> Row a -> List ( Row a, Row b ) -resolveAttributes attr dbgetter db ( oldid, fullold ) = - let - f : Id b String -> List (Row b) - f id = - dbgetter db - |> Db.rows - |> List.filter (\( cid, _ ) -> cid == id) - in - ( oldid, fullold ) - |> (\( id, value ) -> ( ( id, value ), f (attr value.value) )) - |> (\( oldval, list ) -> List.map (\newval -> ( oldval, newval )) list) - - -join : (Row b -> Id a String) -> (Database -> Table b) -> Database -> List (Row a) -> List ( Row a, Row b ) -join attr dbgetter db old = - let - k : List (Id a String) - k = - List.map (\( id, value ) -> id) old - in - old - |> List.map (\( id, value ) -> ( ( id, value ), filterBy attr dbgetter db id )) - |> List.map (\( oldval, list ) -> List.map (\newval -> ( oldval, newval )) list) - |> List.concat - - -concatTupleFirst : ( List a, b ) -> List ( a, b ) -concatTupleFirst ( l, elem ) = - List.map (\x -> ( x, elem )) l - - -concatTupleLast : ( a, List b ) -> List ( a, b ) -concatTupleLast ( elem, l ) = - List.map (\x -> ( elem, x )) l - - type alias FieldConfig a b = { kind : Type , attribute : String @@ -513,55 +419,8 @@ setField { kind, attribute, setter, id, value } = setter value -setManyFields : List (FieldConfig a b) -> Msg.Msg -setManyFields f = - List.map setFieldRaw f - |> Msg.UpdateAll - |> Msg.CRUD - - -setFieldRaw : FieldConfig a b -> Updater.Msg -setFieldRaw { kind, attribute, setter, id, value } = - Updater.AttributeMsg (toStringPlural kind) <| - Updater.DictKeyMsg (unbox id) <| - Updater.AttributeMsg "value" <| - Updater.AttributeMsg attribute <| - setter value - - -type alias FieldUpdateConfig a = - { kind : Type - , attribute : String - , setter : (a -> a) -> Updater.Msg - , id : String - } - - -updateField : FieldUpdateConfig a -> (a -> a) -> Updater.Msg -updateField config updater = - Updater.AttributeMsg (toStringPlural config.kind) <| - Updater.DictKeyMsg config.id <| - Updater.AttributeMsg "value" <| - Updater.AttributeMsg config.attribute <| - config.setter updater - - -- go down and get value via update - - -swapFields : Type -> String -> (a -> Updater.Msg) -> ( Id b String, Id b String ) -> ( a, a ) -> Msg.Msg -swapFields kind attribute setter ( f_id, s_id ) ( f_val, s_val ) = - Msg.CRUD <| - Msg.UpdateAll - [ setFieldRaw - { kind = kind, attribute = attribute, setter = setter, id = f_id, value = s_val } - , setFieldRaw - { kind = kind, attribute = attribute, setter = setter, id = s_id, value = f_val } - ] - - - -- swapFields : FieldUpdateConfig a -> FieldUpdateConfig a -> Database -> Database -- swapFields first second db = -- let diff --git a/src/Type/Entity.elm b/src/Type/Entity.elm index c661cc1..57655c7 100644 --- a/src/Type/Entity.elm +++ b/src/Type/Entity.elm @@ -1,33 +1,8 @@ -module Type.Entity exposing (Encoder, Entity(..), IO, Parser, RecordBuilder, RecordEncoder, TypeBuilder, View, adapt_encoder, adapt_toString, encode, finish, int, int_io, match_encoder, match_model, maybe, new, string) +module Type.Entity exposing (Entity(..), RecordBuilder, RecordEncoder) import Dict exposing (Dict) -import Html exposing (Html) -import Json.Decode exposing (Decoder, nullable, succeed) -import Json.Decode.Pipeline -import Json.Encode exposing (null) -import Json.Encode.Extra -import Msg exposing (Msg) - - -type alias View flag mediator target = - { translate : flag -> mediator -> target - , entity : Entity target - } - - -type alias IO delta target = - { decoder : String -> (Decoder (delta -> target) -> Decoder target) - , toString : delta -> String - , encoder : Encoder delta - } - - -int_io : IO Int a -int_io = - { decoder = \x -> Json.Decode.Pipeline.required x Json.Decode.int - , toString = String.fromInt - , encoder = Json.Encode.int - } +import Json.Decode exposing (Decoder) +import Json.Encode @@ -40,17 +15,12 @@ int_io = -- } -type alias Encoder a = - a -> Json.Encode.Value - - type alias RecordEncoder a = List (a -> ( String, Json.Encode.Value )) type Entity flag = Record (RecordBuilder flag flag) - | Type (TypeBuilder flag flag) type alias RecordBuilder decoded built = @@ -62,85 +32,12 @@ type alias RecordBuilder decoded built = } -type alias TypeBuilder a b = - { name : String - , decoder : Decoder b - , encoder : Encoder a - , toString : a -> String - } - - -type alias Parser a = - a -> String - - -- maybe : Parser a -> Parser (Maybe a) -- maybe parse target = -- Maybe.map parse target -- |> Maybe.withDefault "" -- connect : String -> Entity a b mediator -> Entity c d mediator -> - - -maybe : Entity flag -> Entity (Maybe flag) -maybe p = - case p of - Type b -> - Type - { name = "maybe " ++ b.name - , decoder = nullable b.decoder - , encoder = Json.Encode.Extra.maybe b.encoder - , toString = - \x -> - case x of - Just v -> - b.toString v - - Nothing -> - "" - } - - Record e -> - Record - { name = "maybe " ++ e.name - , decoder = nullable e.decoder - , encoder = - [ \entity -> - ( e.name - , case entity of - Just v -> - Json.Encode.object (List.map (\x -> x v) e.encoder) - - Nothing -> - null - ) - ] - , attributes = e.attributes - , toString = Dict.map (\k v a -> Maybe.map v a |> Maybe.withDefault "") e.toString - } - - -int : Entity Int -int = - Type - { name = "int" - , decoder = Json.Decode.int - , encoder = Json.Encode.int - , toString = String.fromInt - } - - -string : Entity String -string = - Type - { name = "string" - , decoder = Json.Decode.string - , encoder = Json.Encode.string - , toString = \x -> x - } - - - -- attribute : -- String -- -> (built -> newtype) @@ -229,64 +126,7 @@ string = -- encoder = old.encoder, -- model = \built mediator -> Maybe.map2 (\argument oldf -> oldf argument) (mgetter (rgetter built) mediator) (old.model built mediator) -- } - - -new : a -> RecordBuilder a b -new entity = - { name = "" - , decoder = succeed entity - , encoder = [] - , attributes = [] - , toString = Dict.empty - } - - -finish : RecordBuilder a a -> Entity a -finish e = - Record e - - -encode : RecordBuilder a b -> b -> Json.Encode.Value -encode entity instance = - Json.Encode.object - (List.map (\x -> x instance) entity.encoder) - - - -- HELPER - - -match_encoder : (a -> b) -> String -> (b -> Json.Encode.Value) -> List (a -> ( String, Json.Encode.Value )) -> List (a -> ( String, Json.Encode.Value )) -match_encoder getter name encoder old = - (\x -> ( name, encoder (getter x) )) :: old - - -adapt_encoder : RecordEncoder a -> Encoder a -adapt_encoder r = - \encodable -> Json.Encode.object (List.map (\y -> y encodable) r) - - -adapt_toString : Dict String (a -> String) -> Dict String (b -> String) -> Dict String (b -> String) -adapt_toString oldToString newToString = - newToString - - -match_model : (flag -> mediator -> Maybe a) -> (flag -> mediator -> Maybe (a -> model)) -> (flag -> mediator -> Maybe model) -match_model getter old_model = - \flag mediator -> - let - value : Maybe a - value = - getter flag mediator - - func : Maybe (a -> model) - func = - old_model flag mediator - in - Maybe.map2 (\x y -> x y) func value - - - -- type alias Encoder a = -- a -> Json.Encode.Value -- type alias Entity a b = diff --git a/src/Type/Flags.elm b/src/Type/Flags.elm index d2198b4..2b50480 100644 --- a/src/Type/Flags.elm +++ b/src/Type/Flags.elm @@ -1,7 +1,6 @@ module Type.Flags exposing (Flags) import Json.Encode -import Type.LocalStorage diff --git a/src/Type/Graph.elm b/src/Type/Graph.elm index cd5f7fa..f48c6de 100644 --- a/src/Type/Graph.elm +++ b/src/Type/Graph.elm @@ -1,6 +1,5 @@ -module Type.Graph exposing (DataView, Decoder) +module Type.Graph exposing (Decoder) -import Dict exposing (Dict) import Json.Decode @@ -8,9 +7,3 @@ type alias Decoder container decoded = { container | decode : Json.Decode.Decoder decoded } - - -type alias DataView container source mediator target = - { container - | view : source -> mediator -> target - } diff --git a/src/Type/IO.elm b/src/Type/IO.elm index a31b2e7..86992fa 100644 --- a/src/Type/IO.elm +++ b/src/Type/IO.elm @@ -1,4 +1,4 @@ -module Type.IO exposing (DatatypeIO, IO, PartialIO, Reference(..), array, attribute, bool, dict, encode, entity, float, form2update, int, list, map_decoder_maybe, map_maybe_func, maybe, reference, reference_fuzzer, references, result, string, substruct) +module Type.IO exposing (DatatypeIO, IO, PartialIO, Reference(..), array, attribute, bool, dict, encode, entity, float, form2update, int, list, maybe, reference, string, substruct) import Array exposing (Array) import Dict exposing (Dict) @@ -187,7 +187,7 @@ array old = entity : b -> c -> PartialIO b a db c msg entity new view = { decoder = Decoder.entity new - , strDecoder = \a -> Decoder.entity new + , strDecoder = \_ -> Decoder.entity new , toString = ToString.entity new , encoder = Encoder.entity , fuzzer = Fuzz.constant new @@ -281,17 +281,6 @@ reference_fuzzer = |> Fuzz.map (\x -> Reference x) -map_decoder_maybe : (Decoder (delta -> target) -> Decoder target) -> Decoder (Maybe delta -> target) -> Decoder target -map_decoder_maybe olddecoder newhandle = - Json.Decode.map map_maybe_func newhandle - |> olddecoder - - -map_maybe_func : (Maybe delta -> target) -> delta -> target -map_maybe_func func val = - func (Just val) - - form2update : Form.UpdateMsg -> Maybe Update.Msg form2update fmsg = case fmsg of @@ -340,7 +329,7 @@ form2update fmsg = ( Just msg_, Just key_ ) -> Just (Update.DictKeyMsg key_ msg_) - ( _, _ ) -> + _ -> Nothing Form.ResultMsg state msg -> diff --git a/src/Type/IO/Decoder.elm b/src/Type/IO/Decoder.elm index a7f79d2..0aa5f5c 100644 --- a/src/Type/IO/Decoder.elm +++ b/src/Type/IO/Decoder.elm @@ -1,9 +1,8 @@ -module Type.IO.Decoder exposing (Decoder, array, attribute, bool, decodeDictFromTuples, dict, entity, float, int, list, maybe, reference, references, result, string, substruct) +module Type.IO.Decoder exposing (Decoder, array, attribute, bool, dict, entity, float, int, list, maybe, reference, references, result, string, substruct) import Array exposing (Array) import Dict exposing (Dict) -import Json.Decode exposing (Decoder, map, null, nullable, succeed) -import Json.Decode.Extra +import Json.Decode exposing (Decoder, succeed) import Json.Decode.Pipeline exposing (required) diff --git a/src/Type/IO/Encoder.elm b/src/Type/IO/Encoder.elm index ef71ecb..305a9f9 100644 --- a/src/Type/IO/Encoder.elm +++ b/src/Type/IO/Encoder.elm @@ -1,4 +1,4 @@ -module Type.IO.Encoder exposing (Encoder(..), array, attribute, bool, collapseEncoder, dict, entity, float, getMaybeOut, int, list, listToSingle, maybe, reference, references, result, string, substruct) +module Type.IO.Encoder exposing (Encoder(..), array, attribute, bool, collapseEncoder, dict, entity, float, int, list, maybe, reference, references, result, string, substruct) import Array exposing (Array) import Dict exposing (Dict) diff --git a/src/Type/IO/Form.elm b/src/Type/IO/Form.elm index c400506..6274f55 100644 --- a/src/Type/IO/Form.elm +++ b/src/Type/IO/Form.elm @@ -1,15 +1,9 @@ -module Type.IO.Form exposing (Error(..), Form, FormAcc, FormFunctor, ResultState(..), UpdateMsg(..), array, attribute, bool, combine_tuple, dict, entity, float, int, list, maybe, parseHeadTail, reference, references, result, string, substruct) +module Type.IO.Form exposing (Error(..), Form, FormFunctor, ResultState(..), UpdateMsg(..), array, attribute, bool, dict, entity, float, int, list, maybe, reference, references, result, string, substruct) import Array exposing (Array) import Dict exposing (Dict) import Html exposing (Html) -import Html.Attributes -import Html.Events -import Json.Decode exposing (map) import List.Extra -import Material.Checkbox as Checkbox exposing (config) -import Material.TextField as TextField exposing (config) -import Maybe.Extra import Type.IO.Internal as Id exposing (Id) @@ -40,11 +34,6 @@ type Error | NotFound -type alias FormAcc full msg = - { forms : full -> List (Html.Html msg) - } - - type alias FormFunctor msg = String -> (String -> msg) -> Html msg @@ -137,19 +126,6 @@ float name callback kind label f = bool : Form Bool msg bool _ callback kind _ f = - let - bool2state : Maybe Bool -> Checkbox.State - bool2state state = - case state of - Just True -> - Checkbox.checked - - Just False -> - Checkbox.unchecked - - Nothing -> - Checkbox.indeterminate - in Ok <| f (if kind then @@ -311,19 +287,6 @@ dict keySerializer old name callback kind acc f = |> (\(a, b)-> (Dict.fromList a, Dict.fromList b)) |> (\(a, b) -> {config=Just a, view = b}) -} - - -combine_tuple : ( Maybe a, Maybe b ) -> Maybe ( a, b ) -combine_tuple old = - case old of - ( Just a, Just b ) -> - Just ( a, b ) - - _ -> - Nothing - - - {- Dict.toList kind |> List.map (\(key,value) -> (Just key, old.config (callback << DictMsg (keySerializer key)) value)) |> Maybe.Extra.traverse combine_tuple diff --git a/src/Type/IO/Setter.elm b/src/Type/IO/Setter.elm index 2cfb3bb..bca286b 100644 --- a/src/Type/IO/Setter.elm +++ b/src/Type/IO/Setter.elm @@ -1,29 +1,12 @@ -module Type.IO.Setter exposing (Car, Error(..), Msg(..), PartialUpdater, Person, Updater, array, attribute, bool, car1, car2, carUpdater2, dict, entity, errToString, float, int, list, maybe, person_str_updater, reference, references, result, string, substruct, toString, updateWithLong) +module Type.IO.Setter exposing (Error(..), Msg(..), PartialUpdater, Updater, array, attribute, bool, dict, entity, errToString, float, int, list, maybe, reference, references, result, string, substruct) import Array exposing (Array) -import Array.Extra import Dict exposing (Dict) import List.Extra import Result.Extra import Type.IO.Internal as Id exposing (Id) -type alias Person = - { name : String } - - -person_str_updater : (Person -> String) -> (String -> String) -> Person -> Person -person_str_updater getter f x = - Person (f (getter x)) - - -type alias Car = - { brand : Maybe String - , model : Id Person String - , age : Int - } - - type Msg = IntMsg Int | IntUpdate (Int -> Int) @@ -328,24 +311,6 @@ substruct = attribute -carUpdater2 : Updater Car -carUpdater2 = - entity Car - |> attribute "brand" .brand (maybe "" string) - |> reference "model" .model string - |> attribute "age" .age int - - -car1 : Car -car1 = - Car Nothing (Id.box "mymodel") 12 - - -car2 : Result Error Car -car2 = - carUpdater2 (AttributeMsg "brand" (MaybeUpdateMsg (Just (StringMsg "Hello")))) car1 - - -- first = (updateWith ) -- carUpdater : Msg -> Car -> Car diff --git a/src/Type/IO/ToString.elm b/src/Type/IO/ToString.elm index 2724f3a..213ae0c 100644 --- a/src/Type/IO/ToString.elm +++ b/src/Type/IO/ToString.elm @@ -1,10 +1,10 @@ -module Type.IO.ToString exposing (Error(..), ToString, array, attribute, bool, dict, entity, float, int, l2s, list, map_array_toString, map_dict_toString, map_list_toString, maybe, parseHeadTail, reference, references, result, string, substruct) +module Type.IO.ToString exposing (Error(..), ToString, array, attribute, bool, dict, entity, float, int, list, maybe, reference, references, result, string, substruct) import Array exposing (Array) import Dict exposing (Dict) import List.Extra import Result.Extra -import Type.IO.Internal as Id exposing (Id, box, unbox) +import Type.IO.Internal as Id exposing (Id) type Error @@ -251,17 +251,6 @@ array old name arr = -- map_array_toString old -map_list_toString : (String -> kind -> Maybe String) -> String -> List kind -> Maybe String -map_list_toString old s l = - let - ( head, rest ) = - parseHeadTail s - in - String.toInt head - |> Maybe.andThen (\x -> List.Extra.getAt x l) - |> Maybe.andThen (old rest) - - parseHeadTail : String -> ( String, String ) parseHeadTail accessor = if accessor == "*" then @@ -285,29 +274,7 @@ parseHeadTail accessor = ( index, rest ) -map_dict_toString : (String -> Maybe comparable) -> (String -> value -> Maybe String) -> String -> Dict comparable value -> Maybe String -map_dict_toString key_parser value s d = - let - ( head, rest ) = - parseHeadTail s - in - key_parser head - |> Maybe.andThen (\x -> Dict.get x d) - |> Maybe.andThen (value rest) - - -- map_result_toString : (String -> kind -> Maybe String) -> String -> Result error kind -> Maybe String -- map_result_toString old s r = -- Debug.todo "" - - -map_array_toString : (String -> kind -> Maybe String) -> String -> Array kind -> Maybe String -map_array_toString old s a = - let - ( head, rest ) = - parseHeadTail s - in - String.toInt head - |> Maybe.andThen (\x -> Array.get x a) - |> Maybe.andThen (old rest) diff --git a/src/Type/IO/Update.elm b/src/Type/IO/Update.elm index d93411d..83b6051 100644 --- a/src/Type/IO/Update.elm +++ b/src/Type/IO/Update.elm @@ -1,4 +1,4 @@ -module Type.IO.Update exposing (Car, Msg(..), PartialUpdater, Person, Updater, array, attribute, bool, carUpdater2, dict, entity, float, int, list, maybe, person_str_updater, reference, references, result, string, substruct, updateWithLong) +module Type.IO.Update exposing (Msg(..), PartialUpdater, Updater) import Array exposing (Array) import Array.Extra @@ -6,22 +6,6 @@ import Dict exposing (Dict) import List.Extra -type alias Person = - { name : String } - - -person_str_updater : (Person -> String) -> (String -> String) -> Person -> Person -person_str_updater getter f x = - Person (f (getter x)) - - -type alias Car = - { brand : String - , model : String - , age : Int - } - - type Msg a = IntMsg (Int -> Int) | StringMsg (String -> String) @@ -214,14 +198,6 @@ substruct = attribute -carUpdater2 : Updater Car a -carUpdater2 = - entity Car - |> attribute "brand" .brand string - |> reference "model" .model string - |> attribute "age" .age int - - -- first = (updateWith ) -- carUpdater : Msg -> Car -> Car diff --git a/src/Type/IO/Viewer.elm b/src/Type/IO/Viewer.elm index f3c12b2..f7086a4 100644 --- a/src/Type/IO/Viewer.elm +++ b/src/Type/IO/Viewer.elm @@ -1,4 +1,4 @@ -module Type.IO.Viewer exposing (Basic, Viewer, array, attribute, basic, bool, dict, entity, float, int, list, maybe, reference, references, result, string, substruct) +module Type.IO.Viewer exposing (Basic, Viewer, array, attribute, bool, dict, entity, float, int, list, maybe, reference, references, result, string, substruct) import Array exposing (Array) import Dict exposing (Dict) @@ -59,7 +59,7 @@ dict keys values db full = ( Just k1, Just v1 ) -> Just ( k1, v1 ) - ( _, _ ) -> + _ -> Nothing ) |> Maybe.Extra.combine @@ -110,7 +110,7 @@ reference keygetter dictgetter foreigngetter post parent db full = f argument |> Just - ( _, _ ) -> + _ -> Nothing ) @@ -142,5 +142,5 @@ substruct getter struct old = ( Just f, Just v ) -> Just (f v) - ( _, _ ) -> + _ -> Nothing diff --git a/src/Type/LocalStorage.elm b/src/Type/LocalStorage.elm index fe83a5b..5f1be74 100644 --- a/src/Type/LocalStorage.elm +++ b/src/Type/LocalStorage.elm @@ -1,4 +1,4 @@ -module Type.LocalStorage exposing (LocalStorage, decode, encode) +module Type.LocalStorage exposing (LocalStorage) import Json.Decode import Json.Decode.Pipeline diff --git a/src/Type/Timestamp.elm b/src/Type/Timestamp.elm index e6e0525..088597c 100644 --- a/src/Type/Timestamp.elm +++ b/src/Type/Timestamp.elm @@ -1,9 +1,5 @@ module Type.Timestamp exposing (Msg(..), Timestamp) -import Fuzz -import Json.Decode as Decode -import Json.Decode.Pipeline exposing (required) -import Json.Encode as Encode exposing (Value) import Time import Type.IO exposing (IO, attribute, entity, int, substruct) @@ -44,7 +40,5 @@ timestamp other = type Msg - = All Time.Posix - | Created Time.Posix + = Created Time.Posix | Modified Time.Posix - | Accessed Time.Posix diff --git a/src/Utils.elm b/src/Utils.elm index bb73402..100d8d3 100644 --- a/src/Utils.elm +++ b/src/Utils.elm @@ -1,11 +1,4 @@ -module Utils exposing (genericTitle, logo, viewLink) - -import Html exposing (Html, a, li, text) -import Html.Attributes exposing (href) -import Svg -import Svg.Attributes as SA - - +module Utils exposing (genericTitle) {- Miscellaneous functions and helpers @@ -18,28 +11,5 @@ genericTitle = " - Elm SPA Boilerplate" -viewLink : String -> Html msg -viewLink path = - li [] [ a [ href path ] [ text path ] ] - - -- Elm Logo - - -logo : Int -> Html msg -logo size = - Svg.svg [ SA.height (String.fromInt size ++ "px"), SA.viewBox "0 0 600 600" ] - [ shape "#5A6378" "0,20 280,300 0,580" - , shape "#60B5CC" "20,600 300,320 580,600" - , shape "#60B5CC" "320,0 600,0 600,280" - , shape "#7FD13B" "20,0 280,0 402,122 142,122" - , shape "#F0AD00" "170,150 430,150 300,280" - , shape "#7FD13B" "320,300 450,170 580,300 450,430" - , shape "#F0AD00" "470,450 600,320 600,580" - ] - - -shape : String -> String -> Svg.Svg msg -shape color coordinates = - Svg.polygon [ SA.fill color, SA.points coordinates ] [] diff --git a/src/Viewer.elm b/src/Viewer.elm index 531e87f..01fb898 100644 --- a/src/Viewer.elm +++ b/src/Viewer.elm @@ -1,4 +1,4 @@ -module Viewer exposing (Details, Header, detailsConfig, header, notFound, system, textForm, update, view, wideTextForm) +module Viewer exposing (Details, Header, detailsConfig, header, notFound, system, textForm, update, view) --import Url.Builder @@ -7,24 +7,17 @@ import DateFormat.Relative exposing (relativeTime) import Device import Dict import DnDList -import Html exposing (Html, a, div, h1, h3, p, text) +import Html exposing (Html, a, div, h1, h3) import Html.Attributes exposing (class, href, style) import Identicon exposing (identicon) -import Material.Button as Button exposing (text, unelevated) -import Material.Dialog as Dialog exposing (config, simple) -import Material.Drawer.Dismissible exposing (config, header) +import Material.Button as Button +import Material.Dialog as Dialog import Material.Icon as Icon exposing (icon) -import Material.IconButton as IconButton exposing (config, customIcon, iconButton) -import Material.LayoutGrid as LayoutGrid exposing (cell) -import Material.List as MList exposing (config, list) -import Material.List.Divider as MLDivider exposing (config, listItem) -import Material.List.Item as MLItem exposing (config, graphic, listItem, text) +import Material.List as MList exposing (list) +import Material.List.Divider as MLDivider +import Material.List.Item as MLItem import Material.Snackbar as Snackbar -import Material.TextField as TextField exposing (config) -import Material.TextField.Icon as TextFieldIcon -import Material.Theme as Theme -import Material.TopAppBar as TopAppBar exposing (config, regular) -import Material.Typography as Typography +import Material.TextField as TextField import Msg exposing (ViewerMsg(..)) import Session import Time exposing (Posix) @@ -291,73 +284,8 @@ viewDrawerContent selectedIndex = ] -viewHeader2 : Header -> Details Msg.Msg -> Html Msg.Msg -viewHeader2 config details = - regular - (TopAppBar.config - |> TopAppBar.setFixed True - ) - [ TopAppBar.row [] - [ TopAppBar.section [ TopAppBar.alignStart ] - [ iconButton - (IconButton.config - |> IconButton.setAttributes [ TopAppBar.navigationIcon ] - |> IconButton.setOnClick (toggleDrawer config.drawerOpen) - ) - <| - IconButton.icon "menu" - , Html.span - [ TopAppBar.title - - --, Html.Attributes.style "text-transform" "uppercase" - --, Html.Attributes.style "font-weight" "400" - --, Typography.headline5 - ] - [ Html.text details.title ] - ] - , TopAppBar.section [ TopAppBar.alignEnd ] - [ case details.search of - Nothing -> - div [] [] - - Just s -> - TextField.filled - (TextField.config - |> TextField.setTrailingIcon (Just <| TextFieldIcon.icon "search") - |> TextField.setValue (Just s) - |> TextField.setAttributes [ Theme.surface ] - |> TextField.setOnInput Msg.Search - ) - , case details.user of - Nothing -> - div [] [] - - Just s -> - IconButton.iconButton - (IconButton.config |> IconButton.setAttributes [ TopAppBar.actionItem ]) - <| - IconButton.customIcon Html.i - [] - [ identicon "100%" (unbox s) ] - ] - ] - ] - - -- FOOTER - - -viewFooter : Html msg -viewFooter = - div [ class "footer", class "container" ] - [ Html.text "A simple, no-frills boilerplate for creating delightful Single Page Applications (SPAs) in Elm." - , a [ href "https://github.com/jzxhuang/elm-spa-boilerplate" ] [ Html.text "Check it out on Github!" ] - , Html.text "© 2018 - present Jeffrey Huang." - ] - - - -- 404 PAGE (NotFound) @@ -438,72 +366,6 @@ header = -- viewLogo = -- a [ href "/", style "text-decoration" "none" ] [ Utils.logo 32 ] -- STYLING HELPERS (lazy, hard-coded styling) - - -headerHeight : Int -headerHeight = - 60 - - -footerHeight : Int -footerHeight = - 60 - - -catalogPageContainer : List (Html.Attribute msg) -catalogPageContainer = - [ Html.Attributes.style "position" "relative" - , Typography.typography - ] - - -demoPanel : List (Html.Attribute msg) -demoPanel = - [ Html.Attributes.style "display" "-ms-flexbox" - , Html.Attributes.style "display" "flex" - , Html.Attributes.style "position" "relative" - , Html.Attributes.style "height" "100vh" - , Html.Attributes.style "overflow" "hidden" - ] - - -demoContent : List (Html.Attribute msg) -demoContent = - [ Html.Attributes.id "demo-content" - , Html.Attributes.style "height" "100%" - , Html.Attributes.style "-webkit-box-sizing" "border-box" - , Html.Attributes.style "box-sizing" "border-box" - , Html.Attributes.style "max-width" "100%" - , Html.Attributes.style "padding-left" "16px" - , Html.Attributes.style "padding-right" "16px" - , Html.Attributes.style "padding-bottom" "100px" - , Html.Attributes.style "width" "100%" - , Html.Attributes.style "overflow" "auto" - , Html.Attributes.style "display" "-ms-flexbox" - , Html.Attributes.style "display" "flex" - , Html.Attributes.style "-ms-flex-direction" "column" - , Html.Attributes.style "flex-direction" "column" - , Html.Attributes.style "-ms-flex-align" "center" - , Html.Attributes.style "align-items" "center" - , Html.Attributes.style "-ms-flex-pack" "start" - , Html.Attributes.style "justify-content" "flex-start" - ] - - -demoContentTransition : List (Html.Attribute msg) -demoContentTransition = - [ Html.Attributes.style "max-width" "900px" - , Html.Attributes.style "width" "100%" - ] - - -demoTitle : List (Html.Attribute msg) -demoTitle = - [ Html.Attributes.style "border-bottom" "1px solid rgba(0,0,0,.87)" - ] - - - -- -- FORM FUNCTORS -- @@ -520,58 +382,6 @@ textForm label value callback = ) -wideTextForm : Maybe String -> Form.FormFunctor msg -wideTextForm label value callback = - TextField.filled - (TextField.config - |> TextField.setValue (Just value) - |> TextField.setOnInput callback - |> TextField.setLabel label - --|> TextField.outlined True TODO: Uncomment - --|> TextField.setFullwidth True - ) - - -selectUser : List String -> List (Html Msg.Msg) -selectUser users = - if List.length users > 0 then - if List.length users == 1 then - [ List.head users - |> Maybe.withDefault "" - |> (\x -> LayoutGrid.cell [] [ Html.text <| "i have a user: " ++ x ]) - ] - - else - [ Html.h2 [ Typography.headline6 ] [ Html.text "Please choose your account:" ] - , LayoutGrid.cell [] <| - let - sList : List (MLItem.ListItem Msg.Msg) - sList = - List.map (\user -> MLItem.listItem (MLItem.config |> MLItem.setOnClick (Msg.SetUser (box user))) [ MLItem.graphic [] [ identicon "100%" user ], Html.text user ]) users - in - case sList of - fir :: res -> - [ MList.list MList.config - fir - res - ] - - _ -> - [] - ] - - else - [ LayoutGrid.cell [] - [ p [] - [ Html.text "Looks like this is the first time you're using msquaredc!" - ] - , Button.text - (Button.config |> Button.setOnClick (Msg.CRUD (Msg.CreateRandom Db.UserType []))) - "Let's go!" - ] - ] - - userDialog : Bool -> List ( String, Db.User ) -> String -> Maybe Posix -> Html Msg.Msg userDialog open users new_username time = let @@ -594,7 +404,7 @@ userDialog open users new_username time = uList : List (MLItem.ListItem Msg.Msg) uList = List.indexedMap - (\index ( id, user ) -> + (\_ ( id, user ) -> MLItem.listItem (MLItem.config |> MLItem.setOnClick (Msg.SetUser id) diff --git a/src/Viewer/Desktop.elm b/src/Viewer/Desktop.elm index b960ad5..bde492c 100644 --- a/src/Viewer/Desktop.elm +++ b/src/Viewer/Desktop.elm @@ -2,8 +2,8 @@ module Viewer.Desktop exposing (viewLandscape, viewPortrait) import Html exposing (Html, div, text) import Html.Attributes exposing (style) -import Material.Drawer.Permanent as Drawer exposing (config, drawer) -import Material.TopAppBar as TopAppBar exposing (config, prominent) +import Material.Drawer.Permanent as Drawer +import Material.TopAppBar as TopAppBar exposing (prominent) import Viewer.Internal as I diff --git a/src/Viewer/EditableText.elm b/src/Viewer/EditableText.elm index da05355..b474b28 100644 --- a/src/Viewer/EditableText.elm +++ b/src/Viewer/EditableText.elm @@ -3,7 +3,6 @@ module Viewer.EditableText exposing (Config, text) import Html exposing (Attribute, Html, div) import Html.Events exposing (onBlur, onClick) import Material.TextField as TextField -import Msg exposing (EditableTextMsg) type alias Config msg = diff --git a/src/Viewer/Handset.elm b/src/Viewer/Handset.elm index c671cfa..442d6bd 100644 --- a/src/Viewer/Handset.elm +++ b/src/Viewer/Handset.elm @@ -1,12 +1,10 @@ module Viewer.Handset exposing (viewLandscape, viewPortrait) import Html exposing (Html, div, text) -import Html.Attributes exposing (style) -import Material.Drawer.Modal as Drawer exposing (config, scrim) -import Material.List as MList exposing (config) -import Material.List.Item as MLItem exposing (config) -import Material.TopAppBar as TopAppBar exposing (config, short) -import Material.Typography as Typography +import Material.Drawer.Modal as Drawer exposing (scrim) +import Material.List as MList +import Material.List.Item as MLItem +import Material.TopAppBar as TopAppBar import Viewer.Internal as I diff --git a/src/Viewer/Internal.elm b/src/Viewer/Internal.elm index 39ddf47..6de5fe0 100644 --- a/src/Viewer/Internal.elm +++ b/src/Viewer/Internal.elm @@ -1,20 +1,18 @@ -module Viewer.Internal exposing (CardConfig, DrawerConfig, NavButtonConfig, SearchConfig, TopAppBarConfig, ViewerConfig, defaultCardConfig, navButton, viewCard, viewDrawer, viewTopAppBar) +module Viewer.Internal exposing (CardConfig, DrawerConfig, NavButtonConfig, SearchConfig, TopAppBarConfig, ViewerConfig, defaultCardConfig, viewCard, viewDrawer, viewTopAppBar) import Html exposing (Html, div, text) import Html.Attributes import Html.Events import Identicon exposing (identicon) -import Material.Button as Button exposing (config) -import Material.Card as Card exposing (config, primaryAction) +import Material.Button as Button +import Material.Card as Card import Material.Drawer.Modal as Drawer -import Material.Icon as Icon exposing (icon) -import Material.IconButton as IconButton exposing (config, customIcon, iconButton) -import Material.TextField as TextField exposing (config) +import Material.IconButton as IconButton +import Material.TextField as TextField import Material.TextField.Icon as TextFieldIcon import Material.Theme as Theme -import Material.TopAppBar as TopAppBar exposing (config) +import Material.TopAppBar as TopAppBar import Material.Typography as Typography -import Time exposing (Posix) diff --git a/src/Viewer/OrderAwareList.elm b/src/Viewer/OrderAwareList.elm index e8ce5c3..6507571 100644 --- a/src/Viewer/OrderAwareList.elm +++ b/src/Viewer/OrderAwareList.elm @@ -1,4 +1,4 @@ -module Viewer.OrderAwareList exposing (OrderAware, orderAwareList, prePost) +module Viewer.OrderAwareList exposing (OrderAware, orderAwareList) import Type.IO.Internal exposing (Id) diff --git a/tests/AquisitionTest.elm b/tests/AquisitionTest.elm index c403abd..20dd566 100644 --- a/tests/AquisitionTest.elm +++ b/tests/AquisitionTest.elm @@ -1,11 +1,10 @@ -module AquisitionTest exposing (aquireQuestion, suite) +module AquisitionTest exposing (suite) -import Dict exposing (Dict) +import Dict import Expect import Test exposing (..) import Type.Database exposing (..) -import Type.Database.Aquisition as Aq exposing (..) -import Type.Database.TypeMatching as Match +import Type.Database.Aquisition exposing (..) import Type.IO exposing (..) import Type.IO.Internal exposing (Id, box, unbox) From ff12b56d63aa891f69674487aa24ed4caa476c8f Mon Sep 17 00:00:00 2001 From: Jerome Bergmann Date: Mon, 11 Apr 2022 21:13:23 +0200 Subject: [PATCH 05/15] elm-review elm-review is now a dev dep --- package-lock.json | 2232 +++++++++++++++++++++++++++++++++++++++++++-- package.json | 3 +- 2 files changed, 2149 insertions(+), 86 deletions(-) diff --git a/package-lock.json b/package-lock.json index 9b872de..11a6b9f 100644 --- a/package-lock.json +++ b/package-lock.json @@ -17,7 +17,8 @@ "devDependencies": { "coveralls": "^3.1.1", "create-elm-app": "^5.22.0", - "elm-coverage": "^0.4.1" + "elm-coverage": "^0.4.1", + "elm-review": "^2.7.1" } }, "node_modules/@babel/cli": { @@ -1865,6 +1866,42 @@ "node": ">= 6" } }, + "node_modules/@sindresorhus/is": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/@sindresorhus/is/-/is-2.1.1.tgz", + "integrity": "sha512-/aPsuoj/1Dw/kzhkgz+ES6TxG0zfTMGLwuK2ZG00k/iJzYHTLCE8mVU8EPqEOp/lmxPoq1C1C9RYToRKb2KEfg==", + "dev": true, + "engines": { + "node": ">=10" + }, + "funding": { + "url": "https://github.com/sindresorhus/is?sponsor=1" + } + }, + "node_modules/@szmarczak/http-timer": { + "version": "4.0.6", + "resolved": "https://registry.npmjs.org/@szmarczak/http-timer/-/http-timer-4.0.6.tgz", + "integrity": "sha512-4BAffykYOgO+5nzBWYwE3W90sBgLJoUPRWWcL8wlyiM8IB8ipJz3UMJ9KXQd1RKQXpKp8Tutn80HZtWsu2u76w==", + "dev": true, + "dependencies": { + "defer-to-connect": "^2.0.0" + }, + "engines": { + "node": ">=10" + } + }, + "node_modules/@types/cacheable-request": { + "version": "6.0.2", + "resolved": "https://registry.npmjs.org/@types/cacheable-request/-/cacheable-request-6.0.2.tgz", + "integrity": "sha512-B3xVo+dlKM6nnKTcmm5ZtY/OL8bOAOd2Olee9M1zft65ox50OzjEHW91sDiU9j6cvW8Ejg1/Qkf4xd2kugApUA==", + "dev": true, + "dependencies": { + "@types/http-cache-semantics": "*", + "@types/keyv": "*", + "@types/node": "*", + "@types/responselike": "*" + } + }, "node_modules/@types/color-name": { "version": "1.1.1", "resolved": "https://registry.npmjs.org/@types/color-name/-/color-name-1.1.1.tgz", @@ -1887,6 +1924,12 @@ "integrity": "sha512-h4lTMgMJctJybDp8CQrxTUiiYmedihHWkjnF/8Pxseu2S6Nlfcy8kwboQ8yejh456rP2yWoEVm1sS/FVsfM48w==", "dev": true }, + "node_modules/@types/http-cache-semantics": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/@types/http-cache-semantics/-/http-cache-semantics-4.0.1.tgz", + "integrity": "sha512-SZs7ekbP8CN0txVG2xVRH6EgKmEm31BOxA07vkFaETzZz1xh+cbt8BcI0slpymvwhx5dlFnQG2rTlPVQn+iRPQ==", + "dev": true + }, "node_modules/@types/http-proxy": { "version": "1.17.4", "resolved": "https://registry.npmjs.org/@types/http-proxy/-/http-proxy-1.17.4.tgz", @@ -1896,12 +1939,27 @@ "@types/node": "*" } }, + "node_modules/@types/json-buffer": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/@types/json-buffer/-/json-buffer-3.0.0.tgz", + "integrity": "sha512-3YP80IxxFJB4b5tYC2SUPwkg0XQLiu0nWvhRgEatgjf+29IcWO9X1k8xRv5DGssJ/lCrjYTjQPcobJr2yWIVuQ==", + "dev": true + }, "node_modules/@types/json-schema": { "version": "7.0.11", "resolved": "https://registry.npmjs.org/@types/json-schema/-/json-schema-7.0.11.tgz", "integrity": "sha512-wOuvG1SN4Us4rez+tylwwwCV1psiNVOkJeM3AUWUNWg/jDQY2+HE/444y5gc+jBmRqASOm2Oeh5c1axHobwRKQ==", "dev": true }, + "node_modules/@types/keyv": { + "version": "3.1.4", + "resolved": "https://registry.npmjs.org/@types/keyv/-/keyv-3.1.4.tgz", + "integrity": "sha512-BQ5aZNSCpj7D6K2ksrRCTmKRLEpnPvWDiLPfoGyhZ++8YtiK9d/3DBKPJgry359X/P1PfruyYwvnvwFjuEiEIg==", + "dev": true, + "dependencies": { + "@types/node": "*" + } + }, "node_modules/@types/minimatch": { "version": "3.0.3", "resolved": "https://registry.npmjs.org/@types/minimatch/-/minimatch-3.0.3.tgz", @@ -1926,6 +1984,15 @@ "integrity": "sha512-1HcDas8SEj4z1Wc696tH56G8OlRaH/sqZOynNNB+HF0WOeXPaxTtbYzJY2oEfiUxjSKjhCKr+MvR7dCHcEelug==", "dev": true }, + "node_modules/@types/responselike": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/@types/responselike/-/responselike-1.0.0.tgz", + "integrity": "sha512-85Y2BjiufFzaMIlvJDvTTB8Fxl2xfLo4HgmHzVBz08w4wDePCTjYw66PdrolO0kzli3yam/YCgRufyo1DdQVTA==", + "dev": true, + "dependencies": { + "@types/node": "*" + } + }, "node_modules/@types/source-list-map": { "version": "0.1.2", "resolved": "https://registry.npmjs.org/@types/source-list-map/-/source-list-map-0.1.2.tgz", @@ -2557,6 +2624,15 @@ "resolved": "https://registry.npmjs.org/asynckit/-/asynckit-0.4.0.tgz", "integrity": "sha1-x57Zf380y48robyXkLzDZkdLS3k=" }, + "node_modules/at-least-node": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/at-least-node/-/at-least-node-1.0.0.tgz", + "integrity": "sha512-+q/t7Ekv1EDY2l6Gda6LLiX14rU9TV20Wa3ofeQmwPFZbOMo9DXrLbOjFaaclkXKWidIaopwAObQDqwWtGUjqg==", + "dev": true, + "engines": { + "node": ">= 4.0.0" + } + }, "node_modules/atob": { "version": "2.1.2", "resolved": "https://registry.npmjs.org/atob/-/atob-2.1.2.tgz", @@ -2976,6 +3052,55 @@ "binwrap-test": "bin/binwrap-test" } }, + "node_modules/bl": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/bl/-/bl-4.1.0.tgz", + "integrity": "sha512-1W07cM9gS6DcLperZfFSj+bWLtaPGSOHWhPiGzXmvVJbRLdG82sH/Kn8EtW1VqWVA54AKf2h5k5BbnIbwF3h6w==", + "dev": true, + "dependencies": { + "buffer": "^5.5.0", + "inherits": "^2.0.4", + "readable-stream": "^3.4.0" + } + }, + "node_modules/bl/node_modules/buffer": { + "version": "5.7.1", + "resolved": "https://registry.npmjs.org/buffer/-/buffer-5.7.1.tgz", + "integrity": "sha512-EHcyIPBQ4BSGlvjB16k5KgAJ27CIsHY/2JBmCRReo48y9rQ3MaUzWX3KVlBa4U7MyX02HdVj0K7C3WaB3ju7FQ==", + "dev": true, + "funding": [ + { + "type": "github", + "url": "https://github.com/sponsors/feross" + }, + { + "type": "patreon", + "url": "https://www.patreon.com/feross" + }, + { + "type": "consulting", + "url": "https://feross.org/support" + } + ], + "dependencies": { + "base64-js": "^1.3.1", + "ieee754": "^1.1.13" + } + }, + "node_modules/bl/node_modules/readable-stream": { + "version": "3.6.0", + "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-3.6.0.tgz", + "integrity": "sha512-BViHy7LKeTz4oNnkcLJ+lVSL6vpiFeX6/d3oSH8zCW7UxP2onchk+vTGB143xuFjHS3deTgkKoXXymXqymiIdA==", + "dev": true, + "dependencies": { + "inherits": "^2.0.3", + "string_decoder": "^1.1.1", + "util-deprecate": "^1.0.1" + }, + "engines": { + "node": ">= 6" + } + }, "node_modules/bluebird": { "version": "3.7.2", "resolved": "https://registry.npmjs.org/bluebird/-/bluebird-3.7.2.tgz", @@ -3335,6 +3460,64 @@ "node": ">=0.10.0" } }, + "node_modules/cacheable-lookup": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/cacheable-lookup/-/cacheable-lookup-2.0.1.tgz", + "integrity": "sha512-EMMbsiOTcdngM/K6gV/OxF2x0t07+vMOWxZNSCRQMjO2MY2nhZQ6OYhOOpyQrbhqsgtvKGI7hcq6xjnA92USjg==", + "dev": true, + "dependencies": { + "@types/keyv": "^3.1.1", + "keyv": "^4.0.0" + }, + "engines": { + "node": ">=10" + } + }, + "node_modules/cacheable-request": { + "version": "7.0.2", + "resolved": "https://registry.npmjs.org/cacheable-request/-/cacheable-request-7.0.2.tgz", + "integrity": "sha512-pouW8/FmiPQbuGpkXQ9BAPv/Mo5xDGANgSNXzTzJ8DrKGuXOssM4wIQRjfanNRh3Yu5cfYPvcorqbhg2KIJtew==", + "dev": true, + "dependencies": { + "clone-response": "^1.0.2", + "get-stream": "^5.1.0", + "http-cache-semantics": "^4.0.0", + "keyv": "^4.0.0", + "lowercase-keys": "^2.0.0", + "normalize-url": "^6.0.1", + "responselike": "^2.0.0" + }, + "engines": { + "node": ">=8" + } + }, + "node_modules/cacheable-request/node_modules/get-stream": { + "version": "5.2.0", + "resolved": "https://registry.npmjs.org/get-stream/-/get-stream-5.2.0.tgz", + "integrity": "sha512-nBF+F1rAZVCu/p7rjzgA+Yb4lfYXrpl7a6VmJrU8wF9I1CKvP/QwPNZHnOlwbTkY6dvtFIzFMSyQXbLoTQPRpA==", + "dev": true, + "dependencies": { + "pump": "^3.0.0" + }, + "engines": { + "node": ">=8" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, + "node_modules/cacheable-request/node_modules/normalize-url": { + "version": "6.1.0", + "resolved": "https://registry.npmjs.org/normalize-url/-/normalize-url-6.1.0.tgz", + "integrity": "sha512-DlL+XwOy3NxAQ8xuC0okPgK46iuVNAK01YN7RueYBqqFeGsBjV9XmCAzAdgt+667bCl5kPh9EqKKDwnaPG1I7A==", + "dev": true, + "engines": { + "node": ">=10" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, "node_modules/call-me-maybe": { "version": "1.0.1", "resolved": "https://registry.npmjs.org/call-me-maybe/-/call-me-maybe-1.0.1.tgz", @@ -3577,6 +3760,18 @@ "node": ">=4" } }, + "node_modules/cli-spinners": { + "version": "2.6.1", + "resolved": "https://registry.npmjs.org/cli-spinners/-/cli-spinners-2.6.1.tgz", + "integrity": "sha512-x/5fWmGMnbKQAaNwN+UZlV79qBLM9JFnJuJ03gIi5whrob0xV0ofNVHy9DhwGdsMJQc2OKv0oGmLzvaqvAVv+g==", + "dev": true, + "engines": { + "node": ">=6" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, "node_modules/cli-table": { "version": "0.3.4", "resolved": "https://registry.npmjs.org/cli-table/-/cli-table-0.3.4.tgz", @@ -3645,6 +3840,33 @@ "node": ">=0.10.0" } }, + "node_modules/clone": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/clone/-/clone-1.0.4.tgz", + "integrity": "sha1-2jCcwmPfFZlMaIypAheco8fNfH4=", + "dev": true, + "engines": { + "node": ">=0.8" + } + }, + "node_modules/clone-response": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/clone-response/-/clone-response-1.0.2.tgz", + "integrity": "sha1-0dyXOSAxTfZ/vrlCI7TuNQI56Ws=", + "dev": true, + "dependencies": { + "mimic-response": "^1.0.0" + } + }, + "node_modules/clone-response/node_modules/mimic-response": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/mimic-response/-/mimic-response-1.0.1.tgz", + "integrity": "sha512-j5EctnkH7amfV/q5Hgmoal1g2QHFJRraOtmx0JpIqkxhBhI/lJSl1nMpQ45hVarwNETOoWEimndZ4QK0RHxuxQ==", + "dev": true, + "engines": { + "node": ">=4" + } + }, "node_modules/coa": { "version": "2.0.2", "resolved": "https://registry.npmjs.org/coa/-/coa-2.0.2.tgz", @@ -3767,6 +3989,19 @@ "resolved": "https://registry.npmjs.org/component-emitter/-/component-emitter-1.3.0.tgz", "integrity": "sha512-Rd3se6QB+sO1TwqZjscQrurpEPIfO0/yYnSin6Q/rD3mOutHvUrCAhJub3r90uNb+SESBuE0QYoB90YdfatsRg==" }, + "node_modules/compress-brotli": { + "version": "1.3.6", + "resolved": "https://registry.npmjs.org/compress-brotli/-/compress-brotli-1.3.6.tgz", + "integrity": "sha512-au99/GqZtUtiCBliqLFbWlhnCxn+XSYjwZ77q6mKN4La4qOXDoLVPZ50iXr0WmAyMxl8yqoq3Yq4OeQNPPkyeQ==", + "dev": true, + "dependencies": { + "@types/json-buffer": "~3.0.0", + "json-buffer": "~3.0.1" + }, + "engines": { + "node": ">= 12" + } + }, "node_modules/compressible": { "version": "2.0.18", "resolved": "https://registry.npmjs.org/compressible/-/compressible-2.0.18.tgz", @@ -4990,6 +5225,18 @@ "node": ">=0.10" } }, + "node_modules/decompress-response": { + "version": "5.0.0", + "resolved": "https://registry.npmjs.org/decompress-response/-/decompress-response-5.0.0.tgz", + "integrity": "sha512-TLZWWybuxWgoW7Lykv+gq9xvzOsUjQ9tF09Tj6NSTYGMTCHNXzrPnD6Hi+TgZq19PyTAGH4Ll/NIM/eTGglnMw==", + "dev": true, + "dependencies": { + "mimic-response": "^2.0.0" + }, + "engines": { + "node": ">=10" + } + }, "node_modules/deep-equal": { "version": "0.2.2", "resolved": "https://registry.npmjs.org/deep-equal/-/deep-equal-0.2.2.tgz", @@ -5009,6 +5256,24 @@ "node": ">=6" } }, + "node_modules/defaults": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/defaults/-/defaults-1.0.3.tgz", + "integrity": "sha1-xlYFHpgX2f8I7YgUd/P+QBnz730=", + "dev": true, + "dependencies": { + "clone": "^1.0.2" + } + }, + "node_modules/defer-to-connect": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/defer-to-connect/-/defer-to-connect-2.0.1.tgz", + "integrity": "sha512-4tvttepXG1VaYGrRibk5EwJd1t4udunSOVMdLSAL6mId1ix438oPwPZMALY41FCijukO1L0twNcGsdzS7dHgDg==", + "dev": true, + "engines": { + "node": ">=10" + } + }, "node_modules/define-properties": { "version": "1.1.3", "resolved": "https://registry.npmjs.org/define-properties/-/define-properties-1.1.3.tgz", @@ -5368,6 +5633,12 @@ "integrity": "sha512-jtD6YG370ZCIi/9GTaJKQxWTZD045+4R4hTk/x1UyoqadyJ9x9CgSi1RlVDQF8U2sxLLSnFkCaMihqljHIWgMg==", "dev": true }, + "node_modules/duplexer3": { + "version": "0.1.4", + "resolved": "https://registry.npmjs.org/duplexer3/-/duplexer3-0.1.4.tgz", + "integrity": "sha1-7gHdHKwO08vH/b6jfcCo8c4ALOI=", + "dev": true + }, "node_modules/duplexify": { "version": "3.7.1", "resolved": "https://registry.npmjs.org/duplexify/-/duplexify-3.7.1.tgz", @@ -5744,32 +6015,43 @@ "elm-json": "bin/elm-json" } }, - "node_modules/elm-test": { - "version": "0.19.1-revision7", - "resolved": "https://registry.npmjs.org/elm-test/-/elm-test-0.19.1-revision7.tgz", - "integrity": "sha512-sd3nCQMeYMaY84Sz41bVJ30ZvQN1/4ZcD8uYMOuUbM39FDh58NY9/AcImVJ7Z+gjCFdcSU6VscZzhUoPW8jp6Q==", + "node_modules/elm-review": { + "version": "2.7.1", + "resolved": "https://registry.npmjs.org/elm-review/-/elm-review-2.7.1.tgz", + "integrity": "sha512-leDgjvE6ldYSOG/jMLmMw2g1vRnrd9nH9mnQcJt57SY2F4FnZT2hfIbuIUBXPaBwhWwC0a6BRt+Jv/2sGOG03A==", "dev": true, "dependencies": { - "chalk": "^4.1.0", - "chokidar": "^3.5.1", - "commander": "^7.1.0", + "chalk": "^4.0.0", + "chokidar": "^3.5.2", "cross-spawn": "^7.0.3", - "elm-tooling": "^1.2.0", - "glob": "^7.1.6", - "graceful-fs": "^4.2.4", - "rimraf": "^3.0.2", - "split": "^1.0.1", + "elm-tooling": "^1.6.0", + "fast-levenshtein": "^3.0.0", + "find-up": "^4.1.0", + "folder-hash": "^3.3.0", + "fs-extra": "^9.0.0", + "glob": "^7.1.4", + "got": "^10.7.0", + "minimist": "^1.2.0", + "ora": "^5.4.0", + "path-key": "^3.1.1", + "prompts": "^2.2.1", + "strip-ansi": "^6.0.0", + "temp": "^0.9.1", + "terminal-link": "^2.1.1", "which": "^2.0.2", - "xmlbuilder": "^15.1.0" + "wrap-ansi": "^6.2.0" }, "bin": { - "elm-test": "bin/elm-test" + "elm-review": "bin/elm-review" }, "engines": { - "node": ">=10.13.0" + "node": ">=10.0.0" + }, + "funding": { + "url": "https://github.com/sponsors/jfmengels" } }, - "node_modules/elm-test/node_modules/ansi-styles": { + "node_modules/elm-review/node_modules/ansi-styles": { "version": "4.3.0", "resolved": "https://registry.npmjs.org/ansi-styles/-/ansi-styles-4.3.0.tgz", "integrity": "sha512-zbB9rCJAT1rbjiVDb2hqKFHNYLxgtk8NURxZ3IZwD3F6NtxbXZQCnnSi1Lkx+IDohdPlFp222wVALIheZJQSEg==", @@ -5784,7 +6066,7 @@ "url": "https://github.com/chalk/ansi-styles?sponsor=1" } }, - "node_modules/elm-test/node_modules/anymatch": { + "node_modules/elm-review/node_modules/anymatch": { "version": "3.1.2", "resolved": "https://registry.npmjs.org/anymatch/-/anymatch-3.1.2.tgz", "integrity": "sha512-P43ePfOAIupkguHUycrc4qJ9kz8ZiuOUijaETwX7THt0Y/GNK7v0aa8rY816xWjZ7rJdA5XdMcpVFTKMq+RvWg==", @@ -5797,7 +6079,7 @@ "node": ">= 8" } }, - "node_modules/elm-test/node_modules/binary-extensions": { + "node_modules/elm-review/node_modules/binary-extensions": { "version": "2.2.0", "resolved": "https://registry.npmjs.org/binary-extensions/-/binary-extensions-2.2.0.tgz", "integrity": "sha512-jDctJ/IVQbZoJykoeHbhXpOlNBqGNcwXJKJog42E5HDPUwQTSdjCHdihjj0DlnheQ7blbT6dHOafNAiS8ooQKA==", @@ -5806,7 +6088,7 @@ "node": ">=8" } }, - "node_modules/elm-test/node_modules/braces": { + "node_modules/elm-review/node_modules/braces": { "version": "3.0.2", "resolved": "https://registry.npmjs.org/braces/-/braces-3.0.2.tgz", "integrity": "sha512-b8um+L1RzM3WDSzvhm6gIz1yfTbBt6YTlcEKAvsmqCZZFw46z626lVj9j1yEPW33H5H+lBQpZMP1k8l+78Ha0A==", @@ -5818,7 +6100,7 @@ "node": ">=8" } }, - "node_modules/elm-test/node_modules/chalk": { + "node_modules/elm-review/node_modules/chalk": { "version": "4.1.2", "resolved": "https://registry.npmjs.org/chalk/-/chalk-4.1.2.tgz", "integrity": "sha512-oKnbhFyRIXpUuez8iBMmyEa4nbj4IOQyuhc/wy9kY7/WVPcwIO9VA668Pu8RkO7+0G76SLROeyw9CpQ061i4mA==", @@ -5834,7 +6116,7 @@ "url": "https://github.com/chalk/chalk?sponsor=1" } }, - "node_modules/elm-test/node_modules/chokidar": { + "node_modules/elm-review/node_modules/chokidar": { "version": "3.5.3", "resolved": "https://registry.npmjs.org/chokidar/-/chokidar-3.5.3.tgz", "integrity": "sha512-Dr3sfKRP6oTcjf2JmUmFJfeVMvXBdegxB0iVQ5eb2V10uFJUCAS8OByZdVAyVb8xXNz3GjjTgj9kLWsZTqE6kw==", @@ -5861,7 +6143,7 @@ "fsevents": "~2.3.2" } }, - "node_modules/elm-test/node_modules/color-convert": { + "node_modules/elm-review/node_modules/color-convert": { "version": "2.0.1", "resolved": "https://registry.npmjs.org/color-convert/-/color-convert-2.0.1.tgz", "integrity": "sha512-RRECPsj7iu/xb5oKYcsFHSppFNnsj/52OVTRKb4zP5onXwVF3zVmmToNcOfGC+CRDpfK/U584fMg38ZHCaElKQ==", @@ -5873,22 +6155,13 @@ "node": ">=7.0.0" } }, - "node_modules/elm-test/node_modules/color-name": { + "node_modules/elm-review/node_modules/color-name": { "version": "1.1.4", "resolved": "https://registry.npmjs.org/color-name/-/color-name-1.1.4.tgz", "integrity": "sha512-dOy+3AuW3a2wNbZHIuMZpTcgjGuLU/uBL/ubcZF9OXbDo8ff4O8yVp5Bf0efS8uEoYo5q4Fx7dY9OgQGXgAsQA==", "dev": true }, - "node_modules/elm-test/node_modules/commander": { - "version": "7.2.0", - "resolved": "https://registry.npmjs.org/commander/-/commander-7.2.0.tgz", - "integrity": "sha512-QrWXB+ZQSVPmIWIhtEO9H+gwHaMGYiF5ChvoJ+K9ZGHG/sVsa6yiesAD1GC/x46sET00Xlwo1u49RVVVzvcSkw==", - "dev": true, - "engines": { - "node": ">= 10" - } - }, - "node_modules/elm-test/node_modules/fill-range": { + "node_modules/elm-review/node_modules/fill-range": { "version": "7.0.1", "resolved": "https://registry.npmjs.org/fill-range/-/fill-range-7.0.1.tgz", "integrity": "sha512-qOo9F+dMUmC2Lcb4BbVvnKJxTPjCm+RRpe4gDuGrzkL7mEVl/djYSu2OdQ2Pa302N4oqkSg9ir6jaLWJ2USVpQ==", @@ -5900,7 +6173,35 @@ "node": ">=8" } }, - "node_modules/elm-test/node_modules/fsevents": { + "node_modules/elm-review/node_modules/find-up": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/find-up/-/find-up-4.1.0.tgz", + "integrity": "sha512-PpOwAdQ/YlXQ2vj8a3h8IipDuYRi3wceVQQGYWxNINccq40Anw7BlsEXCMbt1Zt+OLA6Fq9suIpIWD0OsnISlw==", + "dev": true, + "dependencies": { + "locate-path": "^5.0.0", + "path-exists": "^4.0.0" + }, + "engines": { + "node": ">=8" + } + }, + "node_modules/elm-review/node_modules/fs-extra": { + "version": "9.1.0", + "resolved": "https://registry.npmjs.org/fs-extra/-/fs-extra-9.1.0.tgz", + "integrity": "sha512-hcg3ZmepS30/7BSFqRvoo3DOMQu7IjqxO5nCDt+zM9XWjb33Wg7ziNT+Qvqbuc3+gWpzO02JubVyk2G4Zvo1OQ==", + "dev": true, + "dependencies": { + "at-least-node": "^1.0.0", + "graceful-fs": "^4.2.0", + "jsonfile": "^6.0.1", + "universalify": "^2.0.0" + }, + "engines": { + "node": ">=10" + } + }, + "node_modules/elm-review/node_modules/fsevents": { "version": "2.3.2", "resolved": "https://registry.npmjs.org/fsevents/-/fsevents-2.3.2.tgz", "integrity": "sha512-xiqMQR4xAeHTuB9uWm+fFRcIOgKBMiOBP+eXiyT7jsgVCq1bkVygt00oASowB7EdtpOHaaPgKt812P9ab+DDKA==", @@ -5914,7 +6215,7 @@ "node": "^8.16.0 || ^10.6.0 || >=11.0.0" } }, - "node_modules/elm-test/node_modules/glob-parent": { + "node_modules/elm-review/node_modules/glob-parent": { "version": "5.1.2", "resolved": "https://registry.npmjs.org/glob-parent/-/glob-parent-5.1.2.tgz", "integrity": "sha512-AOIgSQCepiJYwP3ARnGx+5VnTu2HBYdzbGP45eLw1vr3zB3vZLeyed1sC9hnbcOc9/SrMyM5RPQrkGz4aS9Zow==", @@ -5926,7 +6227,7 @@ "node": ">= 6" } }, - "node_modules/elm-test/node_modules/has-flag": { + "node_modules/elm-review/node_modules/has-flag": { "version": "4.0.0", "resolved": "https://registry.npmjs.org/has-flag/-/has-flag-4.0.0.tgz", "integrity": "sha512-EykJT/Q1KjTWctppgIAgfSO0tKVuZUjhgMr17kqTumMl6Afv3EISleU7qZUzoXDFTAHTDC4NOoG/ZxU3EvlMPQ==", @@ -5935,7 +6236,7 @@ "node": ">=8" } }, - "node_modules/elm-test/node_modules/is-binary-path": { + "node_modules/elm-review/node_modules/is-binary-path": { "version": "2.1.0", "resolved": "https://registry.npmjs.org/is-binary-path/-/is-binary-path-2.1.0.tgz", "integrity": "sha512-ZMERYes6pDydyuGidse7OsHxtbI7WVeUEozgR/g7rd0xUimYNlvZRE/K2MgZTjWy725IfelLeVcEM97mmtRGXw==", @@ -5947,7 +6248,7 @@ "node": ">=8" } }, - "node_modules/elm-test/node_modules/is-number": { + "node_modules/elm-review/node_modules/is-number": { "version": "7.0.0", "resolved": "https://registry.npmjs.org/is-number/-/is-number-7.0.0.tgz", "integrity": "sha512-41Cifkg6e8TylSpdtTpeLVMqvSBEVzTttHvERD741+pnZ8ANv0004MRL43QKPDlK9cGvNp6NZWZUBlbGXYxxng==", @@ -5956,27 +6257,343 @@ "node": ">=0.12.0" } }, - "node_modules/elm-test/node_modules/readdirp": { - "version": "3.6.0", - "resolved": "https://registry.npmjs.org/readdirp/-/readdirp-3.6.0.tgz", - "integrity": "sha512-hOS089on8RduqdbhvQ5Z37A0ESjsqz6qnRcffsMU3495FuTdqSm+7bhJ29JvIOsBDEEnan5DPu9t3To9VRlMzA==", + "node_modules/elm-review/node_modules/jsonfile": { + "version": "6.1.0", + "resolved": "https://registry.npmjs.org/jsonfile/-/jsonfile-6.1.0.tgz", + "integrity": "sha512-5dgndWOriYSm5cnYaJNhalLNDKOqFwyDB/rr1E9ZsGciGvKPs8R2xYGCacuf3z6K1YKDz182fd+fY3cn3pMqXQ==", "dev": true, "dependencies": { - "picomatch": "^2.2.1" + "universalify": "^2.0.0" }, - "engines": { - "node": ">=8.10.0" + "optionalDependencies": { + "graceful-fs": "^4.1.6" } }, - "node_modules/elm-test/node_modules/rimraf": { - "version": "3.0.2", - "resolved": "https://registry.npmjs.org/rimraf/-/rimraf-3.0.2.tgz", - "integrity": "sha512-JZkJMZkAGFFPP2YqXZXPbMlMBgsxzE8ILs4lMIX/2o0L9UBw9O/Y3o6wFw/i9YLapcUJWwqbi3kdxIPdC62TIA==", + "node_modules/elm-review/node_modules/locate-path": { + "version": "5.0.0", + "resolved": "https://registry.npmjs.org/locate-path/-/locate-path-5.0.0.tgz", + "integrity": "sha512-t7hw9pI+WvuwNJXwk5zVHpyhIqzg2qTlklJOf0mVxGSbe3Fp2VieZcduNYjaLDoy6p9uGpQEGWG87WpMKlNq8g==", "dev": true, "dependencies": { - "glob": "^7.1.3" + "p-locate": "^4.1.0" }, - "bin": { + "engines": { + "node": ">=8" + } + }, + "node_modules/elm-review/node_modules/p-locate": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/p-locate/-/p-locate-4.1.0.tgz", + "integrity": "sha512-R79ZZ/0wAxKGu3oYMlz8jy/kbhsNrS7SKZ7PxEHBgJ5+F2mtFW2fK2cOtBh1cHYkQsbzFV7I+EoRKe6Yt0oK7A==", + "dev": true, + "dependencies": { + "p-limit": "^2.2.0" + }, + "engines": { + "node": ">=8" + } + }, + "node_modules/elm-review/node_modules/path-exists": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/path-exists/-/path-exists-4.0.0.tgz", + "integrity": "sha512-ak9Qy5Q7jYb2Wwcey5Fpvg2KoAc/ZIhLSLOSBmRmygPsGwkVVt0fZa0qrtMz+m6tJTAHfZQ8FnmB4MG4LWy7/w==", + "dev": true, + "engines": { + "node": ">=8" + } + }, + "node_modules/elm-review/node_modules/readdirp": { + "version": "3.6.0", + "resolved": "https://registry.npmjs.org/readdirp/-/readdirp-3.6.0.tgz", + "integrity": "sha512-hOS089on8RduqdbhvQ5Z37A0ESjsqz6qnRcffsMU3495FuTdqSm+7bhJ29JvIOsBDEEnan5DPu9t3To9VRlMzA==", + "dev": true, + "dependencies": { + "picomatch": "^2.2.1" + }, + "engines": { + "node": ">=8.10.0" + } + }, + "node_modules/elm-review/node_modules/supports-color": { + "version": "7.2.0", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-7.2.0.tgz", + "integrity": "sha512-qpCAvRl9stuOHveKsn7HncJRvv501qIacKzQlO/+Lwxc9+0q2wLyv4Dfvt80/DPn2pqOBsJdDiogXGR9+OvwRw==", + "dev": true, + "dependencies": { + "has-flag": "^4.0.0" + }, + "engines": { + "node": ">=8" + } + }, + "node_modules/elm-review/node_modules/to-regex-range": { + "version": "5.0.1", + "resolved": "https://registry.npmjs.org/to-regex-range/-/to-regex-range-5.0.1.tgz", + "integrity": "sha512-65P7iz6X5yEr1cwcgvQxbbIw7Uk3gOy5dIdtZ4rDveLqhrdJP+Li/Hx6tyK0NEb+2GCyneCMJiGqrADCSNk8sQ==", + "dev": true, + "dependencies": { + "is-number": "^7.0.0" + }, + "engines": { + "node": ">=8.0" + } + }, + "node_modules/elm-review/node_modules/universalify": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/universalify/-/universalify-2.0.0.tgz", + "integrity": "sha512-hAZsKq7Yy11Zu1DE0OzWjw7nnLZmJZYTDZZyEFHZdUhV8FkH5MCfoU1XMaxXovpyW5nq5scPqq0ZDP9Zyl04oQ==", + "dev": true, + "engines": { + "node": ">= 10.0.0" + } + }, + "node_modules/elm-review/node_modules/wrap-ansi": { + "version": "6.2.0", + "resolved": "https://registry.npmjs.org/wrap-ansi/-/wrap-ansi-6.2.0.tgz", + "integrity": "sha512-r6lPcBGxZXlIcymEu7InxDMhdW0KDxpLgoFLcguasxCaJ/SOIZwINatK9KY/tf+ZrlywOKU0UDj3ATXUBfxJXA==", + "dev": true, + "dependencies": { + "ansi-styles": "^4.0.0", + "string-width": "^4.1.0", + "strip-ansi": "^6.0.0" + }, + "engines": { + "node": ">=8" + } + }, + "node_modules/elm-test": { + "version": "0.19.1-revision7", + "resolved": "https://registry.npmjs.org/elm-test/-/elm-test-0.19.1-revision7.tgz", + "integrity": "sha512-sd3nCQMeYMaY84Sz41bVJ30ZvQN1/4ZcD8uYMOuUbM39FDh58NY9/AcImVJ7Z+gjCFdcSU6VscZzhUoPW8jp6Q==", + "dev": true, + "dependencies": { + "chalk": "^4.1.0", + "chokidar": "^3.5.1", + "commander": "^7.1.0", + "cross-spawn": "^7.0.3", + "elm-tooling": "^1.2.0", + "glob": "^7.1.6", + "graceful-fs": "^4.2.4", + "rimraf": "^3.0.2", + "split": "^1.0.1", + "which": "^2.0.2", + "xmlbuilder": "^15.1.0" + }, + "bin": { + "elm-test": "bin/elm-test" + }, + "engines": { + "node": ">=10.13.0" + } + }, + "node_modules/elm-test/node_modules/ansi-styles": { + "version": "4.3.0", + "resolved": "https://registry.npmjs.org/ansi-styles/-/ansi-styles-4.3.0.tgz", + "integrity": "sha512-zbB9rCJAT1rbjiVDb2hqKFHNYLxgtk8NURxZ3IZwD3F6NtxbXZQCnnSi1Lkx+IDohdPlFp222wVALIheZJQSEg==", + "dev": true, + "dependencies": { + "color-convert": "^2.0.1" + }, + "engines": { + "node": ">=8" + }, + "funding": { + "url": "https://github.com/chalk/ansi-styles?sponsor=1" + } + }, + "node_modules/elm-test/node_modules/anymatch": { + "version": "3.1.2", + "resolved": "https://registry.npmjs.org/anymatch/-/anymatch-3.1.2.tgz", + "integrity": "sha512-P43ePfOAIupkguHUycrc4qJ9kz8ZiuOUijaETwX7THt0Y/GNK7v0aa8rY816xWjZ7rJdA5XdMcpVFTKMq+RvWg==", + "dev": true, + "dependencies": { + "normalize-path": "^3.0.0", + "picomatch": "^2.0.4" + }, + "engines": { + "node": ">= 8" + } + }, + "node_modules/elm-test/node_modules/binary-extensions": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/binary-extensions/-/binary-extensions-2.2.0.tgz", + "integrity": "sha512-jDctJ/IVQbZoJykoeHbhXpOlNBqGNcwXJKJog42E5HDPUwQTSdjCHdihjj0DlnheQ7blbT6dHOafNAiS8ooQKA==", + "dev": true, + "engines": { + "node": ">=8" + } + }, + "node_modules/elm-test/node_modules/braces": { + "version": "3.0.2", + "resolved": "https://registry.npmjs.org/braces/-/braces-3.0.2.tgz", + "integrity": "sha512-b8um+L1RzM3WDSzvhm6gIz1yfTbBt6YTlcEKAvsmqCZZFw46z626lVj9j1yEPW33H5H+lBQpZMP1k8l+78Ha0A==", + "dev": true, + "dependencies": { + "fill-range": "^7.0.1" + }, + "engines": { + "node": ">=8" + } + }, + "node_modules/elm-test/node_modules/chalk": { + "version": "4.1.2", + "resolved": "https://registry.npmjs.org/chalk/-/chalk-4.1.2.tgz", + "integrity": "sha512-oKnbhFyRIXpUuez8iBMmyEa4nbj4IOQyuhc/wy9kY7/WVPcwIO9VA668Pu8RkO7+0G76SLROeyw9CpQ061i4mA==", + "dev": true, + "dependencies": { + "ansi-styles": "^4.1.0", + "supports-color": "^7.1.0" + }, + "engines": { + "node": ">=10" + }, + "funding": { + "url": "https://github.com/chalk/chalk?sponsor=1" + } + }, + "node_modules/elm-test/node_modules/chokidar": { + "version": "3.5.3", + "resolved": "https://registry.npmjs.org/chokidar/-/chokidar-3.5.3.tgz", + "integrity": "sha512-Dr3sfKRP6oTcjf2JmUmFJfeVMvXBdegxB0iVQ5eb2V10uFJUCAS8OByZdVAyVb8xXNz3GjjTgj9kLWsZTqE6kw==", + "dev": true, + "funding": [ + { + "type": "individual", + "url": "https://paulmillr.com/funding/" + } + ], + "dependencies": { + "anymatch": "~3.1.2", + "braces": "~3.0.2", + "glob-parent": "~5.1.2", + "is-binary-path": "~2.1.0", + "is-glob": "~4.0.1", + "normalize-path": "~3.0.0", + "readdirp": "~3.6.0" + }, + "engines": { + "node": ">= 8.10.0" + }, + "optionalDependencies": { + "fsevents": "~2.3.2" + } + }, + "node_modules/elm-test/node_modules/color-convert": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/color-convert/-/color-convert-2.0.1.tgz", + "integrity": "sha512-RRECPsj7iu/xb5oKYcsFHSppFNnsj/52OVTRKb4zP5onXwVF3zVmmToNcOfGC+CRDpfK/U584fMg38ZHCaElKQ==", + "dev": true, + "dependencies": { + "color-name": "~1.1.4" + }, + "engines": { + "node": ">=7.0.0" + } + }, + "node_modules/elm-test/node_modules/color-name": { + "version": "1.1.4", + "resolved": "https://registry.npmjs.org/color-name/-/color-name-1.1.4.tgz", + "integrity": "sha512-dOy+3AuW3a2wNbZHIuMZpTcgjGuLU/uBL/ubcZF9OXbDo8ff4O8yVp5Bf0efS8uEoYo5q4Fx7dY9OgQGXgAsQA==", + "dev": true + }, + "node_modules/elm-test/node_modules/commander": { + "version": "7.2.0", + "resolved": "https://registry.npmjs.org/commander/-/commander-7.2.0.tgz", + "integrity": "sha512-QrWXB+ZQSVPmIWIhtEO9H+gwHaMGYiF5ChvoJ+K9ZGHG/sVsa6yiesAD1GC/x46sET00Xlwo1u49RVVVzvcSkw==", + "dev": true, + "engines": { + "node": ">= 10" + } + }, + "node_modules/elm-test/node_modules/fill-range": { + "version": "7.0.1", + "resolved": "https://registry.npmjs.org/fill-range/-/fill-range-7.0.1.tgz", + "integrity": "sha512-qOo9F+dMUmC2Lcb4BbVvnKJxTPjCm+RRpe4gDuGrzkL7mEVl/djYSu2OdQ2Pa302N4oqkSg9ir6jaLWJ2USVpQ==", + "dev": true, + "dependencies": { + "to-regex-range": "^5.0.1" + }, + "engines": { + "node": ">=8" + } + }, + "node_modules/elm-test/node_modules/fsevents": { + "version": "2.3.2", + "resolved": "https://registry.npmjs.org/fsevents/-/fsevents-2.3.2.tgz", + "integrity": "sha512-xiqMQR4xAeHTuB9uWm+fFRcIOgKBMiOBP+eXiyT7jsgVCq1bkVygt00oASowB7EdtpOHaaPgKt812P9ab+DDKA==", + "dev": true, + "hasInstallScript": true, + "optional": true, + "os": [ + "darwin" + ], + "engines": { + "node": "^8.16.0 || ^10.6.0 || >=11.0.0" + } + }, + "node_modules/elm-test/node_modules/glob-parent": { + "version": "5.1.2", + "resolved": "https://registry.npmjs.org/glob-parent/-/glob-parent-5.1.2.tgz", + "integrity": "sha512-AOIgSQCepiJYwP3ARnGx+5VnTu2HBYdzbGP45eLw1vr3zB3vZLeyed1sC9hnbcOc9/SrMyM5RPQrkGz4aS9Zow==", + "dev": true, + "dependencies": { + "is-glob": "^4.0.1" + }, + "engines": { + "node": ">= 6" + } + }, + "node_modules/elm-test/node_modules/has-flag": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/has-flag/-/has-flag-4.0.0.tgz", + "integrity": "sha512-EykJT/Q1KjTWctppgIAgfSO0tKVuZUjhgMr17kqTumMl6Afv3EISleU7qZUzoXDFTAHTDC4NOoG/ZxU3EvlMPQ==", + "dev": true, + "engines": { + "node": ">=8" + } + }, + "node_modules/elm-test/node_modules/is-binary-path": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/is-binary-path/-/is-binary-path-2.1.0.tgz", + "integrity": "sha512-ZMERYes6pDydyuGidse7OsHxtbI7WVeUEozgR/g7rd0xUimYNlvZRE/K2MgZTjWy725IfelLeVcEM97mmtRGXw==", + "dev": true, + "dependencies": { + "binary-extensions": "^2.0.0" + }, + "engines": { + "node": ">=8" + } + }, + "node_modules/elm-test/node_modules/is-number": { + "version": "7.0.0", + "resolved": "https://registry.npmjs.org/is-number/-/is-number-7.0.0.tgz", + "integrity": "sha512-41Cifkg6e8TylSpdtTpeLVMqvSBEVzTttHvERD741+pnZ8ANv0004MRL43QKPDlK9cGvNp6NZWZUBlbGXYxxng==", + "dev": true, + "engines": { + "node": ">=0.12.0" + } + }, + "node_modules/elm-test/node_modules/readdirp": { + "version": "3.6.0", + "resolved": "https://registry.npmjs.org/readdirp/-/readdirp-3.6.0.tgz", + "integrity": "sha512-hOS089on8RduqdbhvQ5Z37A0ESjsqz6qnRcffsMU3495FuTdqSm+7bhJ29JvIOsBDEEnan5DPu9t3To9VRlMzA==", + "dev": true, + "dependencies": { + "picomatch": "^2.2.1" + }, + "engines": { + "node": ">=8.10.0" + } + }, + "node_modules/elm-test/node_modules/rimraf": { + "version": "3.0.2", + "resolved": "https://registry.npmjs.org/rimraf/-/rimraf-3.0.2.tgz", + "integrity": "sha512-JZkJMZkAGFFPP2YqXZXPbMlMBgsxzE8ILs4lMIX/2o0L9UBw9O/Y3o6wFw/i9YLapcUJWwqbi3kdxIPdC62TIA==", + "dev": true, + "dependencies": { + "glob": "^7.1.3" + }, + "bin": { "rimraf": "bin.js" }, "funding": { @@ -6621,6 +7238,21 @@ "resolved": "https://registry.npmjs.org/fast-json-stable-stringify/-/fast-json-stable-stringify-2.1.0.tgz", "integrity": "sha512-lhd/wF+Lk98HZoTCtlVraHtfh5XYijIjalXck7saUtuanSDyLMxnHhSXEDJqHxD7msR8D0uCmqlkwjCV8xvwHw==" }, + "node_modules/fast-levenshtein": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/fast-levenshtein/-/fast-levenshtein-3.0.0.tgz", + "integrity": "sha512-hKKNajm46uNmTlhHSyZkmToAc56uZJwYq7yrciZjqOxnlfQwERDQJmHPUp7m1m9wx8vgOe8IaCKZ5Kv2k1DdCQ==", + "dev": true, + "dependencies": { + "fastest-levenshtein": "^1.0.7" + } + }, + "node_modules/fastest-levenshtein": { + "version": "1.0.12", + "resolved": "https://registry.npmjs.org/fastest-levenshtein/-/fastest-levenshtein-1.0.12.tgz", + "integrity": "sha512-On2N+BpYJ15xIC974QNVuYGMOlEVt4s0EOI3wwMqOmK1fdDY+FN/zltPV8vosq4ad4c/gJ1KHScUn/6AWIgiow==", + "dev": true + }, "node_modules/fastparse": { "version": "1.1.2", "resolved": "https://registry.npmjs.org/fastparse/-/fastparse-1.1.2.tgz", @@ -6807,6 +7439,46 @@ "readable-stream": "^2.3.6" } }, + "node_modules/folder-hash": { + "version": "3.3.3", + "resolved": "https://registry.npmjs.org/folder-hash/-/folder-hash-3.3.3.tgz", + "integrity": "sha512-SDgHBgV+RCjrYs8aUwCb9rTgbTVuSdzvFmLaChsLre1yf+D64khCW++VYciaByZ8Rm0uKF8R/XEpXuTRSGUM1A==", + "dev": true, + "dependencies": { + "debug": "^4.1.1", + "graceful-fs": "~4.2.0", + "minimatch": "~3.0.4" + }, + "bin": { + "folder-hash": "bin/folder-hash" + }, + "engines": { + "node": ">=6.0.0" + } + }, + "node_modules/folder-hash/node_modules/debug": { + "version": "4.3.4", + "resolved": "https://registry.npmjs.org/debug/-/debug-4.3.4.tgz", + "integrity": "sha512-PRWFHuSU3eDtQJPvnNY7Jcket1j0t5OuOsFzPPzsekD52Zl8qUfFIPEiswXqIvHWGVHOgX+7G/vCNNhehwxfkQ==", + "dev": true, + "dependencies": { + "ms": "2.1.2" + }, + "engines": { + "node": ">=6.0" + }, + "peerDependenciesMeta": { + "supports-color": { + "optional": true + } + } + }, + "node_modules/folder-hash/node_modules/ms": { + "version": "2.1.2", + "resolved": "https://registry.npmjs.org/ms/-/ms-2.1.2.tgz", + "integrity": "sha512-sGkPx+VjMtmA6MX27oA4FBFELFCZZ4S4XqeGOXCv68tT+jb3vk/RyaKWP0PTKyWtmLSM0b+adUTEvbs1PEaH2w==", + "dev": true + }, "node_modules/follow-redirects": { "version": "1.14.9", "resolved": "https://registry.npmjs.org/follow-redirects/-/follow-redirects-1.14.9.tgz", @@ -7153,16 +7825,60 @@ "integrity": "sha1-5aSs0sEB/fPZpNB/DbxNtJ3SgXY=", "dev": true, "engines": { - "node": ">=4" + "node": ">=4" + } + }, + "node_modules/globby/node_modules/slash": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/slash/-/slash-1.0.0.tgz", + "integrity": "sha1-xB8vbDn8FtHNF61LXYlhFK5HDVU=", + "dev": true, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/got": { + "version": "10.7.0", + "resolved": "https://registry.npmjs.org/got/-/got-10.7.0.tgz", + "integrity": "sha512-aWTDeNw9g+XqEZNcTjMMZSy7B7yE9toWOFYip7ofFTLleJhvZwUxxTxkTpKvF+p1SAA4VHmuEy7PiHTHyq8tJg==", + "dev": true, + "dependencies": { + "@sindresorhus/is": "^2.0.0", + "@szmarczak/http-timer": "^4.0.0", + "@types/cacheable-request": "^6.0.1", + "cacheable-lookup": "^2.0.0", + "cacheable-request": "^7.0.1", + "decompress-response": "^5.0.0", + "duplexer3": "^0.1.4", + "get-stream": "^5.0.0", + "lowercase-keys": "^2.0.0", + "mimic-response": "^2.1.0", + "p-cancelable": "^2.0.0", + "p-event": "^4.0.0", + "responselike": "^2.0.0", + "to-readable-stream": "^2.0.0", + "type-fest": "^0.10.0" + }, + "engines": { + "node": ">=10" + }, + "funding": { + "url": "https://github.com/sindresorhus/got?sponsor=1" } }, - "node_modules/globby/node_modules/slash": { - "version": "1.0.0", - "resolved": "https://registry.npmjs.org/slash/-/slash-1.0.0.tgz", - "integrity": "sha1-xB8vbDn8FtHNF61LXYlhFK5HDVU=", + "node_modules/got/node_modules/get-stream": { + "version": "5.2.0", + "resolved": "https://registry.npmjs.org/get-stream/-/get-stream-5.2.0.tgz", + "integrity": "sha512-nBF+F1rAZVCu/p7rjzgA+Yb4lfYXrpl7a6VmJrU8wF9I1CKvP/QwPNZHnOlwbTkY6dvtFIzFMSyQXbLoTQPRpA==", "dev": true, + "dependencies": { + "pump": "^3.0.0" + }, "engines": { - "node": ">=0.10.0" + "node": ">=8" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" } }, "node_modules/graceful-fs": { @@ -7500,6 +8216,12 @@ } ] }, + "node_modules/http-cache-semantics": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/http-cache-semantics/-/http-cache-semantics-4.1.0.tgz", + "integrity": "sha512-carPklcUh7ROWRK7Cv27RPtdhYhUsela/ue5/jKzjegVvXDqM2ILE9Q2BGn9JZJh1g87cp56su/FgQSzcWS8cQ==", + "dev": true + }, "node_modules/http-deceiver": { "version": "1.2.7", "resolved": "https://registry.npmjs.org/http-deceiver/-/http-deceiver-1.2.7.tgz", @@ -8123,6 +8845,15 @@ "node": ">=0.10.0" } }, + "node_modules/is-interactive": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/is-interactive/-/is-interactive-1.0.0.tgz", + "integrity": "sha512-2HvIEKRoqS62guEC+qBjpvRubdX910WCMuJTZ+I9yvqKU2/12eSL549HMwtabb4oupdj2sMP50k+XJfB/8JE6w==", + "dev": true, + "engines": { + "node": ">=8" + } + }, "node_modules/is-number": { "version": "3.0.0", "resolved": "https://registry.npmjs.org/is-number/-/is-number-3.0.0.tgz", @@ -8275,6 +9006,18 @@ "resolved": "https://registry.npmjs.org/is-typedarray/-/is-typedarray-1.0.0.tgz", "integrity": "sha1-5HnICFjfDBsR3dppQPlgEfzaSpo=" }, + "node_modules/is-unicode-supported": { + "version": "0.1.0", + "resolved": "https://registry.npmjs.org/is-unicode-supported/-/is-unicode-supported-0.1.0.tgz", + "integrity": "sha512-knxG2q4UC3u8stRGyAVJCOdxFmv5DZiRcdlIaAQXAbSfJya+OhopNotLQrstBhququ4ZpuKbDc/8S6mgXgPFPw==", + "dev": true, + "engines": { + "node": ">=10" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, "node_modules/is-utf8": { "version": "0.2.1", "resolved": "https://registry.npmjs.org/is-utf8/-/is-utf8-0.2.1.tgz", @@ -8357,6 +9100,12 @@ "node": ">=4" } }, + "node_modules/json-buffer": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/json-buffer/-/json-buffer-3.0.1.tgz", + "integrity": "sha512-4bV5BfR2mqfQTJm+V5tPPdf+ZpuhiIvTuAB5g8kcrXOZpTT/QwwVRWBywX1ozr6lEuPdbHxwaJlm9G6mI2sfSQ==", + "dev": true + }, "node_modules/json-parse-better-errors": { "version": "1.0.2", "resolved": "https://registry.npmjs.org/json-parse-better-errors/-/json-parse-better-errors-1.0.2.tgz", @@ -8442,6 +9191,16 @@ "node": ">=0.6.0" } }, + "node_modules/keyv": { + "version": "4.2.2", + "resolved": "https://registry.npmjs.org/keyv/-/keyv-4.2.2.tgz", + "integrity": "sha512-uYS0vKTlBIjNCAUqrjlxmruxOEiZxZIHXyp32sdcGmP+ukFrmWUnE//RcPXJH3Vxrni1H2gsQbjHE0bH7MtMQQ==", + "dev": true, + "dependencies": { + "compress-brotli": "^1.3.6", + "json-buffer": "3.0.1" + } + }, "node_modules/killable": { "version": "1.0.1", "resolved": "https://registry.npmjs.org/killable/-/killable-1.0.1.tgz", @@ -8456,6 +9215,15 @@ "node": ">=0.10.0" } }, + "node_modules/kleur": { + "version": "3.0.3", + "resolved": "https://registry.npmjs.org/kleur/-/kleur-3.0.3.tgz", + "integrity": "sha512-eTIzlVOSUR+JxdDFepEYcBMtZ9Qqdef+rnzWdRZuMbOywu5tO2w2N7rqjoANZ5k9vywhL6Br1VRjUIgTQx4E8w==", + "dev": true, + "engines": { + "node": ">=6" + } + }, "node_modules/klona": { "version": "2.0.5", "resolved": "https://registry.npmjs.org/klona/-/klona-2.0.5.tgz", @@ -8640,6 +9408,92 @@ "node": ">=0.8.6" } }, + "node_modules/log-symbols": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/log-symbols/-/log-symbols-4.1.0.tgz", + "integrity": "sha512-8XPvpAA8uyhfteu8pIvQxpJZ7SYYdpUivZpGy6sFsBuKRY/7rQGavedeB8aK+Zkyq6upMFVL/9AW6vOYzfRyLg==", + "dev": true, + "dependencies": { + "chalk": "^4.1.0", + "is-unicode-supported": "^0.1.0" + }, + "engines": { + "node": ">=10" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, + "node_modules/log-symbols/node_modules/ansi-styles": { + "version": "4.3.0", + "resolved": "https://registry.npmjs.org/ansi-styles/-/ansi-styles-4.3.0.tgz", + "integrity": "sha512-zbB9rCJAT1rbjiVDb2hqKFHNYLxgtk8NURxZ3IZwD3F6NtxbXZQCnnSi1Lkx+IDohdPlFp222wVALIheZJQSEg==", + "dev": true, + "dependencies": { + "color-convert": "^2.0.1" + }, + "engines": { + "node": ">=8" + }, + "funding": { + "url": "https://github.com/chalk/ansi-styles?sponsor=1" + } + }, + "node_modules/log-symbols/node_modules/chalk": { + "version": "4.1.2", + "resolved": "https://registry.npmjs.org/chalk/-/chalk-4.1.2.tgz", + "integrity": "sha512-oKnbhFyRIXpUuez8iBMmyEa4nbj4IOQyuhc/wy9kY7/WVPcwIO9VA668Pu8RkO7+0G76SLROeyw9CpQ061i4mA==", + "dev": true, + "dependencies": { + "ansi-styles": "^4.1.0", + "supports-color": "^7.1.0" + }, + "engines": { + "node": ">=10" + }, + "funding": { + "url": "https://github.com/chalk/chalk?sponsor=1" + } + }, + "node_modules/log-symbols/node_modules/color-convert": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/color-convert/-/color-convert-2.0.1.tgz", + "integrity": "sha512-RRECPsj7iu/xb5oKYcsFHSppFNnsj/52OVTRKb4zP5onXwVF3zVmmToNcOfGC+CRDpfK/U584fMg38ZHCaElKQ==", + "dev": true, + "dependencies": { + "color-name": "~1.1.4" + }, + "engines": { + "node": ">=7.0.0" + } + }, + "node_modules/log-symbols/node_modules/color-name": { + "version": "1.1.4", + "resolved": "https://registry.npmjs.org/color-name/-/color-name-1.1.4.tgz", + "integrity": "sha512-dOy+3AuW3a2wNbZHIuMZpTcgjGuLU/uBL/ubcZF9OXbDo8ff4O8yVp5Bf0efS8uEoYo5q4Fx7dY9OgQGXgAsQA==", + "dev": true + }, + "node_modules/log-symbols/node_modules/has-flag": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/has-flag/-/has-flag-4.0.0.tgz", + "integrity": "sha512-EykJT/Q1KjTWctppgIAgfSO0tKVuZUjhgMr17kqTumMl6Afv3EISleU7qZUzoXDFTAHTDC4NOoG/ZxU3EvlMPQ==", + "dev": true, + "engines": { + "node": ">=8" + } + }, + "node_modules/log-symbols/node_modules/supports-color": { + "version": "7.2.0", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-7.2.0.tgz", + "integrity": "sha512-qpCAvRl9stuOHveKsn7HncJRvv501qIacKzQlO/+Lwxc9+0q2wLyv4Dfvt80/DPn2pqOBsJdDiogXGR9+OvwRw==", + "dev": true, + "dependencies": { + "has-flag": "^4.0.0" + }, + "engines": { + "node": ">=8" + } + }, "node_modules/loglevel": { "version": "1.6.8", "resolved": "https://registry.npmjs.org/loglevel/-/loglevel-1.6.8.tgz", @@ -8668,6 +9522,15 @@ "integrity": "sha512-77EbyPPpMz+FRFRuAFlWMtmgUWGe9UOG2Z25NqCwiIjRhOf5iKGuzSe5P2w1laq+FkRy4p+PCuVkJSGkzTEKVw==", "dev": true }, + "node_modules/lowercase-keys": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/lowercase-keys/-/lowercase-keys-2.0.0.tgz", + "integrity": "sha512-tqNXrS78oMOE73NMxK4EMLQsQowWf8jKooH9g7xPavRT706R6bkQJ6DY2Te7QukaZsulxa30wQ7bk0pm4XiHmA==", + "dev": true, + "engines": { + "node": ">=8" + } + }, "node_modules/lru-cache": { "version": "5.1.1", "resolved": "https://registry.npmjs.org/lru-cache/-/lru-cache-5.1.1.tgz", @@ -8854,6 +9717,18 @@ "node": ">=4" } }, + "node_modules/mimic-response": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/mimic-response/-/mimic-response-2.1.0.tgz", + "integrity": "sha512-wXqjST+SLt7R009ySCglWBCFpjUygmCIfD790/kVbiGmUgfYGuB14PiTd5DwVxSV4NcYHjzMkoj5LjQZwTQLEA==", + "dev": true, + "engines": { + "node": ">=8" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, "node_modules/mini-css-extract-plugin": { "version": "0.12.0", "resolved": "https://registry.npmjs.org/mini-css-extract-plugin/-/mini-css-extract-plugin-0.12.0.tgz", @@ -9550,52 +10425,194 @@ "integrity": "sha512-pZAE+FJLoyITytdqK0U5s+FIpjN0JP3OzFi/u8Rx+EV5/W+JTWGXG8xFzevE7AjBfDqHv/8vL8qQsIhHnqRkrA==", "dev": true, "engines": { - "node": ">= 0.8" + "node": ">= 0.8" + } + }, + "node_modules/once": { + "version": "1.4.0", + "resolved": "https://registry.npmjs.org/once/-/once-1.4.0.tgz", + "integrity": "sha1-WDsap3WWHUsROsF9nFC6753Xa9E=", + "dependencies": { + "wrappy": "1" + } + }, + "node_modules/onetime": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/onetime/-/onetime-2.0.1.tgz", + "integrity": "sha1-BnQoIw/WdEOyeUsiu6UotoZ5YtQ=", + "dev": true, + "dependencies": { + "mimic-fn": "^1.0.0" + }, + "engines": { + "node": ">=4" + } + }, + "node_modules/opn": { + "version": "5.4.0", + "resolved": "https://registry.npmjs.org/opn/-/opn-5.4.0.tgz", + "integrity": "sha512-YF9MNdVy/0qvJvDtunAOzFw9iasOQHpVthTCvGzxt61Il64AYSGdK+rYwld7NAfk9qJ7dt+hymBNSc9LNYS+Sw==", + "dev": true, + "dependencies": { + "is-wsl": "^1.1.0" + }, + "engines": { + "node": ">=4" + } + }, + "node_modules/optimize-css-assets-webpack-plugin": { + "version": "5.0.3", + "resolved": "https://registry.npmjs.org/optimize-css-assets-webpack-plugin/-/optimize-css-assets-webpack-plugin-5.0.3.tgz", + "integrity": "sha512-q9fbvCRS6EYtUKKSwI87qm2IxlyJK5b4dygW1rKUBT6mMDhdG5e5bZT63v6tnJR9F9FB/H5a0HTmtw+laUBxKA==", + "dev": true, + "dependencies": { + "cssnano": "^4.1.10", + "last-call-webpack-plugin": "^3.0.0" + }, + "peerDependencies": { + "webpack": "^4.0.0" + } + }, + "node_modules/ora": { + "version": "5.4.1", + "resolved": "https://registry.npmjs.org/ora/-/ora-5.4.1.tgz", + "integrity": "sha512-5b6Y85tPxZZ7QytO+BQzysW31HJku27cRIlkbAXaNx+BdcVi+LlRFmVXzeF6a7JCwJpyw5c4b+YSVImQIrBpuQ==", + "dev": true, + "dependencies": { + "bl": "^4.1.0", + "chalk": "^4.1.0", + "cli-cursor": "^3.1.0", + "cli-spinners": "^2.5.0", + "is-interactive": "^1.0.0", + "is-unicode-supported": "^0.1.0", + "log-symbols": "^4.1.0", + "strip-ansi": "^6.0.0", + "wcwidth": "^1.0.1" + }, + "engines": { + "node": ">=10" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, + "node_modules/ora/node_modules/ansi-styles": { + "version": "4.3.0", + "resolved": "https://registry.npmjs.org/ansi-styles/-/ansi-styles-4.3.0.tgz", + "integrity": "sha512-zbB9rCJAT1rbjiVDb2hqKFHNYLxgtk8NURxZ3IZwD3F6NtxbXZQCnnSi1Lkx+IDohdPlFp222wVALIheZJQSEg==", + "dev": true, + "dependencies": { + "color-convert": "^2.0.1" + }, + "engines": { + "node": ">=8" + }, + "funding": { + "url": "https://github.com/chalk/ansi-styles?sponsor=1" + } + }, + "node_modules/ora/node_modules/chalk": { + "version": "4.1.2", + "resolved": "https://registry.npmjs.org/chalk/-/chalk-4.1.2.tgz", + "integrity": "sha512-oKnbhFyRIXpUuez8iBMmyEa4nbj4IOQyuhc/wy9kY7/WVPcwIO9VA668Pu8RkO7+0G76SLROeyw9CpQ061i4mA==", + "dev": true, + "dependencies": { + "ansi-styles": "^4.1.0", + "supports-color": "^7.1.0" + }, + "engines": { + "node": ">=10" + }, + "funding": { + "url": "https://github.com/chalk/chalk?sponsor=1" + } + }, + "node_modules/ora/node_modules/cli-cursor": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/cli-cursor/-/cli-cursor-3.1.0.tgz", + "integrity": "sha512-I/zHAwsKf9FqGoXM4WWRACob9+SNukZTd94DWF57E4toouRulbCxcUh6RKUEOQlYTHJnzkPMySvPNaaSLNfLZw==", + "dev": true, + "dependencies": { + "restore-cursor": "^3.1.0" + }, + "engines": { + "node": ">=8" + } + }, + "node_modules/ora/node_modules/color-convert": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/color-convert/-/color-convert-2.0.1.tgz", + "integrity": "sha512-RRECPsj7iu/xb5oKYcsFHSppFNnsj/52OVTRKb4zP5onXwVF3zVmmToNcOfGC+CRDpfK/U584fMg38ZHCaElKQ==", + "dev": true, + "dependencies": { + "color-name": "~1.1.4" + }, + "engines": { + "node": ">=7.0.0" + } + }, + "node_modules/ora/node_modules/color-name": { + "version": "1.1.4", + "resolved": "https://registry.npmjs.org/color-name/-/color-name-1.1.4.tgz", + "integrity": "sha512-dOy+3AuW3a2wNbZHIuMZpTcgjGuLU/uBL/ubcZF9OXbDo8ff4O8yVp5Bf0efS8uEoYo5q4Fx7dY9OgQGXgAsQA==", + "dev": true + }, + "node_modules/ora/node_modules/has-flag": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/has-flag/-/has-flag-4.0.0.tgz", + "integrity": "sha512-EykJT/Q1KjTWctppgIAgfSO0tKVuZUjhgMr17kqTumMl6Afv3EISleU7qZUzoXDFTAHTDC4NOoG/ZxU3EvlMPQ==", + "dev": true, + "engines": { + "node": ">=8" } }, - "node_modules/once": { - "version": "1.4.0", - "resolved": "https://registry.npmjs.org/once/-/once-1.4.0.tgz", - "integrity": "sha1-WDsap3WWHUsROsF9nFC6753Xa9E=", - "dependencies": { - "wrappy": "1" + "node_modules/ora/node_modules/mimic-fn": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/mimic-fn/-/mimic-fn-2.1.0.tgz", + "integrity": "sha512-OqbOk5oEQeAZ8WXWydlu9HJjz9WVdEIvamMCcXmuqUYjTknH/sqsWvhQ3vgwKFRR1HpjvNBKQ37nbJgYzGqGcg==", + "dev": true, + "engines": { + "node": ">=6" } }, - "node_modules/onetime": { - "version": "2.0.1", - "resolved": "https://registry.npmjs.org/onetime/-/onetime-2.0.1.tgz", - "integrity": "sha1-BnQoIw/WdEOyeUsiu6UotoZ5YtQ=", + "node_modules/ora/node_modules/onetime": { + "version": "5.1.2", + "resolved": "https://registry.npmjs.org/onetime/-/onetime-5.1.2.tgz", + "integrity": "sha512-kbpaSSGJTWdAY5KPVeMOKXSrPtr8C8C7wodJbcsd51jRnmD+GZu8Y0VoU6Dm5Z4vWr0Ig/1NKuWRKf7j5aaYSg==", "dev": true, "dependencies": { - "mimic-fn": "^1.0.0" + "mimic-fn": "^2.1.0" }, "engines": { - "node": ">=4" + "node": ">=6" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" } }, - "node_modules/opn": { - "version": "5.4.0", - "resolved": "https://registry.npmjs.org/opn/-/opn-5.4.0.tgz", - "integrity": "sha512-YF9MNdVy/0qvJvDtunAOzFw9iasOQHpVthTCvGzxt61Il64AYSGdK+rYwld7NAfk9qJ7dt+hymBNSc9LNYS+Sw==", + "node_modules/ora/node_modules/restore-cursor": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/restore-cursor/-/restore-cursor-3.1.0.tgz", + "integrity": "sha512-l+sSefzHpj5qimhFSE5a8nufZYAM3sBSVMAPtYkmC+4EH2anSGaEMXSD0izRQbu9nfyQ9y5JrVmp7E8oZrUjvA==", "dev": true, "dependencies": { - "is-wsl": "^1.1.0" + "onetime": "^5.1.0", + "signal-exit": "^3.0.2" }, "engines": { - "node": ">=4" + "node": ">=8" } }, - "node_modules/optimize-css-assets-webpack-plugin": { - "version": "5.0.3", - "resolved": "https://registry.npmjs.org/optimize-css-assets-webpack-plugin/-/optimize-css-assets-webpack-plugin-5.0.3.tgz", - "integrity": "sha512-q9fbvCRS6EYtUKKSwI87qm2IxlyJK5b4dygW1rKUBT6mMDhdG5e5bZT63v6tnJR9F9FB/H5a0HTmtw+laUBxKA==", + "node_modules/ora/node_modules/supports-color": { + "version": "7.2.0", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-7.2.0.tgz", + "integrity": "sha512-qpCAvRl9stuOHveKsn7HncJRvv501qIacKzQlO/+Lwxc9+0q2wLyv4Dfvt80/DPn2pqOBsJdDiogXGR9+OvwRw==", "dev": true, "dependencies": { - "cssnano": "^4.1.10", - "last-call-webpack-plugin": "^3.0.0" + "has-flag": "^4.0.0" }, - "peerDependencies": { - "webpack": "^4.0.0" + "engines": { + "node": ">=8" } }, "node_modules/original": { @@ -9633,6 +10650,30 @@ "node": ">=0.10.0" } }, + "node_modules/p-cancelable": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/p-cancelable/-/p-cancelable-2.1.1.tgz", + "integrity": "sha512-BZOr3nRQHOntUjTrH8+Lh54smKHoHyur8We1V8DSMVrl5A2malOOwuJRnKRDjSnkoeBh4at6BwEnb5I7Jl31wg==", + "dev": true, + "engines": { + "node": ">=8" + } + }, + "node_modules/p-event": { + "version": "4.2.0", + "resolved": "https://registry.npmjs.org/p-event/-/p-event-4.2.0.tgz", + "integrity": "sha512-KXatOjCRXXkSePPb1Nbi0p0m+gQAwdlbhi4wQKJPI1HsMQS9g+Sqp2o+QHziPr7eYJyOZet836KoHEVM1mwOrQ==", + "dev": true, + "dependencies": { + "p-timeout": "^3.1.0" + }, + "engines": { + "node": ">=8" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, "node_modules/p-finally": { "version": "1.0.0", "resolved": "https://registry.npmjs.org/p-finally/-/p-finally-1.0.0.tgz", @@ -9688,6 +10729,18 @@ "node": ">=6" } }, + "node_modules/p-timeout": { + "version": "3.2.0", + "resolved": "https://registry.npmjs.org/p-timeout/-/p-timeout-3.2.0.tgz", + "integrity": "sha512-rhIwUycgwwKcP9yTOOFK/AKsAopjjCakVqLHePO3CC6Mir1Z99xT+R63jZxAT5lFZLa2inS5h+ZS2GvR99/FBg==", + "dev": true, + "dependencies": { + "p-finally": "^1.0.0" + }, + "engines": { + "node": ">=8" + } + }, "node_modules/p-try": { "version": "2.2.0", "resolved": "https://registry.npmjs.org/p-try/-/p-try-2.2.0.tgz", @@ -11756,6 +12809,19 @@ "node": ">=0.1.90" } }, + "node_modules/prompts": { + "version": "2.4.2", + "resolved": "https://registry.npmjs.org/prompts/-/prompts-2.4.2.tgz", + "integrity": "sha512-NxNv/kLguCA7p3jE8oL2aEBsrJWgAakBpgmgK6lpPWV+WuOmY6r2/zbAVnP+T8bQlA0nzHXSJSJW0Hq7ylaD2Q==", + "dev": true, + "dependencies": { + "kleur": "^3.0.3", + "sisteransi": "^1.0.5" + }, + "engines": { + "node": ">= 6" + } + }, "node_modules/proxy-addr": { "version": "2.0.6", "resolved": "https://registry.npmjs.org/proxy-addr/-/proxy-addr-2.0.6.tgz", @@ -12597,6 +13663,15 @@ "integrity": "sha1-LGN/53yJOv0qZj/iGqkIAGjiBSo=", "deprecated": "https://github.com/lydell/resolve-url#deprecated" }, + "node_modules/responselike": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/responselike/-/responselike-2.0.0.tgz", + "integrity": "sha512-xH48u3FTB9VsZw7R+vvgaKeLKzT6jOogbQhEe/jewwnZgzPcnyWui2Av6JpoYZF/91uueC+lqhWqeURw5/qhCw==", + "dev": true, + "dependencies": { + "lowercase-keys": "^2.0.0" + } + }, "node_modules/restore-cursor": { "version": "2.0.0", "resolved": "https://registry.npmjs.org/restore-cursor/-/restore-cursor-2.0.0.tgz", @@ -12975,6 +14050,12 @@ "integrity": "sha512-eVRqCvVlZbuw3GrM63ovNSNAeA1K16kaR/LRY/92w0zxQ5/1YzwblUX652i4Xs9RwAGjW9d9y6X88t8OaAJfWQ==", "dev": true }, + "node_modules/sisteransi": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/sisteransi/-/sisteransi-1.0.5.tgz", + "integrity": "sha512-bLGGlR1QxBcynn2d5YmDX4MGjlZvy2MRBDRNHLJ8VI6l6+9FUiyTFNJ0IveOSP0bcXgVDPRcfGqA0pjaqUpfVg==", + "dev": true + }, "node_modules/slash": { "version": "2.0.0", "resolved": "https://registry.npmjs.org/slash/-/slash-2.0.0.tgz", @@ -13841,6 +14922,40 @@ "node": ">=4" } }, + "node_modules/supports-hyperlinks": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/supports-hyperlinks/-/supports-hyperlinks-2.2.0.tgz", + "integrity": "sha512-6sXEzV5+I5j8Bmq9/vUphGRM/RJNT9SCURJLjwfOg51heRtguGWDzcaBlgAzKhQa0EVNpPEKzQuBwZ8S8WaCeQ==", + "dev": true, + "dependencies": { + "has-flag": "^4.0.0", + "supports-color": "^7.0.0" + }, + "engines": { + "node": ">=8" + } + }, + "node_modules/supports-hyperlinks/node_modules/has-flag": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/has-flag/-/has-flag-4.0.0.tgz", + "integrity": "sha512-EykJT/Q1KjTWctppgIAgfSO0tKVuZUjhgMr17kqTumMl6Afv3EISleU7qZUzoXDFTAHTDC4NOoG/ZxU3EvlMPQ==", + "dev": true, + "engines": { + "node": ">=8" + } + }, + "node_modules/supports-hyperlinks/node_modules/supports-color": { + "version": "7.2.0", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-7.2.0.tgz", + "integrity": "sha512-qpCAvRl9stuOHveKsn7HncJRvv501qIacKzQlO/+Lwxc9+0q2wLyv4Dfvt80/DPn2pqOBsJdDiogXGR9+OvwRw==", + "dev": true, + "dependencies": { + "has-flag": "^4.0.0" + }, + "engines": { + "node": ">=8" + } + }, "node_modules/supports-preserve-symlinks-flag": { "version": "1.0.0", "resolved": "https://registry.npmjs.org/supports-preserve-symlinks-flag/-/supports-preserve-symlinks-flag-1.0.0.tgz", @@ -14043,6 +15158,49 @@ "rimraf": "bin.js" } }, + "node_modules/terminal-link": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/terminal-link/-/terminal-link-2.1.1.tgz", + "integrity": "sha512-un0FmiRUQNr5PJqy9kP7c40F5BOfpGlYTrxonDChEZB7pzZxRNp/bt+ymiy9/npwXya9KH99nJ/GXFIiUkYGFQ==", + "dev": true, + "dependencies": { + "ansi-escapes": "^4.2.1", + "supports-hyperlinks": "^2.0.0" + }, + "engines": { + "node": ">=8" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, + "node_modules/terminal-link/node_modules/ansi-escapes": { + "version": "4.3.2", + "resolved": "https://registry.npmjs.org/ansi-escapes/-/ansi-escapes-4.3.2.tgz", + "integrity": "sha512-gKXj5ALrKWQLsYG9jlTRmR/xKluxHV+Z9QEwNIgCfM1/uwPMCuzVVnh5mwTd+OuBZcwSIMbqssNWRm1lE51QaQ==", + "dev": true, + "dependencies": { + "type-fest": "^0.21.3" + }, + "engines": { + "node": ">=8" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, + "node_modules/terminal-link/node_modules/type-fest": { + "version": "0.21.3", + "resolved": "https://registry.npmjs.org/type-fest/-/type-fest-0.21.3.tgz", + "integrity": "sha512-t0rzBq87m3fVcduHDUFhKmyyX+9eo6WQjZvf51Ea/M0Q7+T374Jp1aUiyUl0GKxp8M/OETVHSDvmkyPgvX+X2w==", + "dev": true, + "engines": { + "node": ">=10" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, "node_modules/terser": { "version": "4.8.0", "resolved": "https://registry.npmjs.org/terser/-/terser-4.8.0.tgz", @@ -14194,6 +15352,15 @@ "node": ">=0.10.0" } }, + "node_modules/to-readable-stream": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/to-readable-stream/-/to-readable-stream-2.1.0.tgz", + "integrity": "sha512-o3Qa6DGg1CEXshSdvWNX2sN4QHqg03SPq7U6jPXRahlQdl5dK8oXjkU/2/sGrnOZKeGV1zLSO8qPwyKklPPE7w==", + "dev": true, + "engines": { + "node": ">=8" + } + }, "node_modules/to-regex": { "version": "3.0.2", "resolved": "https://registry.npmjs.org/to-regex/-/to-regex-3.0.2.tgz", @@ -14293,6 +15460,18 @@ "resolved": "https://registry.npmjs.org/tweetnacl/-/tweetnacl-0.14.5.tgz", "integrity": "sha1-WuaBd/GS1EViadEIr6k/+HQ/T2Q=" }, + "node_modules/type-fest": { + "version": "0.10.0", + "resolved": "https://registry.npmjs.org/type-fest/-/type-fest-0.10.0.tgz", + "integrity": "sha512-EUV9jo4sffrwlg8s0zDhP0T2WD3pru5Xi0+HTE3zTUmBaZNhfkite9PdSJwdXLwPVW0jnAHT56pZHIOYckPEiw==", + "dev": true, + "engines": { + "node": ">=8" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, "node_modules/type-is": { "version": "1.6.18", "resolved": "https://registry.npmjs.org/type-is/-/type-is-1.6.18.tgz", @@ -15098,6 +16277,15 @@ "minimalistic-assert": "^1.0.0" } }, + "node_modules/wcwidth": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/wcwidth/-/wcwidth-1.0.1.tgz", + "integrity": "sha1-8LDc+RW8X/FSivrbLA4XtTLaL+g=", + "dev": true, + "dependencies": { + "defaults": "^1.0.3" + } + }, "node_modules/webpack": { "version": "4.44.2", "resolved": "https://registry.npmjs.org/webpack/-/webpack-4.44.2.tgz", @@ -17396,6 +18584,33 @@ "integrity": "sha512-shAmDyaQC4H92APFoIaVDHCx5bStIocgvbwQyxPRrbUY20V1EYTbSDchWbuwlMG3V17cprZhA6+78JfB+3DTPw==", "dev": true }, + "@sindresorhus/is": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/@sindresorhus/is/-/is-2.1.1.tgz", + "integrity": "sha512-/aPsuoj/1Dw/kzhkgz+ES6TxG0zfTMGLwuK2ZG00k/iJzYHTLCE8mVU8EPqEOp/lmxPoq1C1C9RYToRKb2KEfg==", + "dev": true + }, + "@szmarczak/http-timer": { + "version": "4.0.6", + "resolved": "https://registry.npmjs.org/@szmarczak/http-timer/-/http-timer-4.0.6.tgz", + "integrity": "sha512-4BAffykYOgO+5nzBWYwE3W90sBgLJoUPRWWcL8wlyiM8IB8ipJz3UMJ9KXQd1RKQXpKp8Tutn80HZtWsu2u76w==", + "dev": true, + "requires": { + "defer-to-connect": "^2.0.0" + } + }, + "@types/cacheable-request": { + "version": "6.0.2", + "resolved": "https://registry.npmjs.org/@types/cacheable-request/-/cacheable-request-6.0.2.tgz", + "integrity": "sha512-B3xVo+dlKM6nnKTcmm5ZtY/OL8bOAOd2Olee9M1zft65ox50OzjEHW91sDiU9j6cvW8Ejg1/Qkf4xd2kugApUA==", + "dev": true, + "requires": { + "@types/http-cache-semantics": "*", + "@types/keyv": "*", + "@types/node": "*", + "@types/responselike": "*" + } + }, "@types/color-name": { "version": "1.1.1", "resolved": "https://registry.npmjs.org/@types/color-name/-/color-name-1.1.1.tgz", @@ -17418,6 +18633,12 @@ "integrity": "sha512-h4lTMgMJctJybDp8CQrxTUiiYmedihHWkjnF/8Pxseu2S6Nlfcy8kwboQ8yejh456rP2yWoEVm1sS/FVsfM48w==", "dev": true }, + "@types/http-cache-semantics": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/@types/http-cache-semantics/-/http-cache-semantics-4.0.1.tgz", + "integrity": "sha512-SZs7ekbP8CN0txVG2xVRH6EgKmEm31BOxA07vkFaETzZz1xh+cbt8BcI0slpymvwhx5dlFnQG2rTlPVQn+iRPQ==", + "dev": true + }, "@types/http-proxy": { "version": "1.17.4", "resolved": "https://registry.npmjs.org/@types/http-proxy/-/http-proxy-1.17.4.tgz", @@ -17427,12 +18648,27 @@ "@types/node": "*" } }, + "@types/json-buffer": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/@types/json-buffer/-/json-buffer-3.0.0.tgz", + "integrity": "sha512-3YP80IxxFJB4b5tYC2SUPwkg0XQLiu0nWvhRgEatgjf+29IcWO9X1k8xRv5DGssJ/lCrjYTjQPcobJr2yWIVuQ==", + "dev": true + }, "@types/json-schema": { "version": "7.0.11", "resolved": "https://registry.npmjs.org/@types/json-schema/-/json-schema-7.0.11.tgz", "integrity": "sha512-wOuvG1SN4Us4rez+tylwwwCV1psiNVOkJeM3AUWUNWg/jDQY2+HE/444y5gc+jBmRqASOm2Oeh5c1axHobwRKQ==", "dev": true }, + "@types/keyv": { + "version": "3.1.4", + "resolved": "https://registry.npmjs.org/@types/keyv/-/keyv-3.1.4.tgz", + "integrity": "sha512-BQ5aZNSCpj7D6K2ksrRCTmKRLEpnPvWDiLPfoGyhZ++8YtiK9d/3DBKPJgry359X/P1PfruyYwvnvwFjuEiEIg==", + "dev": true, + "requires": { + "@types/node": "*" + } + }, "@types/minimatch": { "version": "3.0.3", "resolved": "https://registry.npmjs.org/@types/minimatch/-/minimatch-3.0.3.tgz", @@ -17457,6 +18693,15 @@ "integrity": "sha512-1HcDas8SEj4z1Wc696tH56G8OlRaH/sqZOynNNB+HF0WOeXPaxTtbYzJY2oEfiUxjSKjhCKr+MvR7dCHcEelug==", "dev": true }, + "@types/responselike": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/@types/responselike/-/responselike-1.0.0.tgz", + "integrity": "sha512-85Y2BjiufFzaMIlvJDvTTB8Fxl2xfLo4HgmHzVBz08w4wDePCTjYw66PdrolO0kzli3yam/YCgRufyo1DdQVTA==", + "dev": true, + "requires": { + "@types/node": "*" + } + }, "@types/source-list-map": { "version": "0.1.2", "resolved": "https://registry.npmjs.org/@types/source-list-map/-/source-list-map-0.1.2.tgz", @@ -18015,6 +19260,12 @@ "resolved": "https://registry.npmjs.org/asynckit/-/asynckit-0.4.0.tgz", "integrity": "sha1-x57Zf380y48robyXkLzDZkdLS3k=" }, + "at-least-node": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/at-least-node/-/at-least-node-1.0.0.tgz", + "integrity": "sha512-+q/t7Ekv1EDY2l6Gda6LLiX14rU9TV20Wa3ofeQmwPFZbOMo9DXrLbOjFaaclkXKWidIaopwAObQDqwWtGUjqg==", + "dev": true + }, "atob": { "version": "2.1.2", "resolved": "https://registry.npmjs.org/atob/-/atob-2.1.2.tgz", @@ -18342,6 +19593,40 @@ "unzip-stream": "^0.3.1" } }, + "bl": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/bl/-/bl-4.1.0.tgz", + "integrity": "sha512-1W07cM9gS6DcLperZfFSj+bWLtaPGSOHWhPiGzXmvVJbRLdG82sH/Kn8EtW1VqWVA54AKf2h5k5BbnIbwF3h6w==", + "dev": true, + "requires": { + "buffer": "^5.5.0", + "inherits": "^2.0.4", + "readable-stream": "^3.4.0" + }, + "dependencies": { + "buffer": { + "version": "5.7.1", + "resolved": "https://registry.npmjs.org/buffer/-/buffer-5.7.1.tgz", + "integrity": "sha512-EHcyIPBQ4BSGlvjB16k5KgAJ27CIsHY/2JBmCRReo48y9rQ3MaUzWX3KVlBa4U7MyX02HdVj0K7C3WaB3ju7FQ==", + "dev": true, + "requires": { + "base64-js": "^1.3.1", + "ieee754": "^1.1.13" + } + }, + "readable-stream": { + "version": "3.6.0", + "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-3.6.0.tgz", + "integrity": "sha512-BViHy7LKeTz4oNnkcLJ+lVSL6vpiFeX6/d3oSH8zCW7UxP2onchk+vTGB143xuFjHS3deTgkKoXXymXqymiIdA==", + "dev": true, + "requires": { + "inherits": "^2.0.3", + "string_decoder": "^1.1.1", + "util-deprecate": "^1.0.1" + } + } + } + }, "bluebird": { "version": "3.7.2", "resolved": "https://registry.npmjs.org/bluebird/-/bluebird-3.7.2.tgz", @@ -18653,6 +19938,48 @@ "unset-value": "^1.0.0" } }, + "cacheable-lookup": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/cacheable-lookup/-/cacheable-lookup-2.0.1.tgz", + "integrity": "sha512-EMMbsiOTcdngM/K6gV/OxF2x0t07+vMOWxZNSCRQMjO2MY2nhZQ6OYhOOpyQrbhqsgtvKGI7hcq6xjnA92USjg==", + "dev": true, + "requires": { + "@types/keyv": "^3.1.1", + "keyv": "^4.0.0" + } + }, + "cacheable-request": { + "version": "7.0.2", + "resolved": "https://registry.npmjs.org/cacheable-request/-/cacheable-request-7.0.2.tgz", + "integrity": "sha512-pouW8/FmiPQbuGpkXQ9BAPv/Mo5xDGANgSNXzTzJ8DrKGuXOssM4wIQRjfanNRh3Yu5cfYPvcorqbhg2KIJtew==", + "dev": true, + "requires": { + "clone-response": "^1.0.2", + "get-stream": "^5.1.0", + "http-cache-semantics": "^4.0.0", + "keyv": "^4.0.0", + "lowercase-keys": "^2.0.0", + "normalize-url": "^6.0.1", + "responselike": "^2.0.0" + }, + "dependencies": { + "get-stream": { + "version": "5.2.0", + "resolved": "https://registry.npmjs.org/get-stream/-/get-stream-5.2.0.tgz", + "integrity": "sha512-nBF+F1rAZVCu/p7rjzgA+Yb4lfYXrpl7a6VmJrU8wF9I1CKvP/QwPNZHnOlwbTkY6dvtFIzFMSyQXbLoTQPRpA==", + "dev": true, + "requires": { + "pump": "^3.0.0" + } + }, + "normalize-url": { + "version": "6.1.0", + "resolved": "https://registry.npmjs.org/normalize-url/-/normalize-url-6.1.0.tgz", + "integrity": "sha512-DlL+XwOy3NxAQ8xuC0okPgK46iuVNAK01YN7RueYBqqFeGsBjV9XmCAzAdgt+667bCl5kPh9EqKKDwnaPG1I7A==", + "dev": true + } + } + }, "call-me-maybe": { "version": "1.0.1", "resolved": "https://registry.npmjs.org/call-me-maybe/-/call-me-maybe-1.0.1.tgz", @@ -18849,6 +20176,12 @@ "restore-cursor": "^2.0.0" } }, + "cli-spinners": { + "version": "2.6.1", + "resolved": "https://registry.npmjs.org/cli-spinners/-/cli-spinners-2.6.1.tgz", + "integrity": "sha512-x/5fWmGMnbKQAaNwN+UZlV79qBLM9JFnJuJ03gIi5whrob0xV0ofNVHy9DhwGdsMJQc2OKv0oGmLzvaqvAVv+g==", + "dev": true + }, "cli-table": { "version": "0.3.4", "resolved": "https://registry.npmjs.org/cli-table/-/cli-table-0.3.4.tgz", @@ -18907,6 +20240,29 @@ } } }, + "clone": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/clone/-/clone-1.0.4.tgz", + "integrity": "sha1-2jCcwmPfFZlMaIypAheco8fNfH4=", + "dev": true + }, + "clone-response": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/clone-response/-/clone-response-1.0.2.tgz", + "integrity": "sha1-0dyXOSAxTfZ/vrlCI7TuNQI56Ws=", + "dev": true, + "requires": { + "mimic-response": "^1.0.0" + }, + "dependencies": { + "mimic-response": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/mimic-response/-/mimic-response-1.0.1.tgz", + "integrity": "sha512-j5EctnkH7amfV/q5Hgmoal1g2QHFJRraOtmx0JpIqkxhBhI/lJSl1nMpQ45hVarwNETOoWEimndZ4QK0RHxuxQ==", + "dev": true + } + } + }, "coa": { "version": "2.0.2", "resolved": "https://registry.npmjs.org/coa/-/coa-2.0.2.tgz", @@ -19008,6 +20364,16 @@ "resolved": "https://registry.npmjs.org/component-emitter/-/component-emitter-1.3.0.tgz", "integrity": "sha512-Rd3se6QB+sO1TwqZjscQrurpEPIfO0/yYnSin6Q/rD3mOutHvUrCAhJub3r90uNb+SESBuE0QYoB90YdfatsRg==" }, + "compress-brotli": { + "version": "1.3.6", + "resolved": "https://registry.npmjs.org/compress-brotli/-/compress-brotli-1.3.6.tgz", + "integrity": "sha512-au99/GqZtUtiCBliqLFbWlhnCxn+XSYjwZ77q6mKN4La4qOXDoLVPZ50iXr0WmAyMxl8yqoq3Yq4OeQNPPkyeQ==", + "dev": true, + "requires": { + "@types/json-buffer": "~3.0.0", + "json-buffer": "~3.0.1" + } + }, "compressible": { "version": "2.0.18", "resolved": "https://registry.npmjs.org/compressible/-/compressible-2.0.18.tgz", @@ -19918,6 +21284,15 @@ "resolved": "https://registry.npmjs.org/decode-uri-component/-/decode-uri-component-0.2.0.tgz", "integrity": "sha1-6zkTMzRYd1y4TNGh+uBiEGu4dUU=" }, + "decompress-response": { + "version": "5.0.0", + "resolved": "https://registry.npmjs.org/decompress-response/-/decompress-response-5.0.0.tgz", + "integrity": "sha512-TLZWWybuxWgoW7Lykv+gq9xvzOsUjQ9tF09Tj6NSTYGMTCHNXzrPnD6Hi+TgZq19PyTAGH4Ll/NIM/eTGglnMw==", + "dev": true, + "requires": { + "mimic-response": "^2.0.0" + } + }, "deep-equal": { "version": "0.2.2", "resolved": "https://registry.npmjs.org/deep-equal/-/deep-equal-0.2.2.tgz", @@ -19934,6 +21309,21 @@ "ip-regex": "^2.1.0" } }, + "defaults": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/defaults/-/defaults-1.0.3.tgz", + "integrity": "sha1-xlYFHpgX2f8I7YgUd/P+QBnz730=", + "dev": true, + "requires": { + "clone": "^1.0.2" + } + }, + "defer-to-connect": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/defer-to-connect/-/defer-to-connect-2.0.1.tgz", + "integrity": "sha512-4tvttepXG1VaYGrRibk5EwJd1t4udunSOVMdLSAL6mId1ix438oPwPZMALY41FCijukO1L0twNcGsdzS7dHgDg==", + "dev": true + }, "define-properties": { "version": "1.1.3", "resolved": "https://registry.npmjs.org/define-properties/-/define-properties-1.1.3.tgz", @@ -20235,6 +21625,12 @@ "integrity": "sha512-jtD6YG370ZCIi/9GTaJKQxWTZD045+4R4hTk/x1UyoqadyJ9x9CgSi1RlVDQF8U2sxLLSnFkCaMihqljHIWgMg==", "dev": true }, + "duplexer3": { + "version": "0.1.4", + "resolved": "https://registry.npmjs.org/duplexer3/-/duplexer3-0.1.4.tgz", + "integrity": "sha1-7gHdHKwO08vH/b6jfcCo8c4ALOI=", + "dev": true + }, "duplexify": { "version": "3.7.1", "resolved": "https://registry.npmjs.org/duplexify/-/duplexify-3.7.1.tgz", @@ -20551,6 +21947,256 @@ "binwrap": "^0.2.3" } }, + "elm-review": { + "version": "2.7.1", + "resolved": "https://registry.npmjs.org/elm-review/-/elm-review-2.7.1.tgz", + "integrity": "sha512-leDgjvE6ldYSOG/jMLmMw2g1vRnrd9nH9mnQcJt57SY2F4FnZT2hfIbuIUBXPaBwhWwC0a6BRt+Jv/2sGOG03A==", + "dev": true, + "requires": { + "chalk": "^4.0.0", + "chokidar": "^3.5.2", + "cross-spawn": "^7.0.3", + "elm-tooling": "^1.6.0", + "fast-levenshtein": "^3.0.0", + "find-up": "^4.1.0", + "folder-hash": "^3.3.0", + "fs-extra": "^9.0.0", + "glob": "^7.1.4", + "got": "^10.7.0", + "minimist": "^1.2.0", + "ora": "^5.4.0", + "path-key": "^3.1.1", + "prompts": "^2.2.1", + "strip-ansi": "^6.0.0", + "temp": "^0.9.1", + "terminal-link": "^2.1.1", + "which": "^2.0.2", + "wrap-ansi": "^6.2.0" + }, + "dependencies": { + "ansi-styles": { + "version": "4.3.0", + "resolved": "https://registry.npmjs.org/ansi-styles/-/ansi-styles-4.3.0.tgz", + "integrity": "sha512-zbB9rCJAT1rbjiVDb2hqKFHNYLxgtk8NURxZ3IZwD3F6NtxbXZQCnnSi1Lkx+IDohdPlFp222wVALIheZJQSEg==", + "dev": true, + "requires": { + "color-convert": "^2.0.1" + } + }, + "anymatch": { + "version": "3.1.2", + "resolved": "https://registry.npmjs.org/anymatch/-/anymatch-3.1.2.tgz", + "integrity": "sha512-P43ePfOAIupkguHUycrc4qJ9kz8ZiuOUijaETwX7THt0Y/GNK7v0aa8rY816xWjZ7rJdA5XdMcpVFTKMq+RvWg==", + "dev": true, + "requires": { + "normalize-path": "^3.0.0", + "picomatch": "^2.0.4" + } + }, + "binary-extensions": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/binary-extensions/-/binary-extensions-2.2.0.tgz", + "integrity": "sha512-jDctJ/IVQbZoJykoeHbhXpOlNBqGNcwXJKJog42E5HDPUwQTSdjCHdihjj0DlnheQ7blbT6dHOafNAiS8ooQKA==", + "dev": true + }, + "braces": { + "version": "3.0.2", + "resolved": "https://registry.npmjs.org/braces/-/braces-3.0.2.tgz", + "integrity": "sha512-b8um+L1RzM3WDSzvhm6gIz1yfTbBt6YTlcEKAvsmqCZZFw46z626lVj9j1yEPW33H5H+lBQpZMP1k8l+78Ha0A==", + "dev": true, + "requires": { + "fill-range": "^7.0.1" + } + }, + "chalk": { + "version": "4.1.2", + "resolved": "https://registry.npmjs.org/chalk/-/chalk-4.1.2.tgz", + "integrity": "sha512-oKnbhFyRIXpUuez8iBMmyEa4nbj4IOQyuhc/wy9kY7/WVPcwIO9VA668Pu8RkO7+0G76SLROeyw9CpQ061i4mA==", + "dev": true, + "requires": { + "ansi-styles": "^4.1.0", + "supports-color": "^7.1.0" + } + }, + "chokidar": { + "version": "3.5.3", + "resolved": "https://registry.npmjs.org/chokidar/-/chokidar-3.5.3.tgz", + "integrity": "sha512-Dr3sfKRP6oTcjf2JmUmFJfeVMvXBdegxB0iVQ5eb2V10uFJUCAS8OByZdVAyVb8xXNz3GjjTgj9kLWsZTqE6kw==", + "dev": true, + "requires": { + "anymatch": "~3.1.2", + "braces": "~3.0.2", + "fsevents": "~2.3.2", + "glob-parent": "~5.1.2", + "is-binary-path": "~2.1.0", + "is-glob": "~4.0.1", + "normalize-path": "~3.0.0", + "readdirp": "~3.6.0" + } + }, + "color-convert": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/color-convert/-/color-convert-2.0.1.tgz", + "integrity": "sha512-RRECPsj7iu/xb5oKYcsFHSppFNnsj/52OVTRKb4zP5onXwVF3zVmmToNcOfGC+CRDpfK/U584fMg38ZHCaElKQ==", + "dev": true, + "requires": { + "color-name": "~1.1.4" + } + }, + "color-name": { + "version": "1.1.4", + "resolved": "https://registry.npmjs.org/color-name/-/color-name-1.1.4.tgz", + "integrity": "sha512-dOy+3AuW3a2wNbZHIuMZpTcgjGuLU/uBL/ubcZF9OXbDo8ff4O8yVp5Bf0efS8uEoYo5q4Fx7dY9OgQGXgAsQA==", + "dev": true + }, + "fill-range": { + "version": "7.0.1", + "resolved": "https://registry.npmjs.org/fill-range/-/fill-range-7.0.1.tgz", + "integrity": "sha512-qOo9F+dMUmC2Lcb4BbVvnKJxTPjCm+RRpe4gDuGrzkL7mEVl/djYSu2OdQ2Pa302N4oqkSg9ir6jaLWJ2USVpQ==", + "dev": true, + "requires": { + "to-regex-range": "^5.0.1" + } + }, + "find-up": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/find-up/-/find-up-4.1.0.tgz", + "integrity": "sha512-PpOwAdQ/YlXQ2vj8a3h8IipDuYRi3wceVQQGYWxNINccq40Anw7BlsEXCMbt1Zt+OLA6Fq9suIpIWD0OsnISlw==", + "dev": true, + "requires": { + "locate-path": "^5.0.0", + "path-exists": "^4.0.0" + } + }, + "fs-extra": { + "version": "9.1.0", + "resolved": "https://registry.npmjs.org/fs-extra/-/fs-extra-9.1.0.tgz", + "integrity": "sha512-hcg3ZmepS30/7BSFqRvoo3DOMQu7IjqxO5nCDt+zM9XWjb33Wg7ziNT+Qvqbuc3+gWpzO02JubVyk2G4Zvo1OQ==", + "dev": true, + "requires": { + "at-least-node": "^1.0.0", + "graceful-fs": "^4.2.0", + "jsonfile": "^6.0.1", + "universalify": "^2.0.0" + } + }, + "fsevents": { + "version": "2.3.2", + "resolved": "https://registry.npmjs.org/fsevents/-/fsevents-2.3.2.tgz", + "integrity": "sha512-xiqMQR4xAeHTuB9uWm+fFRcIOgKBMiOBP+eXiyT7jsgVCq1bkVygt00oASowB7EdtpOHaaPgKt812P9ab+DDKA==", + "dev": true, + "optional": true + }, + "glob-parent": { + "version": "5.1.2", + "resolved": "https://registry.npmjs.org/glob-parent/-/glob-parent-5.1.2.tgz", + "integrity": "sha512-AOIgSQCepiJYwP3ARnGx+5VnTu2HBYdzbGP45eLw1vr3zB3vZLeyed1sC9hnbcOc9/SrMyM5RPQrkGz4aS9Zow==", + "dev": true, + "requires": { + "is-glob": "^4.0.1" + } + }, + "has-flag": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/has-flag/-/has-flag-4.0.0.tgz", + "integrity": "sha512-EykJT/Q1KjTWctppgIAgfSO0tKVuZUjhgMr17kqTumMl6Afv3EISleU7qZUzoXDFTAHTDC4NOoG/ZxU3EvlMPQ==", + "dev": true + }, + "is-binary-path": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/is-binary-path/-/is-binary-path-2.1.0.tgz", + "integrity": "sha512-ZMERYes6pDydyuGidse7OsHxtbI7WVeUEozgR/g7rd0xUimYNlvZRE/K2MgZTjWy725IfelLeVcEM97mmtRGXw==", + "dev": true, + "requires": { + "binary-extensions": "^2.0.0" + } + }, + "is-number": { + "version": "7.0.0", + "resolved": "https://registry.npmjs.org/is-number/-/is-number-7.0.0.tgz", + "integrity": "sha512-41Cifkg6e8TylSpdtTpeLVMqvSBEVzTttHvERD741+pnZ8ANv0004MRL43QKPDlK9cGvNp6NZWZUBlbGXYxxng==", + "dev": true + }, + "jsonfile": { + "version": "6.1.0", + "resolved": "https://registry.npmjs.org/jsonfile/-/jsonfile-6.1.0.tgz", + "integrity": "sha512-5dgndWOriYSm5cnYaJNhalLNDKOqFwyDB/rr1E9ZsGciGvKPs8R2xYGCacuf3z6K1YKDz182fd+fY3cn3pMqXQ==", + "dev": true, + "requires": { + "graceful-fs": "^4.1.6", + "universalify": "^2.0.0" + } + }, + "locate-path": { + "version": "5.0.0", + "resolved": "https://registry.npmjs.org/locate-path/-/locate-path-5.0.0.tgz", + "integrity": "sha512-t7hw9pI+WvuwNJXwk5zVHpyhIqzg2qTlklJOf0mVxGSbe3Fp2VieZcduNYjaLDoy6p9uGpQEGWG87WpMKlNq8g==", + "dev": true, + "requires": { + "p-locate": "^4.1.0" + } + }, + "p-locate": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/p-locate/-/p-locate-4.1.0.tgz", + "integrity": "sha512-R79ZZ/0wAxKGu3oYMlz8jy/kbhsNrS7SKZ7PxEHBgJ5+F2mtFW2fK2cOtBh1cHYkQsbzFV7I+EoRKe6Yt0oK7A==", + "dev": true, + "requires": { + "p-limit": "^2.2.0" + } + }, + "path-exists": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/path-exists/-/path-exists-4.0.0.tgz", + "integrity": "sha512-ak9Qy5Q7jYb2Wwcey5Fpvg2KoAc/ZIhLSLOSBmRmygPsGwkVVt0fZa0qrtMz+m6tJTAHfZQ8FnmB4MG4LWy7/w==", + "dev": true + }, + "readdirp": { + "version": "3.6.0", + "resolved": "https://registry.npmjs.org/readdirp/-/readdirp-3.6.0.tgz", + "integrity": "sha512-hOS089on8RduqdbhvQ5Z37A0ESjsqz6qnRcffsMU3495FuTdqSm+7bhJ29JvIOsBDEEnan5DPu9t3To9VRlMzA==", + "dev": true, + "requires": { + "picomatch": "^2.2.1" + } + }, + "supports-color": { + "version": "7.2.0", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-7.2.0.tgz", + "integrity": "sha512-qpCAvRl9stuOHveKsn7HncJRvv501qIacKzQlO/+Lwxc9+0q2wLyv4Dfvt80/DPn2pqOBsJdDiogXGR9+OvwRw==", + "dev": true, + "requires": { + "has-flag": "^4.0.0" + } + }, + "to-regex-range": { + "version": "5.0.1", + "resolved": "https://registry.npmjs.org/to-regex-range/-/to-regex-range-5.0.1.tgz", + "integrity": "sha512-65P7iz6X5yEr1cwcgvQxbbIw7Uk3gOy5dIdtZ4rDveLqhrdJP+Li/Hx6tyK0NEb+2GCyneCMJiGqrADCSNk8sQ==", + "dev": true, + "requires": { + "is-number": "^7.0.0" + } + }, + "universalify": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/universalify/-/universalify-2.0.0.tgz", + "integrity": "sha512-hAZsKq7Yy11Zu1DE0OzWjw7nnLZmJZYTDZZyEFHZdUhV8FkH5MCfoU1XMaxXovpyW5nq5scPqq0ZDP9Zyl04oQ==", + "dev": true + }, + "wrap-ansi": { + "version": "6.2.0", + "resolved": "https://registry.npmjs.org/wrap-ansi/-/wrap-ansi-6.2.0.tgz", + "integrity": "sha512-r6lPcBGxZXlIcymEu7InxDMhdW0KDxpLgoFLcguasxCaJ/SOIZwINatK9KY/tf+ZrlywOKU0UDj3ATXUBfxJXA==", + "dev": true, + "requires": { + "ansi-styles": "^4.0.0", + "string-width": "^4.1.0", + "strip-ansi": "^6.0.0" + } + } + } + }, "elm-test": { "version": "0.19.1-revision7", "resolved": "https://registry.npmjs.org/elm-test/-/elm-test-0.19.1-revision7.tgz", @@ -21219,6 +22865,21 @@ "resolved": "https://registry.npmjs.org/fast-json-stable-stringify/-/fast-json-stable-stringify-2.1.0.tgz", "integrity": "sha512-lhd/wF+Lk98HZoTCtlVraHtfh5XYijIjalXck7saUtuanSDyLMxnHhSXEDJqHxD7msR8D0uCmqlkwjCV8xvwHw==" }, + "fast-levenshtein": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/fast-levenshtein/-/fast-levenshtein-3.0.0.tgz", + "integrity": "sha512-hKKNajm46uNmTlhHSyZkmToAc56uZJwYq7yrciZjqOxnlfQwERDQJmHPUp7m1m9wx8vgOe8IaCKZ5Kv2k1DdCQ==", + "dev": true, + "requires": { + "fastest-levenshtein": "^1.0.7" + } + }, + "fastest-levenshtein": { + "version": "1.0.12", + "resolved": "https://registry.npmjs.org/fastest-levenshtein/-/fastest-levenshtein-1.0.12.tgz", + "integrity": "sha512-On2N+BpYJ15xIC974QNVuYGMOlEVt4s0EOI3wwMqOmK1fdDY+FN/zltPV8vosq4ad4c/gJ1KHScUn/6AWIgiow==", + "dev": true + }, "fastparse": { "version": "1.1.2", "resolved": "https://registry.npmjs.org/fastparse/-/fastparse-1.1.2.tgz", @@ -21367,6 +23028,34 @@ "readable-stream": "^2.3.6" } }, + "folder-hash": { + "version": "3.3.3", + "resolved": "https://registry.npmjs.org/folder-hash/-/folder-hash-3.3.3.tgz", + "integrity": "sha512-SDgHBgV+RCjrYs8aUwCb9rTgbTVuSdzvFmLaChsLre1yf+D64khCW++VYciaByZ8Rm0uKF8R/XEpXuTRSGUM1A==", + "dev": true, + "requires": { + "debug": "^4.1.1", + "graceful-fs": "~4.2.0", + "minimatch": "~3.0.4" + }, + "dependencies": { + "debug": { + "version": "4.3.4", + "resolved": "https://registry.npmjs.org/debug/-/debug-4.3.4.tgz", + "integrity": "sha512-PRWFHuSU3eDtQJPvnNY7Jcket1j0t5OuOsFzPPzsekD52Zl8qUfFIPEiswXqIvHWGVHOgX+7G/vCNNhehwxfkQ==", + "dev": true, + "requires": { + "ms": "2.1.2" + } + }, + "ms": { + "version": "2.1.2", + "resolved": "https://registry.npmjs.org/ms/-/ms-2.1.2.tgz", + "integrity": "sha512-sGkPx+VjMtmA6MX27oA4FBFELFCZZ4S4XqeGOXCv68tT+jb3vk/RyaKWP0PTKyWtmLSM0b+adUTEvbs1PEaH2w==", + "dev": true + } + } + }, "follow-redirects": { "version": "1.14.9", "resolved": "https://registry.npmjs.org/follow-redirects/-/follow-redirects-1.14.9.tgz", @@ -21639,6 +23328,40 @@ } } }, + "got": { + "version": "10.7.0", + "resolved": "https://registry.npmjs.org/got/-/got-10.7.0.tgz", + "integrity": "sha512-aWTDeNw9g+XqEZNcTjMMZSy7B7yE9toWOFYip7ofFTLleJhvZwUxxTxkTpKvF+p1SAA4VHmuEy7PiHTHyq8tJg==", + "dev": true, + "requires": { + "@sindresorhus/is": "^2.0.0", + "@szmarczak/http-timer": "^4.0.0", + "@types/cacheable-request": "^6.0.1", + "cacheable-lookup": "^2.0.0", + "cacheable-request": "^7.0.1", + "decompress-response": "^5.0.0", + "duplexer3": "^0.1.4", + "get-stream": "^5.0.0", + "lowercase-keys": "^2.0.0", + "mimic-response": "^2.1.0", + "p-cancelable": "^2.0.0", + "p-event": "^4.0.0", + "responselike": "^2.0.0", + "to-readable-stream": "^2.0.0", + "type-fest": "^0.10.0" + }, + "dependencies": { + "get-stream": { + "version": "5.2.0", + "resolved": "https://registry.npmjs.org/get-stream/-/get-stream-5.2.0.tgz", + "integrity": "sha512-nBF+F1rAZVCu/p7rjzgA+Yb4lfYXrpl7a6VmJrU8wF9I1CKvP/QwPNZHnOlwbTkY6dvtFIzFMSyQXbLoTQPRpA==", + "dev": true, + "requires": { + "pump": "^3.0.0" + } + } + } + }, "graceful-fs": { "version": "4.2.4", "resolved": "https://registry.npmjs.org/graceful-fs/-/graceful-fs-4.2.4.tgz", @@ -21894,6 +23617,12 @@ } } }, + "http-cache-semantics": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/http-cache-semantics/-/http-cache-semantics-4.1.0.tgz", + "integrity": "sha512-carPklcUh7ROWRK7Cv27RPtdhYhUsela/ue5/jKzjegVvXDqM2ILE9Q2BGn9JZJh1g87cp56su/FgQSzcWS8cQ==", + "dev": true + }, "http-deceiver": { "version": "1.2.7", "resolved": "https://registry.npmjs.org/http-deceiver/-/http-deceiver-1.2.7.tgz", @@ -22388,6 +24117,12 @@ "is-extglob": "^2.1.1" } }, + "is-interactive": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/is-interactive/-/is-interactive-1.0.0.tgz", + "integrity": "sha512-2HvIEKRoqS62guEC+qBjpvRubdX910WCMuJTZ+I9yvqKU2/12eSL549HMwtabb4oupdj2sMP50k+XJfB/8JE6w==", + "dev": true + }, "is-number": { "version": "3.0.0", "resolved": "https://registry.npmjs.org/is-number/-/is-number-3.0.0.tgz", @@ -22497,6 +24232,12 @@ "resolved": "https://registry.npmjs.org/is-typedarray/-/is-typedarray-1.0.0.tgz", "integrity": "sha1-5HnICFjfDBsR3dppQPlgEfzaSpo=" }, + "is-unicode-supported": { + "version": "0.1.0", + "resolved": "https://registry.npmjs.org/is-unicode-supported/-/is-unicode-supported-0.1.0.tgz", + "integrity": "sha512-knxG2q4UC3u8stRGyAVJCOdxFmv5DZiRcdlIaAQXAbSfJya+OhopNotLQrstBhququ4ZpuKbDc/8S6mgXgPFPw==", + "dev": true + }, "is-utf8": { "version": "0.2.1", "resolved": "https://registry.npmjs.org/is-utf8/-/is-utf8-0.2.1.tgz", @@ -22561,6 +24302,12 @@ "integrity": "sha512-OYu7XEzjkCQ3C5Ps3QIZsQfNpqoJyZZA99wd9aWd05NCtC5pWOkShK2mkL6HXQR6/Cy2lbNdPlZBpuQHXE63gA==", "dev": true }, + "json-buffer": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/json-buffer/-/json-buffer-3.0.1.tgz", + "integrity": "sha512-4bV5BfR2mqfQTJm+V5tPPdf+ZpuhiIvTuAB5g8kcrXOZpTT/QwwVRWBywX1ozr6lEuPdbHxwaJlm9G6mI2sfSQ==", + "dev": true + }, "json-parse-better-errors": { "version": "1.0.2", "resolved": "https://registry.npmjs.org/json-parse-better-errors/-/json-parse-better-errors-1.0.2.tgz", @@ -22634,6 +24381,16 @@ "verror": "1.10.0" } }, + "keyv": { + "version": "4.2.2", + "resolved": "https://registry.npmjs.org/keyv/-/keyv-4.2.2.tgz", + "integrity": "sha512-uYS0vKTlBIjNCAUqrjlxmruxOEiZxZIHXyp32sdcGmP+ukFrmWUnE//RcPXJH3Vxrni1H2gsQbjHE0bH7MtMQQ==", + "dev": true, + "requires": { + "compress-brotli": "^1.3.6", + "json-buffer": "3.0.1" + } + }, "killable": { "version": "1.0.1", "resolved": "https://registry.npmjs.org/killable/-/killable-1.0.1.tgz", @@ -22645,6 +24402,12 @@ "resolved": "https://registry.npmjs.org/kind-of/-/kind-of-6.0.3.tgz", "integrity": "sha512-dcS1ul+9tmeD95T+x28/ehLgd9mENa3LsvDTtzm3vyBEO7RPptvAD+t44WVXaUjTBRcrpFeFlC8WCruUR456hw==" }, + "kleur": { + "version": "3.0.3", + "resolved": "https://registry.npmjs.org/kleur/-/kleur-3.0.3.tgz", + "integrity": "sha512-eTIzlVOSUR+JxdDFepEYcBMtZ9Qqdef+rnzWdRZuMbOywu5tO2w2N7rqjoANZ5k9vywhL6Br1VRjUIgTQx4E8w==", + "dev": true + }, "klona": { "version": "2.0.5", "resolved": "https://registry.npmjs.org/klona/-/klona-2.0.5.tgz", @@ -22800,6 +24563,67 @@ "integrity": "sha512-U7KCmLdqsGHBLeWqYlFA0V0Sl6P08EE1ZrmA9cxjUE0WVqT9qnyVDPz1kzpFEP0jdJuFnasWIfSd7fsaNXkpbg==", "dev": true }, + "log-symbols": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/log-symbols/-/log-symbols-4.1.0.tgz", + "integrity": "sha512-8XPvpAA8uyhfteu8pIvQxpJZ7SYYdpUivZpGy6sFsBuKRY/7rQGavedeB8aK+Zkyq6upMFVL/9AW6vOYzfRyLg==", + "dev": true, + "requires": { + "chalk": "^4.1.0", + "is-unicode-supported": "^0.1.0" + }, + "dependencies": { + "ansi-styles": { + "version": "4.3.0", + "resolved": "https://registry.npmjs.org/ansi-styles/-/ansi-styles-4.3.0.tgz", + "integrity": "sha512-zbB9rCJAT1rbjiVDb2hqKFHNYLxgtk8NURxZ3IZwD3F6NtxbXZQCnnSi1Lkx+IDohdPlFp222wVALIheZJQSEg==", + "dev": true, + "requires": { + "color-convert": "^2.0.1" + } + }, + "chalk": { + "version": "4.1.2", + "resolved": "https://registry.npmjs.org/chalk/-/chalk-4.1.2.tgz", + "integrity": "sha512-oKnbhFyRIXpUuez8iBMmyEa4nbj4IOQyuhc/wy9kY7/WVPcwIO9VA668Pu8RkO7+0G76SLROeyw9CpQ061i4mA==", + "dev": true, + "requires": { + "ansi-styles": "^4.1.0", + "supports-color": "^7.1.0" + } + }, + "color-convert": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/color-convert/-/color-convert-2.0.1.tgz", + "integrity": "sha512-RRECPsj7iu/xb5oKYcsFHSppFNnsj/52OVTRKb4zP5onXwVF3zVmmToNcOfGC+CRDpfK/U584fMg38ZHCaElKQ==", + "dev": true, + "requires": { + "color-name": "~1.1.4" + } + }, + "color-name": { + "version": "1.1.4", + "resolved": "https://registry.npmjs.org/color-name/-/color-name-1.1.4.tgz", + "integrity": "sha512-dOy+3AuW3a2wNbZHIuMZpTcgjGuLU/uBL/ubcZF9OXbDo8ff4O8yVp5Bf0efS8uEoYo5q4Fx7dY9OgQGXgAsQA==", + "dev": true + }, + "has-flag": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/has-flag/-/has-flag-4.0.0.tgz", + "integrity": "sha512-EykJT/Q1KjTWctppgIAgfSO0tKVuZUjhgMr17kqTumMl6Afv3EISleU7qZUzoXDFTAHTDC4NOoG/ZxU3EvlMPQ==", + "dev": true + }, + "supports-color": { + "version": "7.2.0", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-7.2.0.tgz", + "integrity": "sha512-qpCAvRl9stuOHveKsn7HncJRvv501qIacKzQlO/+Lwxc9+0q2wLyv4Dfvt80/DPn2pqOBsJdDiogXGR9+OvwRw==", + "dev": true, + "requires": { + "has-flag": "^4.0.0" + } + } + } + }, "loglevel": { "version": "1.6.8", "resolved": "https://registry.npmjs.org/loglevel/-/loglevel-1.6.8.tgz", @@ -22823,6 +24647,12 @@ } } }, + "lowercase-keys": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/lowercase-keys/-/lowercase-keys-2.0.0.tgz", + "integrity": "sha512-tqNXrS78oMOE73NMxK4EMLQsQowWf8jKooH9g7xPavRT706R6bkQJ6DY2Te7QukaZsulxa30wQ7bk0pm4XiHmA==", + "dev": true + }, "lru-cache": { "version": "5.1.1", "resolved": "https://registry.npmjs.org/lru-cache/-/lru-cache-5.1.1.tgz", @@ -22972,6 +24802,12 @@ "integrity": "sha512-jf84uxzwiuiIVKiOLpfYk7N46TSy8ubTonmneY9vrpHNAnp0QBt2BxWV9dO3/j+BoVAb+a5G6YDPW3M5HOdMWQ==", "dev": true }, + "mimic-response": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/mimic-response/-/mimic-response-2.1.0.tgz", + "integrity": "sha512-wXqjST+SLt7R009ySCglWBCFpjUygmCIfD790/kVbiGmUgfYGuB14PiTd5DwVxSV4NcYHjzMkoj5LjQZwTQLEA==", + "dev": true + }, "mini-css-extract-plugin": { "version": "0.12.0", "resolved": "https://registry.npmjs.org/mini-css-extract-plugin/-/mini-css-extract-plugin-0.12.0.tgz", @@ -23568,6 +25404,108 @@ "last-call-webpack-plugin": "^3.0.0" } }, + "ora": { + "version": "5.4.1", + "resolved": "https://registry.npmjs.org/ora/-/ora-5.4.1.tgz", + "integrity": "sha512-5b6Y85tPxZZ7QytO+BQzysW31HJku27cRIlkbAXaNx+BdcVi+LlRFmVXzeF6a7JCwJpyw5c4b+YSVImQIrBpuQ==", + "dev": true, + "requires": { + "bl": "^4.1.0", + "chalk": "^4.1.0", + "cli-cursor": "^3.1.0", + "cli-spinners": "^2.5.0", + "is-interactive": "^1.0.0", + "is-unicode-supported": "^0.1.0", + "log-symbols": "^4.1.0", + "strip-ansi": "^6.0.0", + "wcwidth": "^1.0.1" + }, + "dependencies": { + "ansi-styles": { + "version": "4.3.0", + "resolved": "https://registry.npmjs.org/ansi-styles/-/ansi-styles-4.3.0.tgz", + "integrity": "sha512-zbB9rCJAT1rbjiVDb2hqKFHNYLxgtk8NURxZ3IZwD3F6NtxbXZQCnnSi1Lkx+IDohdPlFp222wVALIheZJQSEg==", + "dev": true, + "requires": { + "color-convert": "^2.0.1" + } + }, + "chalk": { + "version": "4.1.2", + "resolved": "https://registry.npmjs.org/chalk/-/chalk-4.1.2.tgz", + "integrity": "sha512-oKnbhFyRIXpUuez8iBMmyEa4nbj4IOQyuhc/wy9kY7/WVPcwIO9VA668Pu8RkO7+0G76SLROeyw9CpQ061i4mA==", + "dev": true, + "requires": { + "ansi-styles": "^4.1.0", + "supports-color": "^7.1.0" + } + }, + "cli-cursor": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/cli-cursor/-/cli-cursor-3.1.0.tgz", + "integrity": "sha512-I/zHAwsKf9FqGoXM4WWRACob9+SNukZTd94DWF57E4toouRulbCxcUh6RKUEOQlYTHJnzkPMySvPNaaSLNfLZw==", + "dev": true, + "requires": { + "restore-cursor": "^3.1.0" + } + }, + "color-convert": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/color-convert/-/color-convert-2.0.1.tgz", + "integrity": "sha512-RRECPsj7iu/xb5oKYcsFHSppFNnsj/52OVTRKb4zP5onXwVF3zVmmToNcOfGC+CRDpfK/U584fMg38ZHCaElKQ==", + "dev": true, + "requires": { + "color-name": "~1.1.4" + } + }, + "color-name": { + "version": "1.1.4", + "resolved": "https://registry.npmjs.org/color-name/-/color-name-1.1.4.tgz", + "integrity": "sha512-dOy+3AuW3a2wNbZHIuMZpTcgjGuLU/uBL/ubcZF9OXbDo8ff4O8yVp5Bf0efS8uEoYo5q4Fx7dY9OgQGXgAsQA==", + "dev": true + }, + "has-flag": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/has-flag/-/has-flag-4.0.0.tgz", + "integrity": "sha512-EykJT/Q1KjTWctppgIAgfSO0tKVuZUjhgMr17kqTumMl6Afv3EISleU7qZUzoXDFTAHTDC4NOoG/ZxU3EvlMPQ==", + "dev": true + }, + "mimic-fn": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/mimic-fn/-/mimic-fn-2.1.0.tgz", + "integrity": "sha512-OqbOk5oEQeAZ8WXWydlu9HJjz9WVdEIvamMCcXmuqUYjTknH/sqsWvhQ3vgwKFRR1HpjvNBKQ37nbJgYzGqGcg==", + "dev": true + }, + "onetime": { + "version": "5.1.2", + "resolved": "https://registry.npmjs.org/onetime/-/onetime-5.1.2.tgz", + "integrity": "sha512-kbpaSSGJTWdAY5KPVeMOKXSrPtr8C8C7wodJbcsd51jRnmD+GZu8Y0VoU6Dm5Z4vWr0Ig/1NKuWRKf7j5aaYSg==", + "dev": true, + "requires": { + "mimic-fn": "^2.1.0" + } + }, + "restore-cursor": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/restore-cursor/-/restore-cursor-3.1.0.tgz", + "integrity": "sha512-l+sSefzHpj5qimhFSE5a8nufZYAM3sBSVMAPtYkmC+4EH2anSGaEMXSD0izRQbu9nfyQ9y5JrVmp7E8oZrUjvA==", + "dev": true, + "requires": { + "onetime": "^5.1.0", + "signal-exit": "^3.0.2" + } + }, + "supports-color": { + "version": "7.2.0", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-7.2.0.tgz", + "integrity": "sha512-qpCAvRl9stuOHveKsn7HncJRvv501qIacKzQlO/+Lwxc9+0q2wLyv4Dfvt80/DPn2pqOBsJdDiogXGR9+OvwRw==", + "dev": true, + "requires": { + "has-flag": "^4.0.0" + } + } + } + }, "original": { "version": "1.0.2", "resolved": "https://registry.npmjs.org/original/-/original-1.0.2.tgz", @@ -23597,6 +25535,21 @@ "integrity": "sha1-u+Z0BseaqFxc/sdm/lc0VV36EnQ=", "dev": true }, + "p-cancelable": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/p-cancelable/-/p-cancelable-2.1.1.tgz", + "integrity": "sha512-BZOr3nRQHOntUjTrH8+Lh54smKHoHyur8We1V8DSMVrl5A2malOOwuJRnKRDjSnkoeBh4at6BwEnb5I7Jl31wg==", + "dev": true + }, + "p-event": { + "version": "4.2.0", + "resolved": "https://registry.npmjs.org/p-event/-/p-event-4.2.0.tgz", + "integrity": "sha512-KXatOjCRXXkSePPb1Nbi0p0m+gQAwdlbhi4wQKJPI1HsMQS9g+Sqp2o+QHziPr7eYJyOZet836KoHEVM1mwOrQ==", + "dev": true, + "requires": { + "p-timeout": "^3.1.0" + } + }, "p-finally": { "version": "1.0.0", "resolved": "https://registry.npmjs.org/p-finally/-/p-finally-1.0.0.tgz", @@ -23634,6 +25587,15 @@ "retry": "^0.12.0" } }, + "p-timeout": { + "version": "3.2.0", + "resolved": "https://registry.npmjs.org/p-timeout/-/p-timeout-3.2.0.tgz", + "integrity": "sha512-rhIwUycgwwKcP9yTOOFK/AKsAopjjCakVqLHePO3CC6Mir1Z99xT+R63jZxAT5lFZLa2inS5h+ZS2GvR99/FBg==", + "dev": true, + "requires": { + "p-finally": "^1.0.0" + } + }, "p-try": { "version": "2.2.0", "resolved": "https://registry.npmjs.org/p-try/-/p-try-2.2.0.tgz", @@ -25242,6 +27204,16 @@ } } }, + "prompts": { + "version": "2.4.2", + "resolved": "https://registry.npmjs.org/prompts/-/prompts-2.4.2.tgz", + "integrity": "sha512-NxNv/kLguCA7p3jE8oL2aEBsrJWgAakBpgmgK6lpPWV+WuOmY6r2/zbAVnP+T8bQlA0nzHXSJSJW0Hq7ylaD2Q==", + "dev": true, + "requires": { + "kleur": "^3.0.3", + "sisteransi": "^1.0.5" + } + }, "proxy-addr": { "version": "2.0.6", "resolved": "https://registry.npmjs.org/proxy-addr/-/proxy-addr-2.0.6.tgz", @@ -25930,6 +27902,15 @@ "resolved": "https://registry.npmjs.org/resolve-url/-/resolve-url-0.2.1.tgz", "integrity": "sha1-LGN/53yJOv0qZj/iGqkIAGjiBSo=" }, + "responselike": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/responselike/-/responselike-2.0.0.tgz", + "integrity": "sha512-xH48u3FTB9VsZw7R+vvgaKeLKzT6jOogbQhEe/jewwnZgzPcnyWui2Av6JpoYZF/91uueC+lqhWqeURw5/qhCw==", + "dev": true, + "requires": { + "lowercase-keys": "^2.0.0" + } + }, "restore-cursor": { "version": "2.0.0", "resolved": "https://registry.npmjs.org/restore-cursor/-/restore-cursor-2.0.0.tgz", @@ -26256,6 +28237,12 @@ } } }, + "sisteransi": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/sisteransi/-/sisteransi-1.0.5.tgz", + "integrity": "sha512-bLGGlR1QxBcynn2d5YmDX4MGjlZvy2MRBDRNHLJ8VI6l6+9FUiyTFNJ0IveOSP0bcXgVDPRcfGqA0pjaqUpfVg==", + "dev": true + }, "slash": { "version": "2.0.0", "resolved": "https://registry.npmjs.org/slash/-/slash-2.0.0.tgz", @@ -26974,6 +28961,33 @@ "has-flag": "^3.0.0" } }, + "supports-hyperlinks": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/supports-hyperlinks/-/supports-hyperlinks-2.2.0.tgz", + "integrity": "sha512-6sXEzV5+I5j8Bmq9/vUphGRM/RJNT9SCURJLjwfOg51heRtguGWDzcaBlgAzKhQa0EVNpPEKzQuBwZ8S8WaCeQ==", + "dev": true, + "requires": { + "has-flag": "^4.0.0", + "supports-color": "^7.0.0" + }, + "dependencies": { + "has-flag": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/has-flag/-/has-flag-4.0.0.tgz", + "integrity": "sha512-EykJT/Q1KjTWctppgIAgfSO0tKVuZUjhgMr17kqTumMl6Afv3EISleU7qZUzoXDFTAHTDC4NOoG/ZxU3EvlMPQ==", + "dev": true + }, + "supports-color": { + "version": "7.2.0", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-7.2.0.tgz", + "integrity": "sha512-qpCAvRl9stuOHveKsn7HncJRvv501qIacKzQlO/+Lwxc9+0q2wLyv4Dfvt80/DPn2pqOBsJdDiogXGR9+OvwRw==", + "dev": true, + "requires": { + "has-flag": "^4.0.0" + } + } + } + }, "supports-preserve-symlinks-flag": { "version": "1.0.0", "resolved": "https://registry.npmjs.org/supports-preserve-symlinks-flag/-/supports-preserve-symlinks-flag-1.0.0.tgz", @@ -27134,6 +29148,33 @@ } } }, + "terminal-link": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/terminal-link/-/terminal-link-2.1.1.tgz", + "integrity": "sha512-un0FmiRUQNr5PJqy9kP7c40F5BOfpGlYTrxonDChEZB7pzZxRNp/bt+ymiy9/npwXya9KH99nJ/GXFIiUkYGFQ==", + "dev": true, + "requires": { + "ansi-escapes": "^4.2.1", + "supports-hyperlinks": "^2.0.0" + }, + "dependencies": { + "ansi-escapes": { + "version": "4.3.2", + "resolved": "https://registry.npmjs.org/ansi-escapes/-/ansi-escapes-4.3.2.tgz", + "integrity": "sha512-gKXj5ALrKWQLsYG9jlTRmR/xKluxHV+Z9QEwNIgCfM1/uwPMCuzVVnh5mwTd+OuBZcwSIMbqssNWRm1lE51QaQ==", + "dev": true, + "requires": { + "type-fest": "^0.21.3" + } + }, + "type-fest": { + "version": "0.21.3", + "resolved": "https://registry.npmjs.org/type-fest/-/type-fest-0.21.3.tgz", + "integrity": "sha512-t0rzBq87m3fVcduHDUFhKmyyX+9eo6WQjZvf51Ea/M0Q7+T374Jp1aUiyUl0GKxp8M/OETVHSDvmkyPgvX+X2w==", + "dev": true + } + } + }, "terser": { "version": "4.8.0", "resolved": "https://registry.npmjs.org/terser/-/terser-4.8.0.tgz", @@ -27258,6 +29299,12 @@ } } }, + "to-readable-stream": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/to-readable-stream/-/to-readable-stream-2.1.0.tgz", + "integrity": "sha512-o3Qa6DGg1CEXshSdvWNX2sN4QHqg03SPq7U6jPXRahlQdl5dK8oXjkU/2/sGrnOZKeGV1zLSO8qPwyKklPPE7w==", + "dev": true + }, "to-regex": { "version": "3.0.2", "resolved": "https://registry.npmjs.org/to-regex/-/to-regex-3.0.2.tgz", @@ -27336,6 +29383,12 @@ "resolved": "https://registry.npmjs.org/tweetnacl/-/tweetnacl-0.14.5.tgz", "integrity": "sha1-WuaBd/GS1EViadEIr6k/+HQ/T2Q=" }, + "type-fest": { + "version": "0.10.0", + "resolved": "https://registry.npmjs.org/type-fest/-/type-fest-0.10.0.tgz", + "integrity": "sha512-EUV9jo4sffrwlg8s0zDhP0T2WD3pru5Xi0+HTE3zTUmBaZNhfkite9PdSJwdXLwPVW0jnAHT56pZHIOYckPEiw==", + "dev": true + }, "type-is": { "version": "1.6.18", "resolved": "https://registry.npmjs.org/type-is/-/type-is-1.6.18.tgz", @@ -27991,6 +30044,15 @@ "minimalistic-assert": "^1.0.0" } }, + "wcwidth": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/wcwidth/-/wcwidth-1.0.1.tgz", + "integrity": "sha1-8LDc+RW8X/FSivrbLA4XtTLaL+g=", + "dev": true, + "requires": { + "defaults": "^1.0.3" + } + }, "webpack": { "version": "4.44.2", "resolved": "https://registry.npmjs.org/webpack/-/webpack-4.44.2.tgz", diff --git a/package.json b/package.json index 863c2ba..d1e1f17 100644 --- a/package.json +++ b/package.json @@ -23,7 +23,8 @@ "devDependencies": { "coveralls": "^3.1.1", "create-elm-app": "^5.22.0", - "elm-coverage": "^0.4.1" + "elm-coverage": "^0.4.1", + "elm-review": "^2.7.1" }, "dependencies": { "elm-json": "^0.2.12", From 620f76a0b83082ad900b3f7d7880c47dddc70fa9 Mon Sep 17 00:00:00 2001 From: Jerome Bergmann Date: Mon, 11 Apr 2022 21:15:50 +0200 Subject: [PATCH 06/15] Update .travis.yml is it necessary to install? --- .travis.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index b3965c6..8c9d987 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,7 +3,6 @@ language: elm sudo: required install: - - npm i elm-review - npm i create-elm-app -g - npm i elm-coverage -g #- npm i coveralls -g From f26d77991b4a34e03641b191f0e6062ea5787a55 Mon Sep 17 00:00:00 2001 From: Jerome Bergmann Date: Mon, 11 Apr 2022 21:22:25 +0200 Subject: [PATCH 07/15] it is necessary --- .travis.yml | 2 ++ src/Viewer/Tablet.elm | 6 ++++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index 8c9d987..b27576a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,10 +3,12 @@ language: elm sudo: required install: + - npm i elm-review - npm i create-elm-app -g - npm i elm-coverage -g #- npm i coveralls -g script: + - elm-format --verify - elm-review - elm-app test - elm-coverage diff --git a/src/Viewer/Tablet.elm b/src/Viewer/Tablet.elm index 4951819..a2070e1 100644 --- a/src/Viewer/Tablet.elm +++ b/src/Viewer/Tablet.elm @@ -7,7 +7,8 @@ import Material.Drawer.Modal as MDrawer import Material.TopAppBar as TopAppBar import Viewer.Internal as I - +{-| Display the interface in landscape mode. +-} viewLandscape : I.ViewerConfig msg -> List (Html msg) viewLandscape config = [ I.viewTopAppBar @@ -42,7 +43,8 @@ viewLandscape config = ] ] - +{-| Display the interface in portrait mode. +-} viewPortrait : I.ViewerConfig msg -> List (Html msg) viewPortrait config = -- [ topAppBar topAppBarConfig From 621c10e0625742af9122bddf913c21dbbca42dc2 Mon Sep 17 00:00:00 2001 From: Jerome Bergmann Date: Mon, 11 Apr 2022 21:38:11 +0200 Subject: [PATCH 08/15] Update .travis.yml trying to increase the timeout --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index b27576a..6b9b6e8 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,7 +3,7 @@ language: elm sudo: required install: - - npm i elm-review + - travis_wait npm i elm-review - npm i create-elm-app -g - npm i elm-coverage -g #- npm i coveralls -g From 0388279a82f436561f7d4b7f862c7b102eb6d597 Mon Sep 17 00:00:00 2001 From: Jerome Bergmann Date: Mon, 11 Apr 2022 21:52:32 +0200 Subject: [PATCH 09/15] Update .travis.yml trying to get elm-review running --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 6b9b6e8..e65e6d3 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,7 +3,7 @@ language: elm sudo: required install: - - travis_wait npm i elm-review + - npm install elm-review --loglevel verbose - npm i create-elm-app -g - npm i elm-coverage -g #- npm i coveralls -g From 75ac3bc83d8ebd24b3d04b69a970ab2226eb6b18 Mon Sep 17 00:00:00 2001 From: Jerome Bergmann Date: Mon, 11 Apr 2022 21:55:09 +0200 Subject: [PATCH 10/15] Update .travis.yml wrong flag --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index e65e6d3..2bc00f8 100644 --- a/.travis.yml +++ b/.travis.yml @@ -8,7 +8,7 @@ install: - npm i elm-coverage -g #- npm i coveralls -g script: - - elm-format --verify + - elm-format --validate - elm-review - elm-app test - elm-coverage From 566604820d73064cb88ed4f6a6c4ebb9e2a018fd Mon Sep 17 00:00:00 2001 From: Jerome Bergmann Date: Mon, 11 Apr 2022 22:06:41 +0200 Subject: [PATCH 11/15] playing with travis last try for today --- .travis.yml | 2 +- review/src/ReviewConfig.elm | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.travis.yml b/.travis.yml index 2bc00f8..90ae564 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,7 +3,7 @@ language: elm sudo: required install: - - npm install elm-review --loglevel verbose + - travis_wait npm i elm-review -g - npm i create-elm-app -g - npm i elm-coverage -g #- npm i coveralls -g diff --git a/review/src/ReviewConfig.elm b/review/src/ReviewConfig.elm index a876d8e..01fac14 100644 --- a/review/src/ReviewConfig.elm +++ b/review/src/ReviewConfig.elm @@ -60,8 +60,8 @@ config = , NoMissingTypeExpose.rule , NoPrematureLetComputation.rule , NoMissingTypeConstructor.rule - , NoMissingDocumentation.rule - |> Review.Rule.ignoreErrorsForDirectories [ "tests/" ] + -- , NoMissingDocumentation.rule + -- |> Review.Rule.ignoreErrorsForDirectories [ "tests/" ] , NoUnused.CustomTypeConstructors.rule [] |> Review.Rule.ignoreErrorsForDirectories [ "src/Type/IO/" ] , NoUnused.CustomTypeConstructorArgs.rule From 4cdd519baa98031798e783a74cb5fa265fdd923f Mon Sep 17 00:00:00 2001 From: Jerome Bergmann Date: Mon, 11 Apr 2022 22:10:18 +0200 Subject: [PATCH 12/15] Update .travis.yml elm format needs a path --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 90ae564..44f56ee 100644 --- a/.travis.yml +++ b/.travis.yml @@ -8,7 +8,7 @@ install: - npm i elm-coverage -g #- npm i coveralls -g script: - - elm-format --validate + - elm-format src/ --validate - elm-review - elm-app test - elm-coverage From b138ab7f6a4755af0daad4bcc9c625ef003ba11b Mon Sep 17 00:00:00 2001 From: Jerome Bergmann Date: Mon, 11 Apr 2022 22:11:54 +0200 Subject: [PATCH 13/15] Update .travis.yml build diet --- .travis.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.travis.yml b/.travis.yml index 44f56ee..0312892 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,13 +3,13 @@ language: elm sudo: required install: - - travis_wait npm i elm-review -g - - npm i create-elm-app -g + - npm i elm-review -g + #- npm i create-elm-app -g - npm i elm-coverage -g #- npm i coveralls -g script: - elm-format src/ --validate - elm-review - - elm-app test + #- elm-app test - elm-coverage #- cat ./.coverage/lcov.info | coveralls From 9e499e632d79b00f86f80f420c2f795642688fb0 Mon Sep 17 00:00:00 2001 From: Jerome Bergmann Date: Sun, 15 May 2022 11:33:45 +0200 Subject: [PATCH 14/15] filtered out empty questionaries --- src/Main.elm | 1 + src/Page/Code.elm | 11 +++++------ src/Page/Event.elm | 10 +++++++++- src/Viewer.elm | 2 +- 4 files changed, 16 insertions(+), 8 deletions(-) diff --git a/src/Main.elm b/src/Main.elm index 0c5c2e6..b438e05 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -872,6 +872,7 @@ parser model session = -- This holds the paths for each page. Update as needed for each page you add/remove +paths : { top : String, users : String, pageOne : String, pageWithSubpage : String, admin : String, study : String, event : String, questionary : String, question : String, coding_question : String } paths = { top = "" , users = "user" diff --git a/src/Page/Code.elm b/src/Page/Code.elm index 90f00f6..9fa4ed6 100644 --- a/src/Page/Code.elm +++ b/src/Page/Code.elm @@ -142,15 +142,14 @@ init id db = currentQuestion : Maybe CodingAnswerTemplate currentQuestion = - case currentAnswer of - Just ( _, cav ) -> + Maybe.andThen + (\( _, cav ) -> templates |> List.filter (\{ coding_questionId } -> coding_questionId == cav.value.coding_question) |> List.filter (\{ answerId } -> answerId == cav.value.answer) - |> List.head - - Nothing -> - Nothing + |> List.head) + currentAnswer + curID = Maybe.andThen (\x -> List.Extra.elemIndex x history) currentAnswer diff --git a/src/Page/Event.elm b/src/Page/Event.elm index 9255934..c143d06 100644 --- a/src/Page/Event.elm +++ b/src/Page/Event.elm @@ -348,13 +348,21 @@ relatedData id db = , created = Time.millisToPosix timestampedEvent.created , creator = ( timestampedEvent.creator, Maybe.map .value <| Dict.get (unbox timestampedEvent.creator) db.users ) , updated = Time.millisToPosix timestampedEvent.modified - , questionnaries = List.map (Tuple.mapFirst box) <| Dict.toList <| Dict.map (\_ y -> y.value) <| Dict.filter (\_ y -> y.value.study == event.study) db.questionnaries + , questionnaries = List.map (Tuple.mapFirst box) <| Dict.toList <| Dict.map (\_ y -> y.value) <| Dict.filter (\x _ -> isNonEmpty (box x) db) <| Dict.filter (\_ y -> y.value.study == event.study) db.questionnaries , test_subjects = List.map (Tuple.mapFirst box) <| Dict.toList <| Dict.map (\_ y -> y.value) <| Dict.filter (\_ y -> y.value.event == id) db.test_subjects } Nothing -> Nothing +isNonEmpty : Id Db.Questionary String -> Db.Database -> Bool +isNonEmpty id db = + Dict.filter (\_ x -> x.value.questionary == id) db.questions + |> Dict.filter(\_ x -> x.value.text /= "Unnamed Question") + |> Dict.map (\_ y -> y.value) + |> Dict.toList + |> List.length + |> \x -> x > 0 viewLeader : ( String, Maybe Db.User ) -> Maybe String -> String viewLeader ( id, mbLeader ) cur = diff --git a/src/Viewer.elm b/src/Viewer.elm index 01fb898..5d54ac0 100644 --- a/src/Viewer.elm +++ b/src/Viewer.elm @@ -102,7 +102,7 @@ viewSnackbar h = view : Session.Session -> (a -> Msg.Msg) -> Details Msg.Msg -> Header -> Maybe Posix -> Browser.Document Msg.Msg -view session msg details h time = +view session _ details h time = { title = details.title ++ Utils.genericTitle , body = viewSnackbar h From bb4b63f9d1cb40ecb78a6ea74c4d3a5d59b0206a Mon Sep 17 00:00:00 2001 From: Jerome Bergmann Date: Sun, 15 May 2022 14:10:49 +0200 Subject: [PATCH 15/15] Update Study.elm Teilausgabe funktioniert wieder --- src/Page/Study.elm | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/src/Page/Study.elm b/src/Page/Study.elm index 63662a7..54a7545 100644 --- a/src/Page/Study.elm +++ b/src/Page/Study.elm @@ -316,7 +316,7 @@ type alias SerializableStudyDatapoint = , answer : String , coding_question : String , coding_answer : String - , coder : String + -- , coder : String } @@ -328,23 +328,32 @@ exportStudy id db = |> start (Value .study) db.events (Value .name) |> move (Value .study) db.questionnaries (Raw Tuple.first) |> add (Value .questionary) db.questions (Value .text) - -- |> addAttrList (Value .questionary) .questions (Value .input_ty) db (\_ -> ["Implement Me!"]) + -- -- |> addAttrList (Value .questionary) .questions (Value .input_ty) db (\_ -> ["Implement Me!"]) |> move (Value .questionary) db.questions (Raw Tuple.first) |> add (Value .question) db.answers (Value .value) - --|> moveReferenceList (Value .question) .answers (Raw Tuple.first) db + -- --|> moveReferenceList (Value .question) .answers (Raw Tuple.first) db |> move (Value .question) db.coding_questionnaries (Raw Tuple.first) |> add (Value .coding_questionary) db.coding_questions (Value .text) |> move (Value .coding_questionary) db.coding_questions (Raw Tuple.first) |> add (Value .coding_question) db.coding_answers (Value .value) |> move (Value .coding_question) db.coding_answers (Raw Tuple.first) |> move (Raw Tuple.first) db.coding_answers (Raw (\( _, y ) -> y.creator)) - |> add (Raw (\( _, y ) -> y.creator)) db.users (Value (\x -> Maybe.withDefault "" x.name)) + -- |> add (Raw (\( _, y ) -> y.creator)) db.users (Value (\x -> Maybe.withDefault "" x.name)) |> end in List.map serializeStudyDatapoint datapoints |> String.join "\n" - + |> \x -> "event;question;answer;coding_question;coding_answer\n" ++ x serializeStudyDatapoint : SerializableStudyDatapoint -> String serializeStudyDatapoint data = - String.join ";" [ data.event, data.coder, data.question, data.answer, data.coding_question, data.coding_answer ] + + String.join ";" + [ + data.event + --, data.coder + , data.question + , data.answer + , data.coding_question + , data.coding_answer + ]