Andromeda/elmskell
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

integrated haskell backend with elm-street

Browse source
This commit is contained in:
mtgmonkey 2025-05-06 20:34:50 -04:00
parent c86f613ccc
commit d6d84423e0
12 changed files with 573 additions and 273 deletions
Download patch file Download diff file Expand all files Collapse all files

2
assets/js/main.js
View file

File diff suppressed because one or more lines are too long

6
backend/app/Main.hs
View file

@ -1,7 +1,8 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Lib
import ElmskellTypes
import Data.Text.Lazy (Text)
import Network.Wai.Handler.Warp (Port)
import Network.Wai.Middleware.RequestLogger (logStdoutDev)
@ -46,6 +47,9 @@ assetsFolder = "/home/mtgmonkey/elmskell/assets"
-- MAIN
main :: IO ()
main = do
generateElmskellTypes
compiledElmAppOrExc <- E.try $ readFile $ assetsFolder ++ compiledElmAppFile :: IO (Either E.IOException String)
let compiledElmApp = case compiledElmAppOrExc of
Left e -> serverErrorReadFile e

15
backend/hs-server.cabal
View file

@ -28,11 +28,12 @@ library
src
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
build-depends:
base >=4.19.2 && <4.20
aeson >=2.2.3 && <2.3
, base >=4.19.2 && <4.20
, blaze-html >=0.9.2 && <0.10
, blaze-markup >=0.8.3 && <0.9
, directory >=1.3.8 && <1.4
, elm-bridge >=0.8.4 && <0.9
, elm-street >=0.2.2 && <0.3
, http-types >=0.12.4 && <0.13
, scotty ==0.22.*
, text >=2.1.1 && <2.2
@ -50,11 +51,12 @@ executable hs-server-exe
app
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
build-depends:
base >=4.19.2 && <4.20
aeson >=2.2.3 && <2.3
, base >=4.19.2 && <4.20
, blaze-html >=0.9.2 && <0.10
, blaze-markup >=0.8.3 && <0.9
, directory >=1.3.8 && <1.4
, elm-bridge >=0.8.4 && <0.9
, elm-street >=0.2.2 && <0.3
, hs-server
, http-types >=0.12.4 && <0.13
, scotty ==0.22.*
@ -74,11 +76,12 @@ test-suite hs-server-test
test
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
build-depends:
base >=4.19.2 && <4.20
aeson >=2.2.3 && <2.3
, base >=4.19.2 && <4.20
, blaze-html >=0.9.2 && <0.10
, blaze-markup >=0.8.3 && <0.9
, directory >=1.3.8 && <1.4
, elm-bridge >=0.8.4 && <0.9
, elm-street >=0.2.2 && <0.3
, hs-server
, http-types >=0.12.4 && <0.13
, scotty ==0.22.*

2
backend/package.yaml
View file

@ -19,10 +19,12 @@ extra-source-files:
description: Please see README.md
dependencies:
- aeson >= 2.2.3 && < 2.3
- base >= 4.19.2 && < 4.20
- blaze-html >= 0.9.2 && < 0.10
- blaze-markup >= 0.8.3 && < 0.9
- directory >= 1.3.8 && < 1.4
- elm-street >= 0.2.2 && < 0.3
- http-types >= 0.12.4 && < 0.13
- scotty >= 0.22 && < 0.23
- text >= 2.1.1 && < 2.2

114
backend/src/ElmskellTypes.hs
View file

