integrated haskell backend with elm-street

backend/app/Main.hs

@@ -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

backend/hs-server.cabal

@@ -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.*

backend/package.yaml

@@ -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

backend/src/ElmskellTypes.hs

@@ -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 Data.Aeson (ToJSON (..), FromJSON (..))
-import Elm.Module
+import Elm
+import GHC.Generics
 
-data Foo
+data Font = Font
-  = Foo
+  { fontFontSize :: Float
-  { name :: String
+  } deriving (Generic)
-  , blablub :: Int
+    deriving (Elm, ToJSON, FromJSON) via ElmStreet Font
-  } deriving (Show, Eq)
 
-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 ()
+data Theme
-main =
+  = Pit
-  putStrLn $ makeElmModule "Foo"
+  | Dim
-  [ DefineElm (Proxy :: Proxy Foo)
+  | 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"]

frontend/elm.json

@@ -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",

frontend/src/ElmskellTypes/Generated/Decoder.elm

@@ -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)

frontend/src/ElmskellTypes/Generated/ElmStreet.elm

@@ -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")
+

frontend/src/ElmskellTypes/Generated/Encoder.elm

@@ -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)
+    ]

frontend/src/ElmskellTypes/Generated/Types.elm

@@ -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
+    }

frontend/src/Main.elm

@@ -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 =
+        localStorage =
-            case D.decodeValue cookiesKeptDecoder flags of
+            case D.decodeValue decodeCookies flags of
-                Ok cK ->
+                Ok cookies ->
-                    cK
+                    cookies
 
                 Err _ ->
-                    { keepTheme = True
+                    defaultCookies
-                    , keepFont = True
-                    , keepPrompt = True
-                    }
     in
     ( { key = key
       , url = url
       , theme =
-            if cookiesKept.keepTheme then
+            if localStorage.cookiesKept.keepTheme then
-                case D.decodeValue (themeDecoder flags) flags of
+                localStorage.theme
-                    Ok theme ->
-                        theme
-
-                    Err _ ->
-                        Pit
 
             else
-                Pit
+                defaultCookies.theme
       , font =
-            if cookiesKept.keepFont then
+            if localStorage.cookiesKept.keepFont then
-                case D.decodeValue fontDecoder flags of
+                localStorage.font
-                    Ok font ->
-                        font
-
-                    Err _ ->
-                        { fontSize = 20.0 }
 
             else
-                { fontSize = 20.0 }
+                defaultCookies.font
-      , cookiesKept = cookiesKept
+      , cookiesKept = localStorage.cookiesKept
       , prompt =
-            if cookiesKept.keepPrompt then
+            if localStorage.cookiesKept.keepPrompt then
-                case D.decodeValue promptDecoder flags of
+                localStorage.prompt
-                    Ok prompt ->
-                        prompt
-
-                    Err _ ->
-                        { 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
+    encodeCookies
-        [ ( "theme"
+        { defaultCookies
-          , E.string <|
+            | font = model.font
-                case model.theme of
+            , cookiesKept = model.cookiesKept
-                    Pit ->
+            , theme = model.theme
-                        "Pit"
+            , prompt = model.prompt
-
+        }
-                    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)
-
-
 
 -- 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
-    List.map
+            (themeColor model)
-        (themeColor model)
+            [ Background
-        [ Background
+            , Foreground
-        , Foreground
+            , Cursor
-        , Cursor
+            , Black
-        , Black
+            , White
-        , White
+            , BrightBlack
-        , BrightBlack
+            , BrightWhite
-        , BrightWhite
+            ]
-        ]
-        
 
 
 

justfile

@@ -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
+types: haskell
-	stack exec ~/.local/bin/hs-server-exe
+  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