elmskell/frontend/src/Main.elm
2025-05-06 20:34:50 -04:00

1089 lines
31 KiB
Elm

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 <arg> prints more information about <command>|"
++ "\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 <command> prints more information about <command>"
]
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 <cookieName> [true|false] sets whether to store a certain cookie"
++ "\noptions for <cookieName> 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 <float> changes fontSize to <float> if <float> is >0"
++ "\nfont reset changes fontSize to the default of 20px"
]
Just "prompt" ->
[ text <|
"\nprompt prints info about the current prompt"
++ "\nprompt set <arg> sets prompt text to <arg>"
++ "\n <arg> is specified in quotes"
++ "\nprompt color <color> sets prompt color to <color>"
++ "\n run `colors` to list available colors"
]
Just "theme" ->
[ text <|
"\ntheme <arg> sets the current theme according to <arg>"
++ "\nOptions for <arg> 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 <float> 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 <color> <value>"
++ "\ntheme save <name>"
++ "\ntheme load <name>"
++ "\nfeedback <bug|request|good> <content>"
]
}
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 ]