177 lines
3.4 KiB
Haskell
177 lines
3.4 KiB
Haskell
module Main where
|
|
|
|
#ifndef ghcjs_HOST_OS
|
|
import Language.Javascript.JSaddle.Warp as JSaddle
|
|
#endif
|
|
|
|
import Data.Bifunctor
|
|
import Data.Default
|
|
import Data.Function
|
|
import GHC.Generics (Generic)
|
|
import Miso
|
|
import Miso.String (toMisoString)
|
|
import NeatInterpolation qualified as Q
|
|
import Page (Page, initialPage, updatePage, viewPage)
|
|
import Page qualified as Page
|
|
import Route (parseURI)
|
|
|
|
data Model = Model
|
|
{ page :: Maybe (Either String Page)
|
|
}
|
|
deriving (Show, Eq, Generic, Default)
|
|
|
|
data Action
|
|
= NoOp
|
|
| Init URI
|
|
| HandleURI URI
|
|
| HandlePage Page.Action
|
|
| SetPage (Either String Page)
|
|
deriving (Show, Eq)
|
|
|
|
#ifndef ghcjs_HOST_OS
|
|
runApp :: JSM () -> IO ()
|
|
runApp f = JSaddle.debugOr 8080 (f >> syncPoint) JSaddle.jsaddleApp
|
|
#else
|
|
runApp :: IO () -> IO ()
|
|
runApp app = app
|
|
#endif
|
|
|
|
main :: IO ()
|
|
main = runApp $ do
|
|
uri <- getCurrentURI
|
|
startApp App {initialAction = Init uri, ..}
|
|
where
|
|
model = def
|
|
update = updateModel
|
|
view = viewModel
|
|
events = defaultEvents
|
|
subs = [uriSub HandleURI]
|
|
mountPoint = Nothing
|
|
logLevel = Off
|
|
|
|
updateModel :: Action -> Model -> Effect Action Model
|
|
updateModel NoOp m = noEff m
|
|
updateModel (Init uri) m =
|
|
m <# do
|
|
SetPage <$> initialPage (parseURI uri)
|
|
updateModel (HandleURI uri) m =
|
|
m <# do
|
|
let route = parseURI uri
|
|
SetPage <$> initialPage route
|
|
updateModel (SetPage page) m = noEff m {page = Just page}
|
|
updateModel (HandlePage action) m =
|
|
case m.page of
|
|
Just (Right page) ->
|
|
updatePage action page
|
|
& bimap HandlePage (\page -> m {page = Just (Right page)})
|
|
_ -> noEff m
|
|
|
|
viewModel :: Model -> View Action
|
|
viewModel model =
|
|
div_ [] $
|
|
[ viewCss,
|
|
viewHeader,
|
|
nav_ [] [viewCollections],
|
|
main_ [] $
|
|
[ HandlePage
|
|
<$> maybe
|
|
(text "..")
|
|
(either err viewPage)
|
|
model.page
|
|
]
|
|
]
|
|
|
|
viewCss :: View Action
|
|
viewCss =
|
|
node
|
|
HTML
|
|
"style"
|
|
Nothing
|
|
[type_ "text/css"]
|
|
[ text
|
|
( toMisoString
|
|
[Q.text|
|
|
/* normalize */
|
|
* {
|
|
box-sizing: border-box; }
|
|
body {
|
|
margin: 0;
|
|
min-height: 100vh; }
|
|
|
|
/* typography */
|
|
html {
|
|
font: Iosevka; }
|
|
|
|
/* layout */
|
|
body > div {
|
|
display: flex;
|
|
flex-flow: row nowrap;
|
|
min-height: 100vh;
|
|
padding-top: 64px;
|
|
align-items: stretch; }
|
|
header {
|
|
position: fixed;
|
|
top: 0; left: 0;
|
|
width: 100%;
|
|
height: 64px; }
|
|
nav, main {
|
|
min-height: 100%; }
|
|
nav {
|
|
flex: 0 0 200px; }
|
|
main {
|
|
flex: 1 1 auto; }
|
|
|
|
/* borders */
|
|
header {
|
|
border-bottom: 1px solid gray; }
|
|
nav {
|
|
border-right: 1px solid gray; }
|
|
|
|
/* padding */
|
|
nav, header, main {
|
|
padding: 16px; }
|
|
|
|
/* scrolling */
|
|
body > div {
|
|
overflow: visible; }
|
|
header {
|
|
overflow: visible; }
|
|
nav, main {
|
|
overflow: auto; }
|
|
|
|
/* header */
|
|
header {
|
|
display: flex;
|
|
align-items: center; }
|
|
header section {
|
|
margin-left: auto; }
|
|
header section:first-child {
|
|
margin-left: 0; }
|
|
|]
|
|
)
|
|
]
|
|
|
|
err :: String -> View action
|
|
err = text . toMisoString . ("err! " <>)
|
|
|
|
viewHeader :: View Action
|
|
viewHeader =
|
|
header_ [] $
|
|
[ section_ [] [h1_ [] [a_ [href_ "#"] [text "acms"]]],
|
|
section_ [] [viewBranch]
|
|
]
|
|
|
|
viewBranch :: View Action
|
|
viewBranch =
|
|
select_ [] [option_ [] [text "main"]]
|
|
|
|
viewCollections :: View Action
|
|
viewCollections =
|
|
section_ [] $
|
|
[ span_ [] [text "collections"],
|
|
ol_ [] $
|
|
[ li_ [] [a_ [href_ "#collection/posts"] [text "posts"]],
|
|
li_ [] [a_ [href_ "#collection/posts1"] [text "posts1"]]
|
|
]
|
|
]
|