git.iko.soy/rowtype-yoga/psfp
on e677d30 help sign in
183 lines 5.2 kB history raw
1module PSLayout where
3import Prelude
4import CSS.Safer (cssSafer)
5import CSSBaseline (mkCssBaseline)
6import CompileEditor.Component (mkCompileEditor)
7import Data.Array as Array
8import Data.Maybe (Maybe(..), fromMaybe)
9import Data.Nullable (Nullable)
10import Data.Nullable as Nullable
11import Data.String as String
12import Effect (Effect)
13import Milkis.Impl (FetchImpl)
14import React.Basic (JSX, ReactComponent)
15import React.Basic.DOM (unsafeCreateDOMComponent)
16import React.Basic.DOM as R
17import React.Basic.Hooks (ReactChildren, componentWithChildren, element)
18import React.Basic.Hooks as React
19import Theme (fromTheme)
20import Theme.Default (darkTheme)
21import Theme.Provider (mkThemeProvider)
22import Theme.Styles (makeStyles)
23import Theme.Types (CSSTheme)
24import Typography.Header (HeadingLevel(..), mkH)
25import Typography.Paragraph (mkP)
26import Unsafe.Coerce (unsafeCoerce)
28type SiteQueryResult
29 = { site ∷ { siteMetadata ∷ { title ∷ String } } }
31type PreProps
32 = { children ∷
33 Nullable
34 { props ∷
35 Nullable
36 { mdxType ∷ Nullable String
37 , children ∷ Nullable String
38 , className ∷ Nullable String
39 }
40 }
41 }
43mkLayout ∷
44 ∀ children.
45 FetchImpl ->
46 Effect
47 ( ReactComponent
48 { children ∷ ReactChildren children
49 , siteInfo ∷ SiteQueryResult
50 }
51 )
52mkLayout fetchImpl = do
53 themeProvider <- mkThemeProvider
54 mdxProviderComponent <- mkMdxProviderComponent fetchImpl
55 componentWithChildren "MDXLayout" \{ children, siteInfo } -> React.do
56 pure
57 $ element themeProvider
58 { theme: fromTheme darkTheme
59 , children:
60 [ element mdxProviderComponent
61 { children
62 , siteInfo
63 }
64 ]
65 }
67mkMdxProviderComponent ::
68 ∀ children.
69 FetchImpl ->
70 Effect
71 ( ReactComponent
72 { children ∷ ReactChildren children
73 , siteInfo ∷ SiteQueryResult
74 }
75 )
76mkMdxProviderComponent fetchImpl = do
77 cssBaseline <- mkCssBaseline
78 editor <- mkCompileEditor fetchImpl
79 h <- mkH
80 p <- mkP
81 useStyles <-
82 makeStyles \(theme :: CSSTheme) ->
83 { code:
84 cssSafer
85 { fontFamily: "PragmataPro Liga"
86 , backgroundColor: theme.interfaceColour
87 , fontSize: "10pt"
88 , border: "1px solid #383c39"
89 , padding: "3px"
90 , borderRadius: "3px"
91 }
92 , margins:
93 cssSafer
94 { marginLeft: "35px"
95 , marginRight: "35px"
96 }
97 }
98 componentWithChildren "MDXProviderComponent" \{ children, siteInfo } -> React.do
99 classes <- useStyles
100 let
101 baseline child = element cssBaseline { kids: child }
103 siteInfoJSX =
104 R.div
105 { children:
106 [ element h
107 { level: H1
108 , text: siteInfo.site.siteMetadata.title
109 , className: Nothing
110 }
111 , R.div_ (unsafeCoerce children)
112 ]
113 }
115 mdxComponents =
116 { h1:
117 \props ->
118 element h { level: H2, text: props.children, className: Just classes.margins }
119 , h2:
120 \props ->
121 element h { level: H3, text: props.children, className: Just classes.margins }
122 , h3:
123 \props ->
124 element h { level: H4, text: props.children, className: Just classes.margins }
125 , p:
126 \props ->
127 R.div
128 { children: [ element p { text: props.children } ]
129 , className: classes.margins
130 }
131 , inlineCode:
132 \props -> do
133 R.span { className: classes.code, children: props.children }
134 , pre:
135 \(props ∷ PreProps) -> do
136 let
137 childrenQ = Nullable.toMaybe props.children
139 propsQ = (_.props >>> Nullable.toMaybe) =<< childrenQ
141 mdxTypeQ = (_.mdxType >>> Nullable.toMaybe) =<< propsQ
143 childrenQ2 = (_.children >>> Nullable.toMaybe) =<< propsQ
145 classNameQ = (_.className >>> Nullable.toMaybe) =<< propsQ
147 isCode = fromMaybe false (mdxTypeQ <#> eq "code")
149 codeQ = childrenQ2
151 height =
152 (fromMaybe 200 >>> show >>> (_ <> "px")) do
153 code <- codeQ
154 pure
155 ( String.split (String.Pattern "\n") code
156 # Array.length
157 # \x -> (x * 12) + 100
158 )
160 language = fromMaybe "" (classNameQ >>= String.stripPrefix (String.Pattern "language-"))
161 if isCode then
162 element editor
163 { initialCode: fromMaybe "" codeQ
164 , height
165 , language
166 }
167 else
168 element (unsafeCreateDOMComponent "pre") props
169 }
170 pure
171 $ baseline
172 [ element mdxProvider
173 { children: [ siteInfoJSX ]
174 , components: mdxComponents
175 }
176 ]
178foreign import mdxProvider ∷
179 ∀ r.
180 ReactComponent
181 { components ∷ { | r } -- TODO Don't lie
182 , children ∷ Array JSX
183 }