diff --git a/flake.nix b/flake.nix index 3fa9cd3..472d911 100644 --- a/flake.nix +++ b/flake.nix @@ -12,10 +12,20 @@ devShells.${system} = { default = pkgs.mkShell { nativeBuildInputs = [ - pkgs.elmPackages.elm-format pkgs.elm2nix + pkgs.elmPackages.elm + pkgs.elmPackages.elm-format pkgs.elmPackages.elm-json + pkgs.elmPackages.elm-review + pkgs.tokei ]; + shellHook = '' + ${pkgs.elmPackages.fetchElmDeps { + elmPackages = import ./src/elm2nix/elm-srcs.nix; + elmVersion = "0.19.1"; + registryDat = ./src/elm2nix/registry.dat; + }} + ''; }; }; }; diff --git a/src/Cli.elm b/src/Cli.elm index 08b7880..4576e39 100644 --- a/src/Cli.elm +++ b/src/Cli.elm @@ -1,14 +1,53 @@ module Cli exposing (..) +{- ( Command + , CommandErr + , FilledCommand + , FilledFlag + , FilledFlagOption + , FilledOption + , Flag + , FlagOption + , Option + , getFlag + , getFlagOption + , getOption + , mkCommand + , parseInput + ) +-} -type alias Parameter = + +type alias Option = { name : String } -type alias FilledParameter = +type alias FilledOption = { name : String - , content : String + , value : Maybe String + } + + +type alias Flag = + { name : String + } + + +type alias FilledFlag = + { name : String + , value : Bool + } + + +type alias FlagOption = + { name : String + } + + +type alias FilledFlagOption = + { name : String + , value : Maybe String } @@ -18,13 +57,17 @@ type alias DirtyCommand = type alias Command = { name : String - , params : List Parameter + , opts : List Option + , flags : List Flag + , flagOpts : List FlagOption } type alias FilledCommand = { name : String - , params : List FilledParameter + , opts : List FilledOption + , flags : List FilledFlag + , flagOpts : List FilledFlagOption } @@ -34,40 +77,49 @@ type alias CommandErr = , argumentErr : Maybe ArgumentErr } + type ArgumentErr = MissingArgs | TooManyArgs + | UnrecognisedFlag parseInput : List Command -> String -> Result CommandErr FilledCommand parseInput commands input = let tokens = - List.map String.trim (String.split " " input) + String.words input + + tail = + case List.tail tokens of + Just t -> + t + + Nothing -> + [] in case List.head tokens of Just maybeCommand -> case List.head (List.filter (isCommand maybeCommand) commands) of Just command -> - case applyArguments command.params tokens of - Ok list -> - Ok - { name = command.name - , params = list - } + case applyArguments command tail of + Ok filledCommand -> + Ok filledCommand + Err err -> - Err { command = Just command + Err + { command = Just command , got = input , argumentErr = Just err } - Nothing -> Err { command = Nothing , got = input , argumentErr = Nothing } + Nothing -> Err { command = Nothing @@ -76,23 +128,152 @@ parseInput commands input = } -applyArguments : List Parameter -> List String -> Result ArgumentErr (List FilledParameter) -applyArguments params inputs = - if List.length params > List.length inputs then - Err MissingArgs - else if List.length params < List.length inputs then +mkCommand : Command -> Command +mkCommand command = + { command | flags = List.append command.flags [ { name = "--help" } ] } + + +flagsFromTokens : List String -> List String +flagsFromTokens tokens = + tokens + |> List.filter isFlag + + +flagOptionsFromTokens : List String -> List String +flagOptionsFromTokens flags = + flags + |> List.filter isFlagOption + + +nonFlagsFromTokens : List String -> List String +nonFlagsFromTokens tokens = + tokens + |> List.filter (not << isFlag) + |> List.filter (not << isFlagOption) + + +isFlag : String -> Bool +isFlag str = + String.startsWith "--" str && not (String.contains "=" str) + + +isFlagOption : String -> Bool +isFlagOption str = + String.startsWith "--" str && isOnlyOnce "=" str + + +isOnlyOnce : String -> String -> Bool +isOnlyOnce a b = + 1 == List.length (String.indices a b) + + +applyArguments : Command -> List String -> Result ArgumentErr FilledCommand +applyArguments command tokens = + let + opts = + command.opts + + flags = + command.flags + + flagOpts = + command.flagOpts + + flagIns = + flagsFromTokens tokens + + flagOptIns = + flagOptionsFromTokens tokens + + nonFlagIns = + nonFlagsFromTokens tokens + in + if List.length opts < List.length nonFlagIns then Err TooManyArgs + + else if List.any (\m -> not (List.member { name = m } flags)) flagIns then + Err UnrecognisedFlag + + else if + List.any + (\m -> + not + (List.member + { name = + case List.head (String.split "=" m) of + Just head -> + head + + Nothing -> + "" + } + flagOpts + ) + ) + flagOptIns + then + Err UnrecognisedFlag + else - Ok (List.map2 applyParameter params inputs) + let + optionInputs = + expandList (List.map Just nonFlagIns) (List.length opts) + in + Ok + { name = command.name + , opts = List.map2 applyOption opts optionInputs + , flags = List.map (fillFlag flagIns) flags + , flagOpts = List.map (fillFlagOption flagOptIns) flagOpts + } - -applyParameter : Parameter -> String -> FilledParameter -applyParameter param input = - { name = param.name - , content = input +applyOption : Option -> Maybe String -> FilledOption +applyOption option input = + { name = option.name + , value = input } - + + +fillFlag : List String -> Flag -> FilledFlag +fillFlag flagTokens flag = + if List.member flag.name flagTokens then + { name = flag.name + , value = True + } + + else + { name = flag.name + , value = False + } + + +fillFlagOption : List String -> FlagOption -> FilledFlagOption +fillFlagOption flagOptIns flagOption = + let + flag = + case flagOptIns + |> List.filter (\m->String.contains flagOption.name m) + |> List.head + of + Just head -> + Just <| String.dropLeft (1 + String.length flagOption.name) head + Nothing -> + Nothing + + in + { name = flagOption.name + , value = flag + } + + +expandList : List (Maybe String) -> Int -> List (Maybe String) +expandList input len = + if List.length input >= len then + List.take len input + + else + expandList (List.append input [ Nothing ]) len + isCommand : String -> Command -> Bool isCommand name command = @@ -101,3 +282,36 @@ isCommand name command = else False + + +getOption : FilledCommand -> String -> FilledOption +getOption command name = + case List.head <| List.filter (\m->m.name == name) command.opts of + Just head -> + head + Nothing -> + { name = name + , value = Nothing + } + + +getFlag : FilledCommand -> String -> FilledFlag +getFlag command name = + case List.head <| List.filter (\m->m.name == name) command.flags of + Just head -> + head + Nothing -> + { name = name + , value = False + } + + +getFlagOption : FilledCommand -> String -> FilledFlagOption +getFlagOption command name = + case List.head <| List.filter (\m->m.name == name) command.flagOpts of + Just head -> + head + Nothing -> + { name = name + , value = Nothing + } diff --git a/src/Commands.elm b/src/Commands.elm index 7ca7788..98ad1c6 100644 --- a/src/Commands.elm +++ b/src/Commands.elm @@ -1,12 +1,111 @@ module Commands exposing (..) -import Cli exposing (Command) +import Cli exposing (Command, mkCommand) -greet : Command -greet = - { name = "greet" - , params = [ - { name = "name" - } ] +commands : List Command +commands = + [ help + , clear + , colors + , cookies + , debug + , environment + , hello + , todo + ] + + +help : Command +help = + { name = "help" + , opts = + [ { name = "command" } + ] + , flags = [] + , flagOpts = [] } + |> mkCommand + + +clear : Command +clear = + { name = "clear" + , opts = [] + , flags = [] + , flagOpts = [] + } + |> mkCommand + + +colors : Command +colors = + { name = "colors" + , opts = + [ { name = "show" } + ] + , flags = [] + , flagOpts = [] + } + |> mkCommand + + +cookies : Command +cookies = + { name = "cookies" + , opts = + [ { name = "show" } + ] + , flags = [] + , flagOpts = + [ { name = "--keepFont" } + , { name = "--keepPrompt" } + , { name = "--keepTheme" } + ] + } + |> mkCommand + + +debug : Command +debug = + { name = "debug" + , opts = [] + , flags = [] + , flagOpts = [] + } + |> mkCommand + + +environment : Command +environment = + { name = "environment" + , opts = + [ { name = "show" } + ] + , flags = [] + , flagOpts = + [ { name = "--theme" } + , { name = "--fontsize" } + , { name = "--prompt" } + ] + } + |> mkCommand + + +hello : Command +hello = + { name = "hello" + , opts = [] + , flags = [] + , flagOpts = [] + } + |> mkCommand + + +todo : Command +todo = + { name = "todo" + , opts = [] + , flags = [] + , flagOpts = [] + } |> mkCommand diff --git a/src/ElmTypes.elm b/src/ElmTypes.elm new file mode 100644 index 0000000..1f9b249 --- /dev/null +++ b/src/ElmTypes.elm @@ -0,0 +1,31 @@ +module ElmTypes exposing (Model) + +import Browser +import Browser.Navigation as Nav +import Cli +import Json.Encode as E +import Url + + +type alias Model = + { key : Nav.Key + , url : Url.Url + , theme : Theme + , font : Font + , cookiesKept : CookiesKept + , prompt : Prompt + , content : List (Html Msg) + , cliContent : String + } + + +type Msg + = LinkClicked Browser.UrlRequest + | UrlChanged Url.Url + | TakeInput String + | NoInitFocus + | ReceivedStorage E.Value + + +type alias CommandRunner = + Model -> List String -> ( Model, Cmd Msg ) diff --git a/src/Main.elm b/src/Main.elm index 517065f..85f3357 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -3,9 +3,10 @@ port module Main exposing (..) import Browser import Browser.Dom as Dom import Browser.Navigation as Nav +import Cli +import Commands exposing (..) import Css exposing (..) import ElmskellTypes.Generated.Decoder exposing (..) -import ElmskellTypes.Generated.ElmStreet exposing (..) import ElmskellTypes.Generated.Encoder exposing (..) import ElmskellTypes.Generated.Types exposing (..) import Html.Styled exposing (Attribute, Html, styled, text, toUnstyled) @@ -14,11 +15,9 @@ import Html.Styled.Events exposing (onInput) import Json.Decode as D import Json.Encode as E import Task +import Types exposing (..) import Url -import Cli -import Commands exposing (greet) - -- MAIN @@ -40,18 +39,6 @@ main = -- MODEL -type alias Model = - { key : Nav.Key - , url : Url.Url - , theme : Theme - , font : Font - , cookiesKept : CookiesKept - , prompt : Prompt - , content : List (Html Msg) - , cliContent : String - } - - defaultCookies : { cookiesKept : CookiesKept , font : Font @@ -127,14 +114,6 @@ init flags url key = -- UPDATE -type Msg - = LinkClicked Browser.UrlRequest - | UrlChanged Url.Url - | TakeInput String - | NoInitFocus - | ReceivedStorage E.Value - - update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of @@ -153,7 +132,7 @@ update msg model = TakeInput string -> if String.endsWith "\n" string then - runCommand + processInput { model | cliContent = "" , content = @@ -169,7 +148,7 @@ update msg model = , text <| String.trim string ] } - (parseInput string) + string else ( { model | cliContent = string }, Cmd.none ) @@ -217,7 +196,7 @@ applyJSONData model data = errApplyingJSON : Model -> D.Error -> ( Model, Cmd Msg ) errApplyingJSON model e = - ( { model | content = model.content ++ [ coloredText (coreColor Red) <| "\n" ++ D.errorToString e ] }, Cmd.none ) + ( { model | content = model.content ++ [ errMessage <| D.errorToString e ] }, Cmd.none ) isOK : Result x a -> Bool @@ -234,207 +213,167 @@ isOK res = -- COMMANDS -parseInput : String -> Result String Input -parseInput input = +processInput : Model -> String -> ( Model, Cmd Msg ) +processInput model input = let - tokens = - List.map String.trim (String.split " " input) - - command = - case List.head tokens of - Just "help" -> - Ok HelpCommand - - Just "clear" -> - Ok ClearCommand - - Just "colors" -> - Ok ColorsCommand - - Just "cookies" -> - Ok CookiesCommand - - Just "debug" -> - Ok DebugCommand - - Just "font" -> - Ok FontCommand - - Just "hello" -> - Ok HelloCommand - - Just "prompt" -> - Ok PromptCommand - - Just "theme" -> - Ok ThemeCommand - - Just "todo" -> - Ok TodoCommand - - Just trimput -> - Err trimput - - _ -> - Err "error in parseInput parsing tokens" - - args = - case List.tail tokens of - Just tail -> - Ok <| List.filter ((/=) "") tail - - _ -> - Err "error in parseInput parsing tokens" + cleanInput = + String.trim input in - case args of - Ok arguments -> - case command of - Ok cmd -> - Ok { command = cmd, args = arguments } + case Cli.parseInput commands cleanInput of + Ok filledCommand -> + processCommand model filledCommand - Err err -> - Err err - - Err err -> - Err err - - -runCommand : Model -> Result String Input -> ( Model, Cmd Msg ) -runCommand model input = - case input of - Ok { command, args } -> - (case command of - HelpCommand -> - runHelp - - ClearCommand -> - runClear - - ColorsCommand -> - runColors - - CookiesCommand -> - runCookies - - DebugCommand -> - runDebug - - FontCommand -> - runFont - - HelloCommand -> - runHello - - PromptCommand -> - runPrompt - - ThemeCommand -> - runTheme - - TodoCommand -> - runTodo - ) - model - args - - Err "" -> - ( model, Cmd.none ) - - Err string -> + Err _ -> ( { model - | content = model.content ++ [ text <| "\ncommand " ++ string ++ " not recognised. Run `help` to find a valid command" ] + | content = + model.content + ++ [ errMessage "Input not parsed. Come back soon for better error messages." + ] } , Cmd.none ) -type alias CommandRunner = - Model -> List String -> ( Model, Cmd Msg ) +processCommand : Model -> Cli.FilledCommand -> ( Model, Cmd Msg ) +processCommand model command = + if .value <| Cli.getFlag command "--help" then + helpWith model command + + else + case command.name of + "help" -> + runHelp model command + + "clear" -> + runClear model command + + "colors" -> + runColors model command + + "cookies" -> + runCookies model command + + "debug" -> + runDebug model command + + "environment" -> + runEnvironment model command + + "hello" -> + runHello model command + + "todo" -> + runTodo model command + + string -> + ( { model + | content = model.content ++ [ warningMessage "This command isn't implemented yet." ] + } + , Cmd.none + ) runHelp : CommandRunner -runHelp model args = +runHelp model command = + let + snippet_ = + snippet model + in ( { model | content = model.content - ++ (if List.length args < 2 then - case List.head args of - Nothing -> - [ text <| - "\n+--------------------------------------------------+" - ++ "\n|help prints this message |" - ++ "\n|help prints more information about |" - ++ "\n+--------------------------------------------------+" - ++ "\nclear clears the screen" - ++ "\ncookies [UNSTABLE] manages cookies" - ++ "\nhello prints hello world message" - ++ "\nfont manages font" - ++ "\nprompt [UNFINISHED] manages prompt" - ++ "\ntheme manages theme" - ++ "\ntodo prints aspirations for the site" - ] + ++ (case .value <| Cli.getOption command "command" of + Nothing -> + [ text <| + "\n+---------------------------------------------------------+" + ++ "\n|help prints this message |" + ++ "\n|help COMMAND prints more information about COMMAND |" + ++ "\n|COMMAND --help is functionally identical to help COMMAND |" + ++ "\n+---------------------------------------------------------+" + ++ "\nclear clears the screen" + ++ "\ncolors shows off current color scheme" + ++ "\ncookies " + , broken + , text " edits cookie settings" + , text "\nenvironment " + , unimplemented + , text "\nhello prints Hello, World!" + , text "\ntodo prints my todo list" + ] - Just "help" -> - [ text <| - "\nhelp lists available commands with a short summary" - ++ "\nhelp prints more information about " - ] + Just "help" -> + [ text <| + "\n+---------------------------------------------------------+" + ++ "\n|help prints a list and synopsis of commands |" + ++ "\n|help COMMAND prints more information about COMMAND |" + ++ "\n|COMMAND --help is functionally identical to help COMMAND |" + ++ "\n+---------------------------------------------------------+" + ] - Just "clear" -> - [ text <| "\nclear clears the screen" - ] + Just "clear" -> + [ text <| "\nclear clears the screen" + ] - Just "colors" -> - [ text "\ncolors ", coloredText (coreColor BrightCyan) "[UNIMPLEMENTED]" ] + Just "colors" -> + [ snippet_ "\ncolors show" + , text " pretty-prints each color in the current color scheme. It is currently " + , unimplemented + ] - Just "cookies" -> - [ text <| - "\ncookies prints info about the current cookie settings" - ++ "\ncookies set [true|false] sets whether to store a certain cookie" - ++ "\noptions for are:" - ++ "\n keepFont - whether to store fontSize. Default fontSize is 20" - ++ "\n keepPrompt - whether to store prompt. Default prompt is >" - ++ "\n keepTheme - whether to store theme. Default theme is pit" - ] + Just "cookies" -> + [ newline + , newline + , broken + , text " " + , snippet_ "cookies show" + , text " works, but no flags actually change settings" + , snippet_ "\ncookies show" + , text " prints the current cookie policy" + , snippet_ "\ncookies [FLAGS]" + , text " modifies the persistance of various customization features" + , text "\n\nFLAGS:" + , text "\n " + , snippet_ "--keepTheme=[true|false]" + , text " sets whether the theme persists" + , text "\n " + , snippet_ "--keepPrompt=[true|false]" + , text " sets whether the prompt persists" + , text "\n " + , snippet_ "--keepFont=[true|false]" + , text " sets whether the font size persists" + , text "\n\nIt's important to note that the name " + , snippet_ "cookies" + , text "is a fallacy because this site has" + , text "\nno cookies. Information about the session is instead stored in the browser's localStorage." + , text "\nThe difference is that cookies are sent to the server every time you load the website," + , text "\nwhile localStorage never leaves your computer. I call them cookies to aid normal users," + , text "\nas they are virtually indistinguishable on the user side; when you clear your cookies," + , text "\nyour localStorage gets wiped, too." + ] - Just "hello" -> - [ text <| "\nhello prints `Hello World!`" - ] + Just "debug" -> + [ text "\ndebug is a secret command! Its usage may change any day." ] - Just "font" -> - [ text <| - "\nfont size prints info about the current font size" - ++ "\nfont size changes fontSize to if is >0" - ++ "\nfont reset changes fontSize to the default of 20px" - ] + Just "environment" -> + [ text "\nenvironment is ", unimplemented ] - Just "prompt" -> - [ text <| - "\nprompt prints info about the current prompt" - ++ "\nprompt set sets prompt text to " - ++ "\n is specified in quotes" - ++ "\nprompt color sets prompt color to " - ++ "\n run `colors` to list available colors" - ] + Just "hello" -> + [ newline + , snippet_ "hello" + , text " prints Hello, World!" + ] - Just "theme" -> - [ text <| - "\ntheme sets the current theme according to " - ++ "\nOptions for are:" - ++ "\n sun - a theme blinding like the sun" - ++ "\n sky - a toned-down light theme" - ++ "\n dim - a deep and colorful dark theme" - ++ "\n pit - nearly black like the bottom of a pit" - ] + Just "todo" -> + [ newline + , snippet_ "todo" + , text " prints my todo list. Just because a feature is on the list doesn't mean it'll be coming any time soon." + , text "\nIf you want to see any specific features implemented, contact me via Matrix @mtgmonkey:schildichat.net" + , text "\nor via Signal @MTGmonkey. The items on the list are in no particular order and the list is probably" + , text "\nout of date." + ] - Just "todo" -> - [ text "\ntodo prints aspirations for the site" ] - - Just string -> - wrongArgs HelpCommand 1 args - - else - wrongArgs HelpCommand 1 args + Just string -> + [ errMessage <| "\nThe command " ++ string ++ " doesn't exist" ] ) } , Cmd.none @@ -442,382 +381,232 @@ runHelp model args = runClear : CommandRunner -runClear model args = - ( case List.head args of - Nothing -> - { model | content = [] } - - Just string -> - { model | content = model.content ++ wrongArgs ClearCommand 0 args } +runClear model command = + ( { model | content = [] } , Cmd.none ) runColors : CommandRunner -runColors model args = - case List.head args of +runColors model command = + case .value <| Cli.getOption command "show" of Nothing -> - ( { model | content = model.content ++ wrongArgs ColorsCommand 1 args }, Cmd.none ) + processCommand model { command | flags = [ { name = "--help", value = True } ] } - Just "test" -> + Just "show" -> ( { model | content = model.content - ++ [ coloredText (coreColor Red) "Red" ] + ++ [ warningMessage "colors show is ", unimplemented ] } , Cmd.none ) - Just _ -> - ( { model | content = model.content ++ wrongArgs ColorsCommand 1 args }, Cmd.none ) + Just show -> + ( { model + | content = + model.content + ++ [ errMessage <| "colors " ++ show ++ " does not exist. Run " + , snippet model "colors --help" + ] + } + , Cmd.none + ) runCookies : CommandRunner -runCookies model args = - case List.head args of - Nothing -> +runCookies model command = + let + flags = + { keepFont = .value <| Cli.getFlagOption command "--keepFont" + , keepPrompt = .value <| Cli.getFlagOption command "--keepPrompt" + , keepTheme = .value <| Cli.getFlagOption command "--keepTheme" + } + in + case .value <| Cli.getOption command "show" of + Just "show" -> ( { model | content = model.content ++ [ text <| "\n" ++ cookiesKeptToString model.cookiesKept ] }, Cmd.none ) - Just "set" -> + Nothing -> let + keepFont = + if flags.keepFont == Just "true" then + True + + else if flags.keepFont == Just "false" then + False + + else + model.cookiesKept.keepFont + + keepPrompt = + if flags.keepPrompt == Just "true" then + True + + else if flags.keepPrompt == Just "false" then + False + + else + model.cookiesKept.keepPrompt + + keepTheme = + if flags.keepTheme == Just "true" then + True + + else if flags.keepTheme == Just "false" then + False + + else + model.cookiesKept.keepTheme + cookiesKept = - model.cookiesKept - - second = - case List.tail args of - Just tail -> - Maybe.withDefault "" (List.head tail) - - Nothing -> - "" - - third = - case List.tail args of - Just tail -> - case List.tail tail of - Just tail2 -> - Maybe.withDefault "" (List.head tail2) - - Nothing -> - "" - - Nothing -> - "" + { keepFont = keepFont + , keepPrompt = keepPrompt + , keepTheme = keepTheme + } in - if third == "" then - ( { model | content = model.content ++ wrongArgs CookiesCommand 3 args }, Cmd.none ) + if cookiesKept == model.cookiesKept then + helpWith model command else - case second of - "" -> - ( { model | content = model.content ++ wrongArgs CookiesCommand 2 args }, Cmd.none ) + ( { model | cookiesKept = cookiesKept }, saveCookiesKept cookiesKept ) - "keepFont" -> - case third of - "true" -> - saveCookiesKept { model | cookiesKept = { cookiesKept | keepFont = True } } - - "false" -> - saveCookiesKept { model | cookiesKept = { cookiesKept | keepFont = False } } - - _ -> - ( { model | content = model.content ++ wrongArgs CookiesCommand 3 args }, Cmd.none ) - - "keepTheme" -> - case third of - "true" -> - saveCookiesKept { model | cookiesKept = { cookiesKept | keepTheme = True } } - - "false" -> - saveCookiesKept { model | cookiesKept = { cookiesKept | keepTheme = False } } - - _ -> - ( { model | content = model.content ++ wrongArgs CookiesCommand 3 args }, Cmd.none ) - - "keepPrompt" -> - case third of - "true" -> - saveCookiesKept { model | cookiesKept = { cookiesKept | keepPrompt = True } } - - "false" -> - saveCookiesKept { model | cookiesKept = { cookiesKept | keepPrompt = False } } - - _ -> - ( { model | content = model.content ++ wrongArgs CookiesCommand 3 args }, Cmd.none ) - - _ -> - ( { model | content = model.content ++ wrongArgs CookiesCommand 2 args }, Cmd.none ) - - Just string -> - ( { model | content = model.content ++ wrongArgs CookiesCommand 1 args }, Cmd.none ) + Just show -> + ( { model | content = model.content ++ [ errMessage <| "colors " ++ show ++ " does not exist. Run colors --help" ] }, Cmd.none ) runDebug : CommandRunner -runDebug model args = - ( model, getStorage "Theme" ) - - -runHello : CommandRunner -runHello model args = - case List.head args of - Nothing -> - ( { model | content = model.content ++ [ text "\nHello World!" ] }, Cmd.none ) - - _ -> - ( { model | content = model.content ++ wrongArgs HelloCommand 0 args }, Cmd.none ) - - -runFont : CommandRunner -runFont model args = - case List.head args of - Nothing -> - ( { model | content = model.content ++ wrongArgs FontCommand 1 args }, Cmd.none ) - - Just "size" -> - let - string = - case List.tail args of - Just tail -> - Maybe.withDefault "" (List.head tail) - - Nothing -> - "" - - fl = - String.toFloat string - in - case fl of - Just float -> - if float > 0 then - let - newModel = - { model - | content = - model.content - ++ [ text <| - "\nfontSize successfully set to " - ++ string - ++ "px" - ] - , font = { fontSize = float } - } - in - saveFont newModel - - else - ( { model - | content = - model.content - ++ [ text "\nPlease enter a valid fontSize, a Float greater than 0" ] - } - , Cmd.none - ) - - Nothing -> - case string of - "" -> - ( { model | content = model.content ++ [ text <| "\nfontSize is " ++ String.fromFloat model.font.fontSize ++ "px" ] } - , Cmd.none - ) - - "reset" -> - let - newModel = - { model - | content = - model.content - ++ [ text "\nfontSize reset to 20px" ] - , font = { fontSize = 20 } - } - in - saveFont newModel - - _ -> - ( { model - | content = - model.content - ++ [ text <| - "\nfontSize " - ++ string - ++ " not recognised; font size expected" - ] - } - , Cmd.none - ) - - Just "reset" -> - let - newModel = - { model - | content = model.content ++ [ text "\nfontSize reset to 20px" ] - , font = { fontSize = 20 } - } - in - saveFont newModel - - Just string -> - ( { model | content = model.content ++ wrongArgs FontCommand 1 args }, Cmd.none ) - - -runPrompt : CommandRunner -runPrompt model args = - case List.head args of - Nothing -> - ( { model | content = model.content ++ [ text <| "\ncurrent prompt is " ++ model.prompt.prompt ] }, Cmd.none ) - - Just string -> - let - oldPrompt = - model.prompt - in - savePrompt { model | prompt = { oldPrompt | prompt = string } } - - -runTheme : CommandRunner -runTheme model args = - case List.head args of - Nothing -> - ( { model - | content = - model.content - ++ [ text <| - "\nThe current theme is " - ++ (case model.theme of - Sun -> - "sun" - - Sky -> - "sky" - - Dim -> - "dim" - - Pit -> - "pit" - ) - ] - } - , Cmd.none - ) - - Just "sun" -> - setTheme model Sun - - Just "sky" -> - setTheme model Sky - - Just "dim" -> - setTheme model Dim - - Just "pit" -> - setTheme model Pit - - Just string -> - ( { model | content = model.content ++ wrongArgs ThemeCommand 1 args }, Cmd.none ) - - -runTodo : CommandRunner -runTodo model args = - ( case List.head args of - Nothing -> - { model - | content = - model.content - ++ [ text <| - "\nIn no particular order:" - ++ "\n- Implement colors throughout existing methods" - ++ "\n- Something like Neofetch" - ++ "\n- Collect and store feedback in a database" - ++ "\n- Create a style guide for programs involving console colors" - ++ "\n- Modularise the code (to have something more elegant than a single 2k line file)" - ++ "\n- Figure out a better way to parse commands" - ++ "\n- Add cache headers" - ] - } - - Just _ -> - { model | content = model.content ++ wrongArgs TodoCommand 0 args } +runDebug model _ = + ( { model + | content = + model.content + ++ [ successMessage "You found a secret command!" + , text "\ndebug currently does nothing :3" + ] + } , Cmd.none ) +runEnvironment : CommandRunner +runEnvironment model command = + let + theme = + case .value <| Cli.getFlagOption command "--theme" of + Just th -> + case th of + "sun" -> + Sun + + "sky" -> + Sky + + "dim" -> + Dim + + "pit" -> + Pit + + _ -> + model.theme + + Nothing -> + model.theme + + prompt = + case .value <| Cli.getFlagOption command "--prompt" of + Just p -> + let + pr = + model.prompt + in + { pr | prompt = p } + + Nothing -> + model.prompt + + font = + case .value <| Cli.getFlagOption command "--fontsize" of + Just val -> + case String.toFloat val of + Just float -> + let + f = + model.font + in + { f | fontSize = float } + + Nothing -> + model.font + + Nothing -> + model.font + in + ( { model + | prompt = prompt + , theme = theme + , font = font + } + , Cmd.batch + [ savePrompt prompt, saveTheme theme, saveFont font ] + ) + + +runHello : CommandRunner +runHello model _ = + ( { model | content = model.content ++ [ text "\nHello World!" ] }, Cmd.none ) + + +runTodo : CommandRunner +runTodo model _ = + ( { model + | content = + model.content + ++ + [ text "\nRun " + , snippet model "todo --help" + , text " for more information about this list" + , text <| "\n- Implement colors throughout existing methods" + ++ "\n- Create a strong color language for unified UI" + ++ "\n- Finish Colors command. My vision is something like Neofetch" + ++ "\n- Collect and store feedback via command line in a database" + ++ "\n- Fix cookies so the site respects settings from the cookies command" + ++ "\n- Make accessable on mobile" + ++ "\n- Add header advert for tor hidden service" + ++ "\n- Add plaintext mode for noscript users" + ++ "\n- Add warning banner on tor hidden service if Javascript is enabled" + ] + } + , Cmd.none + ) + + +helpWith : CommandRunner +helpWith model command = + processCommand model + { name = "help" + , opts = [ { name = "command", value = Just command.name } ] + , flags = [] + , flagOpts = [] + } + + -- COMMAND ABSTRACTIONS -setTheme : Model -> Theme -> ( Model, Cmd Msg ) -setTheme model theme = - let - newModel = - { model | theme = theme } - in - saveTheme newModel - - -wrongArgs : Command -> Int -> List String -> List (Html Msg) -wrongArgs command expected args = - let - comstr = - case command of - HelpCommand -> - "help" - - ClearCommand -> - "clear" - - ColorsCommand -> - "colors" - - CookiesCommand -> - "cookies" - - DebugCommand -> - "debug" - - FontCommand -> - "font" - - HelloCommand -> - "hello" - - PromptCommand -> - "prompt" - - ThemeCommand -> - "theme" - - TodoCommand -> - "todo" - in - [ text - ((if expected > List.length args then - "\nToo few arguments for " ++ comstr - - else if expected < List.length args then - "\nToo many arguments for " ++ comstr - - else - "\nUnexpected arguments " ++ listToString args - ) - ++ ". Run `help " - ++ comstr - ++ "` for usage" - ) - ] - - listToString : List String -> String listToString list = "[" ++ String.join "," list ++ "]" boolToString : Bool -> String -boolToString bool = - case bool of - True -> +boolToString = + \n -> + if n then "True" - False -> + else "False" @@ -850,24 +639,24 @@ port receiveStorageFromJS : (E.Value -> msg) -> Sub msg -- JSON -saveCookiesKept : Model -> ( Model, Cmd Msg ) -saveCookiesKept model = - ( model, setStorage ( "CookiesKept", encodeCookiesKept model.cookiesKept ) ) +saveCookiesKept : CookiesKept -> Cmd Msg +saveCookiesKept cookiesKept = + setStorage ( "CookiesKept", encodeCookiesKept cookiesKept ) -saveFont : Model -> ( Model, Cmd Msg ) -saveFont model = - ( model, setStorage ( "Font", encodeFont model.font ) ) +saveFont : Font -> Cmd Msg +saveFont font = + setStorage ( "Font", encodeFont font ) -savePrompt : Model -> ( Model, Cmd Msg ) -savePrompt model = - ( model, setStorage ( "Prompt", encodePrompt model.prompt ) ) +savePrompt : Prompt -> Cmd Msg +savePrompt prompt = + setStorage ( "Prompt", encodePrompt prompt ) -saveTheme : Model -> ( Model, Cmd Msg ) -saveTheme model = - ( model, setStorage ( "Theme", encodeTheme model.theme ) ) +saveTheme : Theme -> Cmd Msg +saveTheme theme = + setStorage ( "Theme", encodeTheme theme ) loadStorage : Model -> String -> ( Model, Cmd Msg ) @@ -1174,3 +963,38 @@ coloredTextWBackground fgColor bgColor string = ] [] [ text string ] + + +errMessage : String -> Html Msg +errMessage = + coloredText (coreColor BrightRed) << (++) "\n[ERR] " + + +warningMessage : String -> Html Msg +warningMessage = + coloredText (coreColor Red) << (++) "\n[WARN] " + + +successMessage : String -> Html Msg +successMessage = + coloredText (coreColor BrightGreen) << (++) "\n[SUCCESS] " + + +unimplemented : Html Msg +unimplemented = + coloredText (coreColor BrightCyan) "[UNIMPLEMENTED]" + + +broken : Html Msg +broken = + coloredText (coreColor BrightRed) "[BROKEN]" + + +snippet : Model -> String -> Html Msg +snippet model = + coloredTextWBackground (themeColor model BrightWhite) (themeColor model BrightBlack) + + +newline : Html Msg +newline = + text "\n" diff --git a/src/Types.elm b/src/Types.elm new file mode 100644 index 0000000..33eaa31 --- /dev/null +++ b/src/Types.elm @@ -0,0 +1,37 @@ +module Types exposing (..) + +import Browser +import Browser.Navigation +import Cli +import ElmskellTypes.Generated.Types exposing (..) +import Html.Styled +import Json.Encode +import Url + + +type Msg + = LinkClicked Browser.UrlRequest + | UrlChanged Url.Url + | TakeInput String + | NoInitFocus + | ReceivedStorage Json.Encode.Value + + +type alias Model = + { key : Browser.Navigation.Key + , url : Url.Url + , theme : Theme + , font : Font + , cookiesKept : CookiesKept + , prompt : Prompt + , content : List (Html.Styled.Html Msg) + , cliContent : String + } + + +type alias CommandRunner_ = + Model -> List String -> ( Model, Cmd Msg ) + + +type alias CommandRunner = + Model -> Cli.FilledCommand -> ( Model, Cmd Msg )