port module Main exposing (..) import Browser import Browser.Dom as Dom import Browser.Navigation as Nav 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) import Html.Styled.Attributes exposing (id, value) import Html.Styled.Events exposing (onInput) import Json.Decode as D import Json.Encode as E import Task import Url -- MAIN main : Program E.Value Model Msg main = Browser.application { init = init , view = view , update = update , subscriptions = subscriptions , onUrlChange = UrlChanged , onUrlRequest = LinkClicked } -- 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 : Cookies defaultCookies = { font = { fontSize = 20.0 } , cookiesKept = { keepTheme = True , keepFont = True , keepPrompt = True } , theme = Dim , prompt = { prompt = ">" } } init : E.Value -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) init flags url key = let initContent = [ text "Welcome to my website! Pardon the alpha quality for the time being" , text "\nRun `help` to get started" ] localStorage = case D.decodeValue decodeCookies flags of Ok cookies -> cookies Err _ -> defaultCookies in ( { key = key , url = url , theme = if localStorage.cookiesKept.keepTheme then localStorage.theme else defaultCookies.theme , font = if localStorage.cookiesKept.keepFont then localStorage.font else defaultCookies.font , cookiesKept = localStorage.cookiesKept , prompt = if localStorage.cookiesKept.keepPrompt then localStorage.prompt else defaultCookies.prompt , content = initContent , cliContent = "" } , Task.attempt (\_ -> NoInitFocus) (Dom.focus "init-focus") ) -- UPDATE type Msg = LinkClicked Browser.UrlRequest | UrlChanged Url.Url | TakeInput String | NoInitFocus update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of LinkClicked urlRequest -> case urlRequest of Browser.Internal url -> ( model, Nav.pushUrl model.key (Url.toString url) ) Browser.External href -> ( model, Nav.load href ) UrlChanged url -> ( { model | url = url } , Cmd.none ) TakeInput string -> if String.endsWith "\n" string then runCommand { model | cliContent = "" , content = model.content ++ [ text (if model.content /= [] then "\n" else "" ) , coloredText (coreColor BrightMagenta) model.prompt.prompt , text <| String.trim string ] } (parseInput string) else ( { model | cliContent = string }, Cmd.none ) NoInitFocus -> ( model, Cmd.none ) -- COMMANDS parseInput : String -> Result String Input parseInput 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 "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" in case args of Ok arguments -> case command of Ok cmd -> Ok { command = cmd, args = arguments } 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 FontCommand -> runFont HelloCommand -> runHello PromptCommand -> runPrompt ThemeCommand -> runTheme TodoCommand -> runTodo ) model args Err "" -> ( model, Cmd.none ) Err string -> ( { model | content = model.content ++ [ text <| "\ncommand " ++ string ++ " not recognised. Run `help` to find a valid command" ] } , Cmd.none ) type alias CommandRunner = Model -> List String -> ( Model, Cmd Msg ) runHelp : CommandRunner runHelp model args = ( { 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" ] Just "help" -> [ text <| "\nhelp lists available commands with a short summary" ++ "\nhelp prints more information about " ] Just "clear" -> [ text <| "\nclear clears the screen" ] Just "colors" -> [ text "\ncolors ", coloredText (coreColor BrightCyan) "[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 "hello" -> [ text <| "\nhello prints `Hello World!`" ] 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 "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 "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" -> [ text "\ntodo prints aspirations for the site" ] Just string -> wrongArgs HelpCommand 1 args else wrongArgs HelpCommand 1 args ) } , Cmd.none ) runClear : CommandRunner runClear model args = ( case List.head args of Nothing -> { model | content = [] } Just string -> { model | content = model.content ++ wrongArgs ClearCommand 0 args } , Cmd.none ) runColors : CommandRunner runColors model args = case List.head args of Nothing -> ( { model | content = model.content ++ wrongArgs ColorsCommand 1 args }, Cmd.none ) Just "test" -> ( { model | content = model.content ++ [ coloredText (coreColor Red) "Red" ] } , Cmd.none ) Just _ -> ( { model | content = model.content ++ wrongArgs ColorsCommand 1 args }, Cmd.none ) runCookies : CommandRunner runCookies model args = case List.head args of Nothing -> let newModel = { model | content = model.content ++ [ text <| "\n" ++ cookiesKeptToString model.cookiesKept ] } in ( newModel , Cmd.batch [ setStorage <| encodeModel newModel ] ) Just "set" -> let 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 -> "" in if third == "" then ( { model | content = model.content ++ wrongArgs CookiesCommand 3 args }, Cmd.none ) else case second of "" -> ( { model | content = model.content ++ wrongArgs CookiesCommand 2 args }, Cmd.none ) "keepFont" -> case third of "true" -> saveModel { model | cookiesKept = { cookiesKept | keepFont = True } } "false" -> saveModel { model | cookiesKept = { cookiesKept | keepFont = False } } _ -> ( { model | content = model.content ++ wrongArgs CookiesCommand 3 args }, Cmd.none ) "keepTheme" -> case third of "true" -> saveModel { model | cookiesKept = { cookiesKept | keepTheme = True } } "false" -> saveModel { model | cookiesKept = { cookiesKept | keepTheme = False } } _ -> ( { model | content = model.content ++ wrongArgs CookiesCommand 3 args }, Cmd.none ) "keepPrompt" -> case third of "true" -> saveModel { model | cookiesKept = { cookiesKept | keepPrompt = True } } "false" -> saveModel { 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 ) 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 saveModel 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 saveModel 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 ( newModel , Cmd.batch [ setStorage <| encodeModel 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 saveModel { 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" ++ "\nUpcoming commands to look forward to:" ++ "\nfunfetch" ++ "\ncolors test" ++ "\ncolors set " ++ "\ntheme save " ++ "\ntheme load " ++ "\nfeedback " ] } Just _ -> { model | content = model.content ++ wrongArgs TodoCommand 0 args } , Cmd.none ) -- COMMAND ABSTRACTIONS setTheme : Model -> Theme -> ( Model, Cmd Msg ) setTheme model theme = let newModel = { model | theme = theme } in saveModel 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" 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 -> "True" False -> "False" cookiesKeptToString : CookiesKept -> String cookiesKeptToString cookiesKept = "{ keepFont = " ++ boolToString cookiesKept.keepFont ++ "\n, keepPrompt = " ++ boolToString cookiesKept.keepPrompt ++ "\n, keepTheme = " ++ boolToString cookiesKept.keepTheme ++ "\n}" saveModel : Model -> ( Model, Cmd Msg ) saveModel model = ( model, Cmd.batch [ setStorage <| encodeModel model ] ) -- PORTS -- sets localStorage 'cookies' to E.Value port setStorage : E.Value -> Cmd a -- JSON encodeModel : Model -> E.Value encodeModel model = encodeCookies { defaultCookies | font = model.font , cookiesKept = model.cookiesKept , theme = model.theme , prompt = model.prompt } -- SUBSCRIPTIONS subscriptions : Model -> Sub Msg subscriptions _ = Sub.none -- VIEW view : Model -> Browser.Document Msg view model = Browser.Document "elmskell" [ toUnstyled <| viewBody model ] viewBody : Model -> Html Msg viewBody model = styledBody model [] [ styledContent model [] model.content , styledCL model [] [ styledPrompt model [] [ coloredText (coreColor BrightMagenta) model.prompt.prompt ] , styledCLI model [ onInput TakeInput, value model.cliContent, id "init-focus" ] [] ] ] -- STYLES allColors : Model -> List Color allColors model = List.map coreColor [ Red , Green , Yellow , Blue , Magenta , Cyan , BrightRed , BrightGreen , BrightYellow , BrightBlue , BrightMagenta , BrightCyan ] ++ List.map (themeColor model) [ Background , Foreground , Cursor , Black , White , BrightBlack , BrightWhite ] -- Colors from Root Loops -- flavor: intense -- fruit: raspberry -- milk: each option -- sugar: 6 -- colors: 9 -- sogginess: 7 coreColor : CoreColor -> Color coreColor color = case color of Red -> hex "e14433" Green -> hex "#359b54" Yellow -> hex "#a08016" Blue -> hex "#5a77f2" Magenta -> hex "#cf2ec8" Cyan -> hex "1894a5" BrightRed -> hex "#f36552" BrightGreen -> hex "#3db361" BrightYellow -> hex "#b9941a" BrightBlue -> hex "#7491f8" BrightMagenta -> hex "#e54ede" BrightCyan -> hex "#1eabbf" themeColor : Model -> ThemeColor -> Color themeColor model color = case model.theme of Pit -> case color of Background -> hex "#120211" Foreground -> hex "#f3d9f0" Cursor -> themeColor model White Black -> hex "#380e36" White -> hex "#e29edc" BrightBlack -> hex "#7c2b77" BrightWhite -> hex "#f9ecf7" Dim -> case color of Background -> hex "#380e36" Foreground -> hex "#f7e5f4" Cursor -> themeColor model White Black -> hex "#5e1c56" White -> hex "#e8b2e2" BrightBlack -> hex "#9d3c98" BrightWhite -> hex "#fbf4fa" Sky -> case color of Background -> hex "#f3d9f0" Foreground -> hex "#380e36" Cursor -> themeColor model White Black -> hex "#eec6e9" White -> hex "#7c2b77" BrightBlack -> hex "#d575cd" BrightWhite -> hex "#120211" Sun -> case color of Background -> hex "#f9ecf7" Foreground -> hex "#5a1c56" Cursor -> themeColor model White Black -> hex "#f3d9f0" White -> hex "#9d3c98" BrightBlack -> hex "#dc8ed5" BrightWhite -> hex "#380e36" styledBody : Model -> List (Attribute Msg) -> List (Html Msg) -> Html Msg styledBody model = styled Html.Styled.main_ [ backgroundColor <| themeColor model Background , color <| themeColor model Foreground , minHeight (vh 100) , width (vw 100) , margin (px 0) , padding (px 0) ] styledContent : Model -> List (Attribute Msg) -> List (Html Msg) -> Html Msg styledContent model = styled Html.Styled.span [ color <| themeColor model Foreground , fontSize (px model.font.fontSize) , padding (px 0) , margin (px 0) , backgroundColor <| themeColor model Background , borderWidth (px 0) , width (vw 100) , whiteSpace preWrap , fontFamily monospace ] styledCL : Model -> List (Attribute Msg) -> List (Html Msg) -> Html Msg styledCL model = styled Html.Styled.span [ backgroundColor <| themeColor model Background , padding (px 0) , margin (px 0) , displayFlex , flexDirection row , flexWrap noWrap , justifyContent flexStart ] styledCLI : Model -> List (Attribute Msg) -> List (Html Msg) -> Html Msg styledCLI model = styled Html.Styled.textarea [ color <| themeColor model Foreground , fontSize (px model.font.fontSize) , padding (px 0) , margin (px 0) , backgroundColor <| themeColor model Background , borderWidth (px 0) , outlineWidth (px 0) , height (px model.font.fontSize) , resize none , overflow hidden , flexGrow (Css.int 100) ] styledPrompt : Model -> List (Attribute Msg) -> List (Html Msg) -> Html Msg styledPrompt model = styled Html.Styled.span [ color <| themeColor model Foreground , fontSize (px model.font.fontSize) , padding (px 0) , margin (px 0) , backgroundColor <| themeColor model Background , borderWidth (px 0) , height (px model.font.fontSize) , fontFamily monospace ] coloredText : Color -> String -> Html Msg coloredText fgColor string = coloredTextWBackground fgColor (rgba 0 0 0 0) string coloredTextWBackground : Color -> Color -> String -> Html Msg coloredTextWBackground fgColor bgColor string = styled Html.Styled.span [ color fgColor , backgroundColor bgColor , padding (px 0) , margin (px 0) , borderWidth (px 0) ] [] [ text string ]