@ -1,20 +1,106 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE TypeApplications #-}
module ElmskellTypes
module ElmskellTypes (generateElmskellTypes) where
import Elm.Derive
import Elm.Module
import Data.Aeson (ToJSON (..), FromJSON (..))
import Elm
import GHC.Generics
data Foo
= Foo
{ name :: String
, blablub :: Int
} deriving (Show, Eq)
data Font = Font
{ fontFontSize :: Float
} deriving (Generic)
deriving (Elm, ToJSON, FromJSON) via ElmStreet Font
deriveBoth defaultOptions ''Foo
data Cookies = Cookies
{ cookiesFont :: Font
, cookiesCookiesKept :: CookiesKept
, cookiesTheme :: Theme
, cookiesPrompt :: Prompt
} deriving (Generic)
deriving (Elm, ToJSON, FromJSON) via ElmStreet Cookies
main :: IO ()
main =
putStrLn $ makeElmModule "Foo"
[ DefineElm (Proxy :: Proxy Foo)
data Theme
= Pit
| Dim
| Sky
| Sun
deriving (Generic)
deriving (Elm, ToJSON, FromJSON) via ElmStreet Theme
data CookiesKept = CookiesKept
{ cookiesKeptKeepTheme :: Bool
, cookiesKeptKeepFont :: Bool
, cookiesKeptKeepPrompt :: Bool
} deriving (Generic)
deriving (Elm, ToJSON, FromJSON) via ElmStreet CookiesKept
data Prompt = Prompt
{ promptPrompt :: String
} deriving (Generic)
deriving (Elm, ToJSON, FromJSON) via ElmStreet Prompt
data CoreColor
= Red
| Green
| Yellow
| Blue
| Magenta
| Cyan
| BrightRed
| BrightGreen
| BrightYellow
| BrightBlue
| BrightMagenta
| BrightCyan
deriving (Generic)
deriving (Elm, ToJSON, FromJSON) via ElmStreet CoreColor
data ThemeColor
= Background
| Foreground
| Cursor
| Black
| White
| BrightBlack
| BrightWhite
deriving (Generic)
deriving (Elm, ToJSON, FromJSON) via ElmStreet ThemeColor
data Command
= HelpCommand
| ClearCommand
| ColorsCommand
| CookiesCommand
| FontCommand
| HelloCommand
| PromptCommand
| ThemeCommand
| TodoCommand
deriving (Generic)
deriving (Elm, ToJSON, FromJSON) via ElmStreet Command
data Input = Input
{ inputCommand :: Command
, inputArgs :: [String]
}
deriving (Generic)
deriving (Elm, ToJSON, FromJSON) via ElmStreet Input
type Types =
'[Font
, Cookies
, Theme
, CookiesKept
, Prompt
, CoreColor
, ThemeColor
, Command
, Input
]
generateElmskellTypes :: IO ()
generateElmskellTypes = generateElm @Types $ defaultSettings "frontend/src" ["ElmskellTypes", "Generated"]

8
frontend/elm.json
View file

