This commit is contained in:
Alexander Foremny
2024-06-04 12:32:59 +02:00
parent 9d3c32956b
commit 03b019ca96
2 changed files with 100 additions and 5 deletions

View File

@@ -26,6 +26,7 @@ import Form qualified as F
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Miso import Miso
import Miso.String (toMisoString) import Miso.String (toMisoString)
import NeatInterpolation qualified as Q
data Model = Model data Model = Model
{ schema :: Maybe (Either String Schema), { schema :: Maybe (Either String Schema),
@@ -162,15 +163,108 @@ viewModel :: Model -> View Action
viewModel model = viewModel model =
let input = fromMaybe (A.Object AM.empty) model.input let input = fromMaybe (A.Object AM.empty) model.input
in div_ [] $ in div_ [] $
[ viewCss,
viewHeader,
nav_ [] [viewCollections],
main_ [] $
[ maybe (text "..") (either err viewSchema) model.schema, [ maybe (text "..") (either err viewSchema) model.schema,
maybe (text "..") (either err viewPosts) model.posts, maybe (text "..") (either err viewPosts) model.posts,
maybe (text "..") (either err (viewForm input)) model.schema, maybe (text "..") (either err (viewForm input)) model.schema,
viewInput input viewInput input
] ]
]
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 :: String -> View Action
err = text . toMisoString . ("err! " <>) err = text . toMisoString . ("err! " <>)
viewHeader :: View Action
viewHeader =
header_ [] $
[ section_ [] [h1_ [] [text "acms"]],
section_ [] [viewBranch]
]
viewBranch :: View Action
viewBranch =
select_ [] [option_ [] [text "main"]]
viewCollections :: View Action
viewCollections =
section_ [] $
[ span_ [] [text "collections"],
ol_ [] [li_ [] [a_ [href_ "#"] [text "posts"]]]
]
viewSchema :: Schema -> View Action viewSchema :: Schema -> View Action
viewSchema schema = viewSchema schema =
case schema.type_ of case schema.type_ of

View File

@@ -20,7 +20,7 @@ executable frontend
default-extensions: default-extensions:
CPP OverloadedStrings RecordWildCards DeriveAnyClass CPP OverloadedStrings RecordWildCards DeriveAnyClass
DuplicateRecordFields LambdaCase OverloadedRecordDot DuplicateRecordFields LambdaCase OverloadedRecordDot
NoFieldSelectors ViewPatterns NoFieldSelectors ViewPatterns QuasiQuotes
ghc-options: ghc-options:
-Wall -fno-warn-name-shadowing -fno-warn-ambiguous-fields -Wall -fno-warn-name-shadowing -fno-warn-ambiguous-fields
@@ -34,6 +34,7 @@ executable frontend
containers, containers,
data-default, data-default,
miso, miso,
neat-interpolation,
text, text,
utf8-string utf8-string