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"]] ] ]