git.iko.soy/rowtype-yoga/psfp
on 148366a help sign in
rowtype-yoga/psfp/blog/src/components/PSLayout.purs
309 lines 10 kB history raw
1module PSLayout where
3import Prelude
5import Control.Monad.State (evalStateT, get, put, runStateT)
6import Control.Monad.State as State
7import Control.Monad.Trans.Class (lift)
8import Data.Array (foldMap)
9import Data.Array as Array
10import Data.Array.NonEmpty as NEA
11import Data.Either (Either(..))
12import Data.Foldable (fold)
13import Data.Function.Uncurried (mkFn2)
14import Data.Maybe (Maybe(..), fromMaybe, isJust)
15import Data.Monoid (guard)
16import Data.Monoid.Additive (Additive(..))
17import Data.Newtype (ala)
18import Data.Newtype as NT
19import Data.Nullable (Nullable)
20import Data.Nullable as Nullable
21import Data.String as String
22import Data.Traversable (Accum, mapAccumL)
23import Data.Tuple.Nested ((/\))
24import Debug.Trace (spy)
25import Effect (Effect)
26import Effect.Aff (launchAff_)
27import Effect.Class (liftEffect)
28import Effect.Class.Console (log)
29import JSS (jss, jssClasses)
30import Justifill (justifill)
31import Milkis.Impl (FetchImpl)
32import React.Basic (JSX, ReactComponent, fragment)
33import React.Basic.DOM (unsafeCreateDOMComponent)
34import React.Basic.DOM as R
35import React.Basic.Helpers (jsx)
36import React.Basic.Hooks (ReactChildren, component, componentWithChildren, element, memo, reactChildrenToArray, readRef, useEffect, useReducer, useRef, useState, writeRef)
37import React.Basic.Hooks as React
38import Unsafe.Coerce (unsafeCoerce)
39import Yoga.Box.Component as Box
40import Yoga.ClickAway.Component as ClickAway
41import Yoga.CompileEditor.Component (mkCompileEditor)
42import Yoga.Compiler.Api (apiCompiler)
43import Yoga.Compiler.Types (Compiler)
44import Yoga.FillInTheGaps.Component as FillInTheGaps
45import Yoga.FillInTheGaps.Logic (findResult, parseSegments, toCode)
46import Yoga.Header.Component (mkHeader)
47import Yoga.Helpers ((?||))
48import Yoga.InlineCode.Component as InlineCode
49import Yoga.Modal.Component as Modal
50import Yoga.Theme (fromTheme)
51import Yoga.Theme.CSSBaseline (mkCssBaseline)
52import Yoga.Theme.Default (darkTheme)
53import Yoga.Theme.Provider (mkThemeProvider)
54import Yoga.Theme.Styles (makeStylesJSS)
55import Yoga.Theme.Types (CSSTheme)
56import Yoga.Typography.Header (HeadingLevel(..), mkH)
57import Yoga.Typography.Paragraph (mkP)
58import Yoga.WithSidebar.Component (makeComponent) as WithSidebar
60type SiteQueryResult
61 = { site ∷
62 { siteMetadata ∷
63 { title ∷ String
64 , menuLinks ∷ Array { name ∷ String, link ∷ String }
65 }
66 }
67 }
69type PreProps
70 = { children ∷
71 Nullable
72 { props ∷
73 Nullable
74 { mdxType ∷ Nullable String
75 , children ∷ Nullable String
76 , className ∷ Nullable String
77 }
78 }
79 }
81data ShowModal
82 = ShowModal Modal.Props
83 | HideModal
85mkLayout ∷
86 ∀ r.
87 FetchImpl ->
88 Effect
89 ( ReactComponent
90 { children ∷ ReactChildren JSX
91 , siteInfo ∷ SiteQueryResult
92 }
93 )
94mkLayout fetchImpl = do
95 themeProvider <- mkThemeProvider
96 modal <- memo Modal.makeComponent
97 clickAway <- memo ClickAway.makeComponent
98 mdxProviderComponent <- memo $ mkMdxProviderComponent (apiCompiler fetchImpl)
99 componentWithChildren "MDXLayout" \{ children, siteInfo } -> React.do
100 maybeModalProps /\ dispatch <-
101 useReducer Nothing case _, _ of
102 _, ShowModal props -> Just props
103 _, HideModal -> Nothing
104 pure
105 $ element themeProvider
106 { theme: fromTheme darkTheme
107 , children:
108 [ R.div_
109 [ maybeModalProps
110 # foldMap \modalProps ->
111 fragment
112 [ element clickAway { allowEscape: Just true, onClick: dispatch HideModal, style: Nothing }
113 , element modal (justifill modalProps)
114 ]
115 , element mdxProviderComponent
116 { children: spy "children" children
117 , siteInfo
118 , showModal: dispatch <<< ShowModal
119 }
120 ]
121 ]
122 }
124isQuiz ∷ JSX -> Boolean
125isQuiz a =
126 (unsafeCoerce a).props.mdxType == "pre"
127 && ((unsafeCoerce a).props.children.props.className == "language-purescript")
128 && ((unsafeCoerce a).props.children.props.mdxType == "code")
129 && ((unsafeCoerce a).props.children.props.children # parseSegments # isJust)
131mkMdxProviderComponent ∷
132 ∀ r.
133 { | Compiler r } ->
134 Effect
135 ( ReactComponent
136 { children ∷ ReactChildren JSX
137 , siteInfo ∷ SiteQueryResult
138 , showModal ∷ Modal.Props -> Effect Unit
139 }
140 )
141mkMdxProviderComponent compiler = do
142 cssBaseline <- memo mkCssBaseline
143 editor <- memo $ mkCompileEditor compiler
144 box <- memo $ Box.makeComponent
145 sidebar <- memo mkSidebar
146 header <- memo mkHeader
147 yogaInlineCode <- InlineCode.makeComponent
148 quiz <- memo $ mkQuiz compiler
149 h <- memo mkH
150 p <- memo mkP
151 useStyles <-
152 makeStylesJSS
153 $ jssClasses \(theme ∷ CSSTheme) ->
154 { code:
155 { fontFamily: theme.codeFontFamily # NEA.head
156 , backgroundColor: theme.interfaceColour
157 , fontSize: "10pt"
158 , border: "1px solid #383c39"
159 , padding: "3px"
160 , borderRadius: "3px"
161 }
162 }
163 componentWithChildren "MDXProviderComponent" \{ children, siteInfo, showModal } -> React.do
164 classes <- useStyles {}
165 visibleUntil /\ updateVisible <- useState 1
166 let
167 onFailure = showModal (justifill { title: "Failed", kids: [ R.text "Try again" ] } ∷ Modal.Props)
168 onSuccess = updateVisible (_ + one)
170 mapVisible i kid =
171 { accum: i + if isQuiz kid then one else zero
172 , value: guard (i < visibleUntil) (pure kid)
173 }
174 visibleKids :: Array JSX
175 visibleKids = reactChildrenToArray children
176 # mapAccumL mapVisible zero
177 # _.value
178 # Array.catMaybes
180 siteInfoJSX =
181 R.div
182 { children:
183 [ jsx header { className: "" } [ R.text siteInfo.site.siteMetadata.title ]
184 , element sidebar { links: siteInfo.site.siteMetadata.menuLinks }
185 , jsx box {} visibleKids
186 ]
187 }
188 mdxComponents /\ _ <-
189 useState
190 { h1:
191 \props ->
192 element h ({ level: H2, text: props.children, className: Nothing })
193 , h2:
194 \props ->
195 element h { level: H3, text: props.children, className: Nothing }
196 , h3:
197 \props ->
198 element h { level: H4, text: props.children, className: Nothing }
199 , hr: (const $ R.hr {})
200 , p:
201 \props ->
202 R.div
203 { children: [ element p { text: props.children } ]
204 }
205 , inlineCode:
206 \props -> do
207 R.span { className: classes.code, children: props.children }
208 , pre: mkFn2
209 \(props ∷ PreProps) other -> do
210 let
211 _ = spy "other" other
212 childrenQ = Nullable.toMaybe props.children
214 propsQ = (_.props >>> Nullable.toMaybe) =<< childrenQ
216 mdxTypeQ = (_.mdxType >>> Nullable.toMaybe) =<< propsQ
218 childrenQ2 = (_.children >>> Nullable.toMaybe) =<< propsQ
220 classNameQ = (_.className >>> Nullable.toMaybe) =<< propsQ
222 isCode = fromMaybe false (mdxTypeQ <#> eq "code")
224 codeQ = childrenQ2
226 height =
227 (fromMaybe 200 >>> show >>> (_ <> "px")) do
228 code <- codeQ
229 pure
230 ( String.split (String.Pattern "\n") code
231 # Array.length
232 # \x -> (x * 12) + 100
233 )
235 language = fromMaybe "" (classNameQ >>= String.stripPrefix (String.Pattern "language-"))
237 segmentsQ = parseSegments (codeQ ?|| "")
238 case isCode, language, segmentsQ of
239 true, "purescript", Just initialSegments -> element quiz { initialSegments, onFailure, onSuccess }
240 true, _, _ ->
241 element editor
242 { initialCode: fromMaybe "" codeQ
243 , height
244 , language
245 }
246 false, _, _ -> element (unsafeCreateDOMComponent "pre") props
247 }
248 pure
249 $ element mdxProvider
250 { children: pure $ jsx cssBaseline {} [ siteInfoJSX ]
251 , components: mdxComponents
252 }
254mkQuiz ∷ _ -> Effect (ReactComponent _)
255mkQuiz compiler = do
256 fillInTheGaps <- FillInTheGaps.makeComponent
257 box <- Box.makeComponent
258 component "Quiz" \({ initialSegments, onFailure, onSuccess } ∷ { initialSegments ∷ _, onFailure ∷ _, onSuccess :: _}) -> React.do
259 segments /\ updateSegments <- useState initialSegments
260 solved /\ updateSolved <- useState false
261 pure
262 $ jsx box {}
263 [ element fillInTheGaps
264 { segments
265 , incantate:
266 launchAff_ do
267 let
268 code = toCode segments
269 result <- compiler.compileAndRun { code }
270 liftEffect case result of
271 Right r
272 | String.stripSuffix (String.Pattern "\n") r.stdout == (findResult $ join segments) -> do
273 updateSolved (const true)
274 onSuccess
275 _ -> onFailure
276 , updateSegments:
277 \update -> do
278 let
279 updated = update segments
280 case segments, updated of
281 old, new
282 | new == old -> mempty
283 _, _ -> updateSegments (const updated)
284 , readOnly: Just solved
285 }
286 ]
288mkSidebar = do
289 withSidebar <- WithSidebar.makeComponent
290 useStyles <-
291 makeStylesJSS
292 $ jssClasses \(theme ∷ CSSTheme) ->
293 {}
294 component "Sidebar" \{ links } -> React.do
295 classes <- useStyles {}
296 pure
297 $ element withSidebar
298 ( justifill
299 { sidebarChildren: [ R.div_ [] ]
300 , notSidebarChildren: [] ∷ Array JSX
301 }
302 )
304foreign import mdxProvider ∷
305 ∀ r.
306 ReactComponent
307 { components ∷ { | r } -- TODO Don't lie
308 , children ∷ Array JSX
309 }