@ -6,20 +6,24 @@
"elm-version": "0.19.1",
"dependencies": {
"direct": {
"NoRedInk/elm-json-decode-pipeline": "1.0.1",
"bartavelle/json-helpers": "2.0.2",
"elm/browser": "1.0.2",
"elm/core": "1.0.5",
"elm/html": "1.0.0",
"elm/json": "1.1.3",
"elm/time": "1.0.0",
"elm/url": "1.0.0",
"lobanov/elm-localstorage": "1.0.1",
"rtfeldman/elm-css": "18.0.0"
"rtfeldman/elm-css": "18.0.0",
"rtfeldman/elm-iso8601-date-strings": "1.1.4"
},
"indirect": {
"elm/bytes": "1.0.8",
"elm/file": "1.0.5",
"elm/http": "2.0.0",
"elm/parser": "1.1.0",
"elm/random": "1.0.0",
"elm/time": "1.0.0",
"elm/virtual-dom": "1.0.3",
"lobanov/elm-taskport": "2.0.1",
"robinheghan/murmur3": "1.0.0",

47
frontend/src/ElmskellTypes/Generated/Decoder.elm Normal file
View file

@ -0,0 +1,47 @@
module ElmskellTypes.Generated.Decoder exposing (..)
import Iso8601 as Iso
import Json.Decode as D exposing (..)
import Json.Decode.Pipeline as D exposing (required)
import ElmskellTypes.Generated.ElmStreet exposing (..)
import ElmskellTypes.Generated.Types as T
decodeFont : Decoder T.Font
decodeFont = D.succeed T.Font
|> required "fontSize" D.float
decodeCookies : Decoder T.Cookies
decodeCookies = D.succeed T.Cookies
|> required "font" decodeFont
|> required "cookiesKept" decodeCookiesKept
|> required "theme" decodeTheme
|> required "prompt" decodePrompt
decodeTheme : Decoder T.Theme
decodeTheme = elmStreetDecodeEnum T.readTheme
decodeCookiesKept : Decoder T.CookiesKept
decodeCookiesKept = D.succeed T.CookiesKept
|> required "keepTheme" D.bool
|> required "keepFont" D.bool
|> required "keepPrompt" D.bool
decodePrompt : Decoder T.Prompt
decodePrompt = D.succeed T.Prompt
|> required "prompt" D.string
decodeCoreColor : Decoder T.CoreColor
decodeCoreColor = elmStreetDecodeEnum T.readCoreColor
decodeThemeColor : Decoder T.ThemeColor
decodeThemeColor = elmStreetDecodeEnum T.readThemeColor
decodeCommand : Decoder T.Command
decodeCommand = elmStreetDecodeEnum T.readCommand
decodeInput : Decoder T.Input
decodeInput = D.succeed T.Input
|> required "command" decodeCommand
|> required "args" (D.list D.string)

52
frontend/src/ElmskellTypes/Generated/ElmStreet.elm Normal file
View file

@ -0,0 +1,52 @@
module ElmskellTypes.Generated.ElmStreet exposing (..)
import Json.Encode as E exposing (Value)
import Json.Decode as D exposing (Decoder)
import Json.Decode.Pipeline as D exposing (..)
elmStreetEncodeMaybe : (a -> Value) -> Maybe a -> Value
elmStreetEncodeMaybe enc = Maybe.withDefault E.null << Maybe.map enc
elmStreetEncodeEither : (a -> Value) -> (b -> Value) -> Result a b -> Value
elmStreetEncodeEither encA encB res = E.object <| case res of
Err a -> [("Left", encA a)]
Ok b -> [("Right", encB b)]
elmStreetEncodePair : (a -> Value) -> (b -> Value) -> (a, b) -> Value
elmStreetEncodePair encA encB (a, b) = E.list identity [encA a, encB b]
elmStreetEncodeTriple : (a -> Value) -> (b -> Value) -> (c -> Value) -> (a, b, c) -> Value
elmStreetEncodeTriple encA encB encC (a, b, c) = E.list identity [encA a, encB b, encC c]
elmStreetEncodeNonEmpty : (a -> Value) -> (a, List a) -> Value
elmStreetEncodeNonEmpty encA (a, xs) = E.list encA <| a :: xs
decodeStr : (String -> Maybe a) -> String -> Decoder a
decodeStr readX x = case readX x of
Just a -> D.succeed a
Nothing -> D.fail "Constructor not matched"
elmStreetDecodeEnum : (String -> Maybe a) -> Decoder a
elmStreetDecodeEnum r = D.andThen (decodeStr r) D.string
elmStreetDecodeChar : Decoder Char
elmStreetDecodeChar = D.andThen (decodeStr (Maybe.map Tuple.first << String.uncons)) D.string
elmStreetDecodeEither : Decoder a -> Decoder b -> Decoder (Result a b)
elmStreetDecodeEither decA decB = D.oneOf
[ D.field "Left" (D.map Err decA)
, D.field "Right" (D.map Ok decB)
]
elmStreetDecodePair : Decoder a -> Decoder b -> Decoder (a, b)
elmStreetDecodePair decA decB = D.map2 Tuple.pair (D.index 0 decA) (D.index 1 decB)
elmStreetDecodeTriple : Decoder a -> Decoder b -> Decoder c -> Decoder (a, b, c)
elmStreetDecodeTriple decA decB decC = D.map3 (\a b c -> (a,b,c)) (D.index 0 decA) (D.index 1 decB) (D.index 2 decC)
elmStreetDecodeNonEmpty : Decoder a -> Decoder (a, List a)
elmStreetDecodeNonEmpty decA = D.list decA |> D.andThen (\xs -> case xs of
h::t -> D.succeed (h, t)
_ -> D.fail "Expecting non-empty array")

56
frontend/src/ElmskellTypes/Generated/Encoder.elm Normal file
View file

@ -0,0 +1,56 @@
module ElmskellTypes.Generated.Encoder exposing (..)
import Iso8601 as Iso
import Json.Encode as E exposing (..)
import ElmskellTypes.Generated.ElmStreet exposing (..)
import ElmskellTypes.Generated.Types as T
encodeFont : T.Font -> Value
encodeFont x = E.object
[ ("tag", E.string "Font")
, ("fontSize", E.float x.fontSize)
]
encodeCookies : T.Cookies -> Value
encodeCookies x = E.object
[ ("tag", E.string "Cookies")
, ("font", encodeFont x.font)
, ("cookiesKept", encodeCookiesKept x.cookiesKept)
, ("theme", encodeTheme x.theme)
, ("prompt", encodePrompt x.prompt)
]
encodeTheme : T.Theme -> Value
encodeTheme = E.string << T.showTheme
encodeCookiesKept : T.CookiesKept -> Value
encodeCookiesKept x = E.object
[ ("tag", E.string "CookiesKept")
, ("keepTheme", E.bool x.keepTheme)
, ("keepFont", E.bool x.keepFont)
, ("keepPrompt", E.bool x.keepPrompt)
]
encodePrompt : T.Prompt -> Value
encodePrompt x = E.object
[ ("tag", E.string "Prompt")
, ("prompt", E.string x.prompt)
]
encodeCoreColor : T.CoreColor -> Value
encodeCoreColor = E.string << T.showCoreColor
encodeThemeColor : T.ThemeColor -> Value
encodeThemeColor = E.string << T.showThemeColor
encodeCommand : T.Command -> Value
encodeCommand = E.string << T.showCommand
encodeInput : T.Input -> Value
encodeInput x = E.object
[ ("tag", E.string "Input")
, ("command", encodeCommand x.command)
, ("args", (E.list E.string) x.args)
]

200
frontend/src/ElmskellTypes/Generated/Types.elm Normal file
View file

@ -0,0 +1,200 @@
module ElmskellTypes.Generated.Types exposing (..)
import Time exposing (Posix)
import Json.Decode exposing (Value)
type alias Font =
{ fontSize : Float
}
type alias Cookies =
{ font : Font
, cookiesKept : CookiesKept
, theme : Theme
, prompt : Prompt
}
type Theme
= Pit
| Dim
| Sky
| Sun
showTheme : Theme -> String
showTheme x = case x of
Pit -> "Pit"
Dim -> "Dim"
Sky -> "Sky"
Sun -> "Sun"
readTheme : String -> Maybe Theme
readTheme x = case x of
"Pit" -> Just Pit
"Dim" -> Just Dim
"Sky" -> Just Sky
"Sun" -> Just Sun
_ -> Nothing
universeTheme : List Theme
universeTheme = [Pit, Dim, Sky, Sun]
type alias CookiesKept =
{ keepTheme : Bool
, keepFont : Bool
, keepPrompt : Bool
}
type alias Prompt =
{ prompt : String
}
type CoreColor
= Red
| Green
| Yellow
| Blue
| Magenta
| Cyan
| BrightRed
| BrightGreen
| BrightYellow
| BrightBlue
| BrightMagenta
| BrightCyan
showCoreColor : CoreColor -> String
showCoreColor x = case x of
Red -> "Red"
Green -> "Green"
Yellow -> "Yellow"
Blue -> "Blue"
Magenta -> "Magenta"
Cyan -> "Cyan"
BrightRed -> "BrightRed"
BrightGreen -> "BrightGreen"
BrightYellow -> "BrightYellow"
BrightBlue -> "BrightBlue"
BrightMagenta -> "BrightMagenta"
BrightCyan -> "BrightCyan"
readCoreColor : String -> Maybe CoreColor
readCoreColor x = case x of
"Red" -> Just Red
"Green" -> Just Green
"Yellow" -> Just Yellow
"Blue" -> Just Blue
"Magenta" -> Just Magenta
"Cyan" -> Just Cyan
"BrightRed" -> Just BrightRed
"BrightGreen" -> Just BrightGreen
"BrightYellow" -> Just BrightYellow
"BrightBlue" -> Just BrightBlue
"BrightMagenta" -> Just BrightMagenta
"BrightCyan" -> Just BrightCyan
_ -> Nothing
universeCoreColor : List CoreColor
universeCoreColor = [ Red
, Green
, Yellow
, Blue
, Magenta
, Cyan
, BrightRed
, BrightGreen
, BrightYellow
, BrightBlue
, BrightMagenta
, BrightCyan ]
type ThemeColor
= Background
| Foreground
| Cursor
| Black
| White
| BrightBlack
| BrightWhite
showThemeColor : ThemeColor -> String
showThemeColor x = case x of
Background -> "Background"
Foreground -> "Foreground"
Cursor -> "Cursor"
Black -> "Black"
White -> "White"
BrightBlack -> "BrightBlack"
BrightWhite -> "BrightWhite"
readThemeColor : String -> Maybe ThemeColor
readThemeColor x = case x of
"Background" -> Just Background
"Foreground" -> Just Foreground
"Cursor" -> Just Cursor
"Black" -> Just Black
"White" -> Just White
"BrightBlack" -> Just BrightBlack
"BrightWhite" -> Just BrightWhite
_ -> Nothing
universeThemeColor : List ThemeColor
universeThemeColor = [ Background
, Foreground
, Cursor
, Black
, White
, BrightBlack
, BrightWhite ]
type Command
= HelpCommand
| ClearCommand
| ColorsCommand
| CookiesCommand
| FontCommand
| HelloCommand
| PromptCommand
| ThemeCommand
| TodoCommand
showCommand : Command -> String
showCommand x = case x of
HelpCommand -> "HelpCommand"
ClearCommand -> "ClearCommand"
ColorsCommand -> "ColorsCommand"
CookiesCommand -> "CookiesCommand"
FontCommand -> "FontCommand"
HelloCommand -> "HelloCommand"
PromptCommand -> "PromptCommand"
ThemeCommand -> "ThemeCommand"
TodoCommand -> "TodoCommand"
readCommand : String -> Maybe Command
readCommand x = case x of
"HelpCommand" -> Just HelpCommand
"ClearCommand" -> Just ClearCommand
"ColorsCommand" -> Just ColorsCommand
"CookiesCommand" -> Just CookiesCommand
"FontCommand" -> Just FontCommand
"HelloCommand" -> Just HelloCommand
"PromptCommand" -> Just PromptCommand
"ThemeCommand" -> Just ThemeCommand
"TodoCommand" -> Just TodoCommand
_ -> Nothing
universeCommand : List Command
universeCommand = [ HelpCommand
, ClearCommand
, ColorsCommand
, CookiesCommand
, FontCommand
, HelloCommand
, PromptCommand
, ThemeCommand
, TodoCommand ]
type alias Input =
{ command : Command
, args : List String
}

321
frontend/src/Main.elm
View file

@ -4,6 +4,10 @@ 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)
@ -33,23 +37,6 @@ main =
-- MODEL
type alias Font =
{ fontSize : Float
}
type alias CookiesKept =
{ keepTheme : Bool
, keepFont : Bool
, keepPrompt : Bool
}
type alias Prompt =
{ prompt : String
}
type alias Model =
{ key : Nav.Key
, url : Url.Url
@ -62,6 +49,19 @@ type alias Model =
}
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
@ -70,53 +70,35 @@ init flags url key =
, text "\nRun `help` to get started"
]
cookiesKept =
case D.decodeValue cookiesKeptDecoder flags of
Ok cK ->
cK
localStorage =
case D.decodeValue decodeCookies flags of
Ok cookies ->
cookies
Err _ ->
{ keepTheme = True
, keepFont = True
, keepPrompt = True
}
defaultCookies
in
( { key = key
, url = url
, theme =
if cookiesKept.keepTheme then
case D.decodeValue (themeDecoder flags) flags of
Ok theme ->
theme
Err _ ->
Pit
if localStorage.cookiesKept.keepTheme then
localStorage.theme
else
Pit
defaultCookies.theme
, font =
if cookiesKept.keepFont then
case D.decodeValue fontDecoder flags of
Ok font ->
font
Err _ ->
{ fontSize = 20.0 }
if localStorage.cookiesKept.keepFont then
localStorage.font
else
{ fontSize = 20.0 }
, cookiesKept = cookiesKept
defaultCookies.font
, cookiesKept = localStorage.cookiesKept
, prompt =
if cookiesKept.keepPrompt then
case D.decodeValue promptDecoder flags of
Ok prompt ->
prompt
Err _ ->
{ prompt = ">" }
if localStorage.cookiesKept.keepPrompt then
localStorage.prompt
else
{ prompt = ">" }
defaultCookies.prompt
, content = initContent
, cliContent = ""
}
@ -182,24 +164,6 @@ update msg model =
-- COMMANDS
type Command
= Help
| Clear
| Colors
| Cookies
| FontCommand
| Hello
| PromptCommand
| Theme
| Todo
type alias Input =
{ command : Command
, args : List String
}
parseInput : String -> Result String Input
parseInput input =
let
@ -209,31 +173,31 @@ parseInput input =
command =
case List.head tokens of
Just "help" ->
Ok Help
Ok HelpCommand
Just "clear" ->
Ok Clear
Ok ClearCommand
Just "colors" ->
Ok Colors
Ok ColorsCommand
Just "cookies" ->
Ok Cookies
Ok CookiesCommand
Just "font" ->
Ok FontCommand
Just "hello" ->
Ok Hello
Ok HelloCommand
Just "prompt" ->
Ok PromptCommand
Just "theme" ->
Ok Theme
Ok ThemeCommand
Just "todo" ->
Ok Todo
Ok TodoCommand
Just trimput ->
Err trimput
@ -267,31 +231,31 @@ runCommand model input =
case input of
Ok { command, args } ->
(case command of
Help ->
HelpCommand ->
runHelp
Clear ->
ClearCommand ->
runClear
Colors ->
ColorsCommand ->
runColors
Cookies ->
CookiesCommand ->
runCookies
FontCommand ->
runFont
Hello ->
HelloCommand ->
runHello
PromptCommand ->
runPrompt
Theme ->
ThemeCommand ->
runTheme
Todo ->
TodoCommand ->
runTodo
)
model
@ -308,10 +272,6 @@ runCommand model input =
)
-- COMMANDS
type alias CommandRunner =
Model -> List String -> ( Model, Cmd Msg )
@ -395,10 +355,10 @@ runHelp model args =
[ text "\ntodo prints aspirations for the site" ]
Just string ->
wrongArgs Help 1 args
wrongArgs HelpCommand 1 args
else
wrongArgs Help 1 args
wrongArgs HelpCommand 1 args
)
}
, Cmd.none
@ -412,7 +372,7 @@ runClear model args =
{ model | content = [] }
Just string ->
{ model | content = model.content ++ wrongArgs Clear 0 args }
{ model | content = model.content ++ wrongArgs ClearCommand 0 args }
, Cmd.none
)
@ -421,7 +381,7 @@ runColors : CommandRunner
runColors model args =
case List.head args of
Nothing ->
( { model | content = model.content ++ wrongArgs Colors 1 args }, Cmd.none )
( { model | content = model.content ++ wrongArgs ColorsCommand 1 args }, Cmd.none )
Just "test" ->
( { model
@ -433,7 +393,7 @@ runColors model args =
)
Just _ ->
( { model | content = model.content ++ wrongArgs Colors 1 args }, Cmd.none )
( { model | content = model.content ++ wrongArgs ColorsCommand 1 args }, Cmd.none )
runCookies : CommandRunner
@ -475,12 +435,12 @@ runCookies model args =
""
in
if third == "" then
( { model | content = model.content ++ wrongArgs Cookies 3 args }, Cmd.none )
( { model | content = model.content ++ wrongArgs CookiesCommand 3 args }, Cmd.none )
else
case second of
"" ->
( { model | content = model.content ++ wrongArgs Cookies 2 args }, Cmd.none )
( { model | content = model.content ++ wrongArgs CookiesCommand 2 args }, Cmd.none )
"keepFont" ->
case third of
@ -491,7 +451,7 @@ runCookies model args =
saveModel { model | cookiesKept = { cookiesKept | keepFont = False } }
_ ->
( { model | content = model.content ++ wrongArgs Cookies 3 args }, Cmd.none )
( { model | content = model.content ++ wrongArgs CookiesCommand 3 args }, Cmd.none )
"keepTheme" ->
case third of
@ -502,7 +462,7 @@ runCookies model args =
saveModel { model | cookiesKept = { cookiesKept | keepTheme = False } }
_ ->
( { model | content = model.content ++ wrongArgs Cookies 3 args }, Cmd.none )
( { model | content = model.content ++ wrongArgs CookiesCommand 3 args }, Cmd.none )
"keepPrompt" ->
case third of
@ -513,13 +473,13 @@ runCookies model args =
saveModel { model | cookiesKept = { cookiesKept | keepPrompt = False } }
_ ->
( { model | content = model.content ++ wrongArgs Cookies 3 args }, Cmd.none )
( { model | content = model.content ++ wrongArgs CookiesCommand 3 args }, Cmd.none )
_ ->
( { model | content = model.content ++ wrongArgs Cookies 2 args }, Cmd.none )
( { model | content = model.content ++ wrongArgs CookiesCommand 2 args }, Cmd.none )
Just string ->
( { model | content = model.content ++ wrongArgs Cookies 1 args }, Cmd.none )
( { model | content = model.content ++ wrongArgs CookiesCommand 1 args }, Cmd.none )
runHello : CommandRunner
@ -529,7 +489,7 @@ runHello model args =
( { model | content = model.content ++ [ text "\nHello World!" ] }, Cmd.none )
_ ->
( { model | content = model.content ++ wrongArgs Hello 0 args }, Cmd.none )
( { model | content = model.content ++ wrongArgs HelloCommand 0 args }, Cmd.none )
runFont : CommandRunner
@ -682,7 +642,7 @@ runTheme model args =
setTheme model Pit
Just string ->
( { model | content = model.content ++ wrongArgs Theme 1 args }, Cmd.none )
( { model | content = model.content ++ wrongArgs ThemeCommand 1 args }, Cmd.none )
runTodo : CommandRunner
@ -711,7 +671,7 @@ runTodo model args =
}
Just _ ->
{ model | content = model.content ++ wrongArgs Todo 0 args }
{ model | content = model.content ++ wrongArgs TodoCommand 0 args }
, Cmd.none
)
@ -734,31 +694,31 @@ wrongArgs command expected args =
let
comstr =
case command of
Help ->
HelpCommand ->
"help"
Clear ->
ClearCommand ->
"clear"
Colors ->
ColorsCommand ->
"colors"
Cookies ->
CookiesCommand ->
"cookies"
FontCommand ->
"font"
Hello ->
HelloCommand ->
"hello"
PromptCommand ->
"prompt"
Theme ->
ThemeCommand ->
"theme"
Todo ->
TodoCommand ->
"todo"
in
[ text
@ -823,88 +783,13 @@ port setStorage : E.Value -> Cmd a
encodeModel : Model -> E.Value
encodeModel model =
E.object
[ ( "theme"
, E.string <|
case model.theme of
Pit ->
"Pit"
Dim ->
"Dim"
Sky ->
"Sky"
Sun ->
"Sun"
)
, ( "font"
, E.object
[ ( "fontSize"
, E.float model.font.fontSize
)
]
)
, ( "cookiesKept"
, E.object
[ ( "keepTheme", E.bool model.cookiesKept.keepTheme )
, ( "keepFont", E.bool model.cookiesKept.keepFont )
, ( "keepPrompt", E.bool model.cookiesKept.keepPrompt )
]
)
, ( "prompt"
, E.object
[ ( "prompt"
, E.string model.prompt.prompt
)
]
)
]
themeDecoder : E.Value -> D.Decoder Theme
themeDecoder flags =
case D.decodeValue (D.field "theme" D.string) flags of
Ok "Pit" ->
D.succeed Pit
Ok "Dim" ->
D.succeed Dim
Ok "Sky" ->
D.succeed Sky
Ok "Sun" ->
D.succeed Sun
Ok _ ->
D.fail "Unknown value found in theme field of json"
Err _ ->
D.fail "Error decoding theme field of json"
fontDecoder : D.Decoder Font
fontDecoder =
D.map Font
(D.at [ "font", "fontSize" ] D.float)
cookiesKeptDecoder : D.Decoder CookiesKept
cookiesKeptDecoder =
D.map3 CookiesKept
(D.at [ "cookiesKept", "keepTheme" ] D.bool)
(D.at [ "cookiesKept", "keepFont" ] D.bool)
(D.at [ "cookiesKept", "keepPrompt" ] D.bool)
promptDecoder : D.Decoder Prompt
promptDecoder =
D.map Prompt
(D.at [ "prompt", "prompt" ] D.string)
encodeCookies
{ defaultCookies
| font = model.font
, cookiesKept = model.cookiesKept
, theme = model.theme
, prompt = model.prompt
}
-- SUBSCRIPTIONS
@ -940,40 +825,6 @@ viewBody model =
-- STYLES
type Theme
= Pit
| Dim
| Sky
| Sun
type CoreColor
= Red
| Green
| Yellow
| Blue
| Magenta
| Cyan
| BrightRed
| BrightGreen
| BrightYellow
| BrightBlue
| BrightMagenta
| BrightCyan
type ThemeColor
= Background
| Foreground
| Cursor
| Black
| White
| BrightBlack
| BrightWhite
allColors : Model -> List Color
allColors model =
List.map
@ -991,18 +842,16 @@ allColors model =
, BrightMagenta
, BrightCyan
]
++
List.map
(themeColor model)
[ Background
, Foreground
, Cursor
, Black
, White
, BrightBlack
, BrightWhite
]
++ List.map
(themeColor model)
[ Background
, Foreground
, Cursor
, Black
, White
, BrightBlack
, BrightWhite
]

23
justfile
View file

@ -1,20 +1,17 @@
help:
echo compile builds both ends
echo produce builds, minifies, optimises both ends
echo run produces before executing the result
echo elm builds the elm
echo haskell builds the haskell
echo format-elm formats the elm
echo produce-elm builds, minifies, optimises the elm
compile: elm haskell
produce: produce-elm haskell
echo "REMEMBER to RESTART elmskell.service TO UPDATE SITE IN PLACE"
echo "REMEMBER to RUN sudo iptables-apply -t 60 /etc/iptables/iptables.rules IF YOU HAVEN'T SINCE RESTART"
run: produce
stack exec ~/.local/bin/hs-server-exe
types: haskell
rm -rf frontend/src/ElmskellTypes/Generated
stack exec ~/.local/bin/hs-server-exe
compile: elm haskell
run: produce exec
exec:
stack exec ~/.local/bin/hs-server-exe
haskell:
cd backend && stack install