add cache rules to haskell, alphabetize soem types, remove Cookies type
This commit is contained in:
mtgmonkey
parent
9ec9c55912
commit
870d8ec257
7 changed files with 209 additions and 239 deletions
File diff suppressed because one or more lines are too long
|
|
@ -32,7 +32,6 @@ index compiledElmApp = renderHtml $ do
|
|||
port :: Port
|
||||
port = 8080
|
||||
|
||||
|
||||
adminContact :: String
|
||||
adminContact = "[Matrix] @mtgmonkey:calitabby.net"
|
||||
|
||||
|
|
@ -69,18 +68,20 @@ main = do
|
|||
|
||||
-- GET requests
|
||||
get "/" $ do
|
||||
shortCache
|
||||
status ok200
|
||||
S.html $ index $ do
|
||||
compiledElmApp
|
||||
"\n"
|
||||
boilerplateJs
|
||||
|
||||
get "/favicon.ico/" $ do
|
||||
shortCache
|
||||
status notFound404
|
||||
S.html $ "you want a favi-<i>what</i>now!?"
|
||||
|
||||
-- ERR
|
||||
notFound $ do
|
||||
noCache
|
||||
status methodNotAllowed405
|
||||
S.text "Verb disallowed; OR, route doesn't exist :("
|
||||
|
||||
|
|
@ -93,6 +94,12 @@ serverErrorReadFile e = H.toHtml $ "document.getElementById('body').innerHTML='S
|
|||
++ adminContact
|
||||
++ "';"
|
||||
|
||||
shortCache :: ActionM ()
|
||||
shortCache = addHeader "Cache-Control" "private, must-understand, stale-if-error=43200, max-age=43200"
|
||||
|
||||
noCache :: ActionM ()
|
||||
noCache = addHeader "Cache-Control" "no-cache"
|
||||
|
||||
embedJs :: Js -> H.Html
|
||||
embedJs js = H.script $ js
|
||||
|
||||
|
|
|
|||
|
|
@ -10,39 +10,27 @@ import Data.Aeson (ToJSON (..), FromJSON (..))
|
|||
import Elm
|
||||
import GHC.Generics
|
||||
|
||||
data Font = Font
|
||||
{ fontFontSize :: Float
|
||||
} deriving (Generic)
|
||||
deriving (Elm, ToJSON, FromJSON) via ElmStreet Font
|
||||
|
||||
data Cookies = Cookies
|
||||
{ cookiesCookiesKept :: CookiesKept
|
||||
, cookiesFont :: Font
|
||||
, cookiesPrompt :: Prompt
|
||||
, cookiesTheme :: Theme
|
||||
} deriving (Generic)
|
||||
deriving (Elm, ToJSON, FromJSON) via ElmStreet Cookies
|
||||
|
||||
data Theme
|
||||
= Pit
|
||||
| Dim
|
||||
| Sky
|
||||
| Sun
|
||||
data Command
|
||||
= ClearCommand
|
||||
| ColorsCommand
|
||||
| CookiesCommand
|
||||
| DebugCommand
|
||||
| FontCommand
|
||||
| HelloCommand
|
||||
| HelpCommand
|
||||
| PromptCommand
|
||||
| ThemeCommand
|
||||
| TodoCommand
|
||||
deriving (Generic)
|
||||
deriving (Elm, ToJSON, FromJSON) via ElmStreet Theme
|
||||
deriving (Elm, ToJSON, FromJSON) via ElmStreet Command
|
||||
|
||||
data CookiesKept = CookiesKept
|
||||
{ cookiesKeptKeepTheme :: Bool
|
||||
, cookiesKeptKeepFont :: Bool
|
||||
{ cookiesKeptKeepFont :: Bool
|
||||
, cookiesKeptKeepPrompt :: Bool
|
||||
, cookiesKeptKeepTheme :: 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
|
||||
|
|
@ -59,6 +47,31 @@ data CoreColor
|
|||
deriving (Generic)
|
||||
deriving (Elm, ToJSON, FromJSON) via ElmStreet CoreColor
|
||||
|
||||
data Font = Font
|
||||
{ fontFontSize :: Float
|
||||
} deriving (Generic)
|
||||
deriving (Elm, ToJSON, FromJSON) via ElmStreet Font
|
||||
|
||||
data Input = Input
|
||||
{ inputCommand :: Command
|
||||
, inputArgs :: [String]
|
||||
}
|
||||
deriving (Generic)
|
||||
deriving (Elm, ToJSON, FromJSON) via ElmStreet Input
|
||||
|
||||
data Prompt = Prompt
|
||||
{ promptPrompt :: String
|
||||
} deriving (Generic)
|
||||
deriving (Elm, ToJSON, FromJSON) via ElmStreet Prompt
|
||||
|
||||
data Theme
|
||||
= Pit
|
||||
| Dim
|
||||
| Sky
|
||||
| Sun
|
||||
deriving (Generic)
|
||||
deriving (Elm, ToJSON, FromJSON) via ElmStreet Theme
|
||||
|
||||
data ThemeColor
|
||||
= Background
|
||||
| Foreground
|
||||
|
|
@ -70,37 +83,15 @@ data ThemeColor
|
|||
deriving (Generic)
|
||||
deriving (Elm, ToJSON, FromJSON) via ElmStreet ThemeColor
|
||||
|
||||
data Command
|
||||
= ClearCommand
|
||||
| ColorsCommand
|
||||
| CookiesCommand
|
||||
| DebugCommand
|
||||
| FontCommand
|
||||
| HelloCommand
|
||||
| HelpCommand
|
||||
| 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
|
||||
'[Command
|
||||
, CookiesKept
|
||||
, Prompt
|
||||
, CoreColor
|
||||
, ThemeColor
|
||||
, Command
|
||||
, Font
|
||||
, Input
|
||||
, Prompt
|
||||
, Theme
|
||||
, ThemeColor
|
||||
]
|
||||
|
||||
generateElmskellTypes :: IO ()
|
||||
|
|
|
|||
|
|
@ -8,40 +8,33 @@ 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 "cookiesKept" decodeCookiesKept
|
||||
|> required "font" decodeFont
|
||||
|> required "prompt" decodePrompt
|
||||
|> required "theme" decodeTheme
|
||||
|
||||
decodeTheme : Decoder T.Theme
|
||||
decodeTheme = elmStreetDecodeEnum T.readTheme
|
||||
decodeCommand : Decoder T.Command
|
||||
decodeCommand = elmStreetDecodeEnum T.readCommand
|
||||
|
||||
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
|
||||
|> required "keepTheme" D.bool
|
||||
|
||||
decodeCoreColor : Decoder T.CoreColor
|
||||
decodeCoreColor = elmStreetDecodeEnum T.readCoreColor
|
||||
|
||||
decodeThemeColor : Decoder T.ThemeColor
|
||||
decodeThemeColor = elmStreetDecodeEnum T.readThemeColor
|
||||
|
||||
decodeCommand : Decoder T.Command
|
||||
decodeCommand = elmStreetDecodeEnum T.readCommand
|
||||
decodeFont : Decoder T.Font
|
||||
decodeFont = D.succeed T.Font
|
||||
|> required "fontSize" D.float
|
||||
|
||||
decodeInput : Decoder T.Input
|
||||
decodeInput = D.succeed T.Input
|
||||
|> required "command" decodeCommand
|
||||
|> required "args" (D.list D.string)
|
||||
|
||||
decodePrompt : Decoder T.Prompt
|
||||
decodePrompt = D.succeed T.Prompt
|
||||
|> required "prompt" D.string
|
||||
|
||||
decodeTheme : Decoder T.Theme
|
||||
decodeTheme = elmStreetDecodeEnum T.readTheme
|
||||
|
||||
decodeThemeColor : Decoder T.ThemeColor
|
||||
decodeThemeColor = elmStreetDecodeEnum T.readThemeColor
|
||||
|
|
|
|||
|
|
@ -7,30 +7,31 @@ import ElmskellTypes.Generated.ElmStreet exposing (..)
|
|||
import ElmskellTypes.Generated.Types as T
|
||||
|
||||
|
||||
encodeCommand : T.Command -> Value
|
||||
encodeCommand = E.string << T.showCommand
|
||||
|
||||
encodeCookiesKept : T.CookiesKept -> Value
|
||||
encodeCookiesKept x = E.object
|
||||
[ ("tag", E.string "CookiesKept")
|
||||
, ("keepFont", E.bool x.keepFont)
|
||||
, ("keepPrompt", E.bool x.keepPrompt)
|
||||
, ("keepTheme", E.bool x.keepTheme)
|
||||
]
|
||||
|
||||
encodeCoreColor : T.CoreColor -> Value
|
||||
encodeCoreColor = E.string << T.showCoreColor
|
||||
|
||||
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")
|
||||
, ("cookiesKept", encodeCookiesKept x.cookiesKept)
|
||||
, ("font", encodeFont x.font)
|
||||
, ("prompt", encodePrompt x.prompt)
|
||||
, ("theme", encodeTheme x.theme)
|
||||
]
|
||||
|
||||
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)
|
||||
encodeInput : T.Input -> Value
|
||||
encodeInput x = E.object
|
||||
[ ("tag", E.string "Input")
|
||||
, ("command", encodeCommand x.command)
|
||||
, ("args", (E.list E.string) x.args)
|
||||
]
|
||||
|
||||
encodePrompt : T.Prompt -> Value
|
||||
|
|
@ -39,18 +40,8 @@ encodePrompt x = E.object
|
|||
, ("prompt", E.string x.prompt)
|
||||
]
|
||||
|
||||
encodeCoreColor : T.CoreColor -> Value
|
||||
encodeCoreColor = E.string << T.showCoreColor
|
||||
encodeTheme : T.Theme -> Value
|
||||
encodeTheme = E.string << T.showTheme
|
||||
|
||||
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)
|
||||
]
|
||||
|
|
|
|||
|
|
@ -4,49 +4,61 @@ import Time exposing (Posix)
|
|||
import Json.Decode exposing (Value)
|
||||
|
||||
|
||||
type alias Font =
|
||||
{ fontSize : Float
|
||||
}
|
||||
type Command
|
||||
= ClearCommand
|
||||
| ColorsCommand
|
||||
| CookiesCommand
|
||||
| DebugCommand
|
||||
| FontCommand
|
||||
| HelloCommand
|
||||
| HelpCommand
|
||||
| PromptCommand
|
||||
| ThemeCommand
|
||||
| TodoCommand
|
||||
|
||||
type alias Cookies =
|
||||
{ cookiesKept : CookiesKept
|
||||
, font : Font
|
||||
, prompt : Prompt
|
||||
, theme : Theme
|
||||
}
|
||||
showCommand : Command -> String
|
||||
showCommand x = case x of
|
||||
ClearCommand -> "ClearCommand"
|
||||
ColorsCommand -> "ColorsCommand"
|
||||
CookiesCommand -> "CookiesCommand"
|
||||
DebugCommand -> "DebugCommand"
|
||||
FontCommand -> "FontCommand"
|
||||
HelloCommand -> "HelloCommand"
|
||||
HelpCommand -> "HelpCommand"
|
||||
PromptCommand -> "PromptCommand"
|
||||
ThemeCommand -> "ThemeCommand"
|
||||
TodoCommand -> "TodoCommand"
|
||||
|
||||
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
|
||||
readCommand : String -> Maybe Command
|
||||
readCommand x = case x of
|
||||
"ClearCommand" -> Just ClearCommand
|
||||
"ColorsCommand" -> Just ColorsCommand
|
||||
"CookiesCommand" -> Just CookiesCommand
|
||||
"DebugCommand" -> Just DebugCommand
|
||||
"FontCommand" -> Just FontCommand
|
||||
"HelloCommand" -> Just HelloCommand
|
||||
"HelpCommand" -> Just HelpCommand
|
||||
"PromptCommand" -> Just PromptCommand
|
||||
"ThemeCommand" -> Just ThemeCommand
|
||||
"TodoCommand" -> Just TodoCommand
|
||||
_ -> Nothing
|
||||
|
||||
universeTheme : List Theme
|
||||
universeTheme = [Pit, Dim, Sky, Sun]
|
||||
universeCommand : List Command
|
||||
universeCommand = [ ClearCommand
|
||||
, ColorsCommand
|
||||
, CookiesCommand
|
||||
, DebugCommand
|
||||
, FontCommand
|
||||
, HelloCommand
|
||||
, HelpCommand
|
||||
, PromptCommand
|
||||
, ThemeCommand
|
||||
, TodoCommand ]
|
||||
|
||||
type alias CookiesKept =
|
||||
{ keepTheme : Bool
|
||||
, keepFont : Bool
|
||||
{ keepFont : Bool
|
||||
, keepPrompt : Bool
|
||||
}
|
||||
|
||||
type alias Prompt =
|
||||
{ prompt : String
|
||||
, keepTheme : Bool
|
||||
}
|
||||
|
||||
type CoreColor
|
||||
|
|
@ -108,6 +120,43 @@ universeCoreColor = [ Red
|
|||
, BrightMagenta
|
||||
, BrightCyan ]
|
||||
|
||||
type alias Font =
|
||||
{ fontSize : Float
|
||||
}
|
||||
|
||||
type alias Input =
|
||||
{ command : Command
|
||||
, args : List String
|
||||
}
|
||||
|
||||
type alias Prompt =
|
||||
{ prompt : String
|
||||
}
|
||||
|
||||
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 ThemeColor
|
||||
= Background
|
||||
| Foreground
|
||||
|
|
@ -146,59 +195,3 @@ universeThemeColor = [ Background
|
|||
, White
|
||||
, BrightBlack
|
||||
, BrightWhite ]
|
||||
|
||||
type Command
|
||||
= ClearCommand
|
||||
| ColorsCommand
|
||||
| CookiesCommand
|
||||
| DebugCommand
|
||||
| FontCommand
|
||||
| HelloCommand
|
||||
| HelpCommand
|
||||
| PromptCommand
|
||||
| ThemeCommand
|
||||
| TodoCommand
|
||||
|
||||
showCommand : Command -> String
|
||||
showCommand x = case x of
|
||||
ClearCommand -> "ClearCommand"
|
||||
ColorsCommand -> "ColorsCommand"
|
||||
CookiesCommand -> "CookiesCommand"
|
||||
DebugCommand -> "DebugCommand"
|
||||
FontCommand -> "FontCommand"
|
||||
HelloCommand -> "HelloCommand"
|
||||
HelpCommand -> "HelpCommand"
|
||||
PromptCommand -> "PromptCommand"
|
||||
ThemeCommand -> "ThemeCommand"
|
||||
TodoCommand -> "TodoCommand"
|
||||
|
||||
readCommand : String -> Maybe Command
|
||||
readCommand x = case x of
|
||||
"ClearCommand" -> Just ClearCommand
|
||||
"ColorsCommand" -> Just ColorsCommand
|
||||
"CookiesCommand" -> Just CookiesCommand
|
||||
"DebugCommand" -> Just DebugCommand
|
||||
"FontCommand" -> Just FontCommand
|
||||
"HelloCommand" -> Just HelloCommand
|
||||
"HelpCommand" -> Just HelpCommand
|
||||
"PromptCommand" -> Just PromptCommand
|
||||
"ThemeCommand" -> Just ThemeCommand
|
||||
"TodoCommand" -> Just TodoCommand
|
||||
_ -> Nothing
|
||||
|
||||
universeCommand : List Command
|
||||
universeCommand = [ ClearCommand
|
||||
, ColorsCommand
|
||||
, CookiesCommand
|
||||
, DebugCommand
|
||||
, FontCommand
|
||||
, HelloCommand
|
||||
, HelpCommand
|
||||
, PromptCommand
|
||||
, ThemeCommand
|
||||
, TodoCommand ]
|
||||
|
||||
type alias Input =
|
||||
{ command : Command
|
||||
, args : List String
|
||||
}
|
||||
|
|
|
|||
|
|
@ -49,7 +49,12 @@ type alias Model =
|
|||
}
|
||||
|
||||
|
||||
defaultCookies : Cookies
|
||||
defaultCookies :
|
||||
{ cookiesKept : CookiesKept
|
||||
, font : Font
|
||||
, prompt : Prompt
|
||||
, theme : Theme
|
||||
}
|
||||
defaultCookies =
|
||||
{ font = { fontSize = 20.0 }
|
||||
, cookiesKept =
|
||||
|
|
@ -74,24 +79,31 @@ init flags url key =
|
|||
case D.decodeValue (D.field "Theme" decodeTheme) flags of
|
||||
Ok val ->
|
||||
val
|
||||
|
||||
Err _ ->
|
||||
defaultCookies.theme
|
||||
|
||||
pr =
|
||||
case D.decodeValue (D.field "Prompt" decodePrompt) flags of
|
||||
Ok val ->
|
||||
val
|
||||
|
||||
Err _ ->
|
||||
defaultCookies.prompt
|
||||
|
||||
cK =
|
||||
case D.decodeValue (D.field "CookiesKept" decodeCookiesKept) flags of
|
||||
Ok val ->
|
||||
val
|
||||
|
||||
Err _ ->
|
||||
defaultCookies.cookiesKept
|
||||
|
||||
fo =
|
||||
case D.decodeValue (D.field "Font" decodeFont) flags of
|
||||
Ok val ->
|
||||
val
|
||||
|
||||
Err _ ->
|
||||
defaultCookies.font
|
||||
in
|
||||
|
|
@ -715,14 +727,8 @@ runTodo model args =
|
|||
++ "\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>"
|
||||
++ "\n- Figure out a better way to parse commands"
|
||||
++ "\n- Add cache headers"
|
||||
]
|
||||
}
|
||||
|
||||
|
|
@ -823,6 +829,24 @@ cookiesKeptToString cookiesKept =
|
|||
++ "\n}"
|
||||
|
||||
|
||||
|
||||
-- PORTS
|
||||
-- sets localStorage 'cookies' to E.Value
|
||||
|
||||
|
||||
port setStorage : ( String, E.Value ) -> Cmd a
|
||||
|
||||
|
||||
port getStorage : String -> Cmd a
|
||||
|
||||
|
||||
port receiveStorageFromJS : (E.Value -> msg) -> Sub msg
|
||||
|
||||
|
||||
|
||||
-- JSON
|
||||
|
||||
|
||||
saveCookiesKept : Model -> ( Model, Cmd Msg )
|
||||
saveCookiesKept model =
|
||||
( model, setStorage ( "CookiesKept", encodeCookiesKept model.cookiesKept ) )
|
||||
|
|
@ -849,35 +873,6 @@ loadStorage model key =
|
|||
|
||||
|
||||
|
||||
-- PORTS
|
||||
-- sets localStorage 'cookies' to E.Value
|
||||
|
||||
|
||||
port setStorage : ( String, E.Value ) -> Cmd a
|
||||
|
||||
|
||||
port getStorage : String -> Cmd a
|
||||
|
||||
|
||||
port receiveStorageFromJS : (E.Value -> msg) -> Sub msg
|
||||
|
||||
|
||||
|
||||
-- JSON
|
||||
|
||||
|
||||
encodeModel : Model -> E.Value
|
||||
encodeModel model =
|
||||
encodeCookies
|
||||
{ defaultCookies
|
||||
| font = model.font
|
||||
, cookiesKept = model.cookiesKept
|
||||
, theme = model.theme
|
||||
, prompt = model.prompt
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- SUBSCRIPTIONS
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue