git.iko.soy/rowtype-yoga/psfp
on 74e7b2d help sign in
rowtype-yoga/psfp/blog/src/components/PSLayout.purs
345 lines 13 kB history raw
1module PSLayout where
3import Prelude
4import Color as Color
5import Data.Array (intercalate)
6import Data.Array as Array
7import Data.Either (Either(..))
8import Data.Function.Uncurried (mkFn2)
9import Data.Maybe (Maybe(..), fromMaybe, isJust)
10import Data.Nullable (Nullable)
11import Data.Nullable as Nullable
12import Data.String as String
13import Data.Traversable (mapAccumL)
14import Data.Tuple.Nested ((/\))
15import Effect (Effect)
16import Effect.Aff (launchAff_)
17import Effect.Class (liftEffect)
18import Effect.Unsafe (unsafePerformEffect)
19import MDX (MDX(..))
20import Milkis.Impl (FetchImpl)
21import React.Basic (JSX, ReactComponent, fragment)
22import React.Basic.DOM (Props_h1, Props_h2, Props_h3, Props_p, unsafeCreateDOMComponent)
23import React.Basic.DOM as R
24import React.Basic.Emotion as Emotion
25import React.Basic.Hooks (ReactChildren, element, memo, mkReducer, reactChildrenFromArray, reactChildrenToArray, reactComponent, reactComponentWithChildren, useReducer, useState, useState')
26import React.Basic.Hooks as React
27import Shared.Models.Body (CompileResult)
28import Unsafe.Coerce (unsafeCoerce)
29import Yoga ((/>), (</), (</*))
30import Yoga as Y
31import Yoga.Block as Block
32import Yoga.Block.Atom.Toggle.Types (TogglePosition(..))
33import Yoga.Block.Container as Container
34import Yoga.Block.Container.Style (DarkOrLightMode(..), colour)
35import Yoga.Block.Icon.SVG as Icon
36import Yoga.Block.Internal (_0)
37import Yoga.Block.Modal as Modal
38import Yoga.CompileEditor.Component (mkCompileEditor)
39import Yoga.Compiler.Api (apiCompiler)
40import Yoga.Compiler.Types (Compiler)
41import Yoga.FillInTheGaps.Component as FillInTheGaps
42import Yoga.FillInTheGaps.Logic (Segment, findResult, parseSegments, toCode)
43import Yoga.Helpers ((?||))
45type SiteQueryResult =
46 { siteMetadata ∷
47 { title ∷ String
48 , menuLinks ∷ Array { name ∷ String, link ∷ String }
49 }
50 }
52type PreProps =
53 { children ∷
54 Nullable
55 { props ∷
56 Nullable
57 { mdxType ∷ Nullable String
58 , children ∷ Nullable String
59 , className ∷ Nullable String
60 }
61 }
62 }
64data ShowModal
65 = ShowModal Modal.Props
66 | HideModal
68mkLayout ∷
69 FetchImpl ->
70 Effect
71 ( ReactComponent
72 { children ∷ ReactChildren MDX
73 , siteInfo ∷ SiteQueryResult
74 , mdxProviderComponent ∷ ReactComponent MdxProviderProps
75 }
76 )
77mkLayout fetchImpl = do
78 reducer <-
79 mkReducer case _, _ of
80 _, ShowModal props -> Just props
81 _, HideModal -> Nothing
82 -- mdxProviderComponent <- mkMdxProviderComponent (apiCompiler fetchImpl)
83 reactComponentWithChildren "MDXLayout" \{ children, siteInfo, mdxProviderComponent } -> React.do
84 (maybeModalProps ∷ Maybe Modal.Props) /\ dispatch <- useReducer Nothing reducer
85 darkOrLightMode /\ setDarkOrLightMode <- useState' Nothing
86 let
87 maybeTogglePosition =
88 darkOrLightMode
89 <#> case _ of
90 DarkMode -> ToggleIsRight
91 LightMode -> ToggleIsLeft
92 darkThemeToggle =
93 Block.toggle
94 Y.</> do
95 { className: "dark-light-toggle"
96 , css:
97 Emotion.css
98 { marginRight: Emotion.str "0"
99 , marginLeft: Emotion.str "auto"
100 }
101 , setTogglePosition:
102 case _ of
103 ToggleIsLeft -> setDarkOrLightMode (Just LightMode)
104 ToggleIsRight -> setDarkOrLightMode (Just DarkMode)
105 , togglePosition: fromMaybe ToggleIsLeft maybeTogglePosition
106 , left:
107 Block.icon
108 Y.</> do
109 { icon: Icon.moon
110 , stroke: Emotion.str "#eef"
111 }
112 , right:
113 Block.icon
114 Y.</> do
115 { icon: Icon.sun
116 , stroke: Emotion.str "yellow"
117 }
118 , backgroundLeft:
119 Color.hsl 205.0 1.0 0.80
120 , backgroundRight:
121 Color.hsl 250.0 1.0 0.1
122 }
123 header =
124 Block.box
125 </ { className: "top-box"
126 , css:
127 Emotion.css
128 { background: Emotion.str colour.backgroundLayer5
129 }
130 }
131 /> [ Block.cluster
132 </* { justify: "space-between"
133 , className: "header"
134 , space: "var(--s-2)"
135 , css: Emotion.css { width: Emotion.percent 100.0 }
136 }
137 /> do
138 [ Y.styled
139 R.span'
140 { className: "blog-header"
141 , css:
142 Emotion.css
143 { fontSize: Emotion.str "min(var(--s3), calc(var(--s1) + 1vw))"
144 , textTransform: Emotion.str "uppercase"
145 , letterSpacing: Emotion.str "calc(min(var(--s0) + 3vw), var(--s2) * -1.7)"
146 , fontWeight: Emotion.str "300"
147 , color: Emotion.str colour.text
148 }
149 }
150 [ R.text siteInfo.siteMetadata.title ]
151 , darkThemeToggle
152 ]
153 ]
154 pure
155 $ element Container.component
156 { themeVariant: darkOrLightMode
157 , content:
158 Y.styled Block.stack
159 { className: "blog-content"
160 , space: _0
161 , splitAfter: 2
162 , css:
163 Emotion.css
164 { minHeight: Emotion.vh 100.0
165 , background: Emotion.str colour.background
166 , borderRadius: Emotion.str "0 var(--s1) var(--s1) 0"
167 }
168 }
169 [ header
170 , Block.centre
171 </* { className: "centre"
172 , padding: _0
173 , gutters: _0
174 , css:
175 Emotion.css
176 { maxWidth: Emotion.ch 90.0
177 }
178 }
179 /> [ Block.box
180 </ do
181 { padding: Emotion.px 16
182 , css: Emotion.css { background: Emotion.str colour.background }
183 }
184 /> [ element mdxProviderComponent
185 { children
186 , siteInfo
187 , showModal: dispatch <<< ShowModal
188 , hideModal: dispatch HideModal
189 , modalOpen: isJust maybeModalProps
190 }
191 ]
192 ]
193 , Y.styled Block.box
194 { className: "blog-footer"
195 , css:
196 Emotion.css
197 { background: Emotion.str colour.backgroundLayer1
198 , borderTop: Emotion.str colour.backgroundLayer3
199 , color: Emotion.str colour.text
200 }
201 }
202 [ R.text "Mark Eibes" ]
203 ]
204 }
206isQuiz ∷ MDX -> Boolean
207isQuiz (MDX a) =
208 a.props.mdxType == "pre"
209 && ((unsafeCoerce a).props.children.props.className == "language-purescript")
210 && ((unsafeCoerce a).props.children.props.mdxType == "code")
211 && ((unsafeCoerce a).props.children.props.children # parseSegments # isJust)
213type MdxProviderProps =
214 { children ∷ ReactChildren MDX
215 , siteInfo ∷ SiteQueryResult
216 , showModal ∷ Modal.Props -> Effect Unit
217 , hideModal ∷ Effect Unit
218 , modalOpen ∷ Boolean
219 }
221mkLiveMdxProviderComponent ∷ FetchImpl -> Effect (ReactComponent MdxProviderProps)
222mkLiveMdxProviderComponent fetchImpl = mkMdxProviderComponent (apiCompiler fetchImpl)
224mkMdxProviderComponent ∷
225 ∀ r.
226 { | Compiler r } ->
227 Effect (ReactComponent MdxProviderProps)
228mkMdxProviderComponent compiler = do
229 editor <- memo $ mkCompileEditor compiler
230 quiz <- memo $ mkQuiz compiler
231 reactComponentWithChildren "MDXProviderComponent" do
232 \{ children, siteInfo, showModal, hideModal, modalOpen } -> React.do
233 visibleUntil /\ updateVisible <- useState 1
234 let
235 onFailure title kids =
236 showModal
237 { content: fragment kids
238 , isOpen: modalOpen
239 , setIsOpen: if _ then pure unit else hideModal
240 }
241 onSuccess = updateVisible (_ + one)
242 mapVisible ∷ Int -> MDX -> _
243 mapVisible i kid =
244 { accum: i + if isQuiz kid then one else zero
245 , value: if (i < visibleUntil) then Just kid else Nothing
246 }
247 visibleKids ∷ Array MDX
248 visibleKids =
249 reactChildrenToArray children
250 # mapAccumL mapVisible zero
251 # _.value
252 # Array.catMaybes
253 contentMDX ∷ ReactChildren MDX
254 contentMDX = reactChildrenFromArray visibleKids
255 let
256 mdxComponents =
257 { h1:
258 \(props ∷ { | Props_h1 }) -> R.h2 props
259 , h2:
260 \(props ∷ { | Props_h2 }) -> R.h3 props
261 , h3:
262 \(props ∷ { | Props_h3 }) -> R.h4 props
263 , hr: (const $ R.hr {})
264 , p:
265 \(props ∷ { | Props_p }) -> R.p props
266 , inlineCode:
267 \props -> do
268 R.span { children: props.children }
269 , pre:
270 mkFn2 \(props ∷ PreProps) other -> do
271 let
272 childrenQ = Nullable.toMaybe props.children
273 propsQ = (_.props >>> Nullable.toMaybe) =<< childrenQ
274 mdxTypeQ = (_.mdxType >>> Nullable.toMaybe) =<< propsQ
275 childrenQ2 = (_.children >>> Nullable.toMaybe) =<< propsQ
276 classNameQ = (_.className >>> Nullable.toMaybe) =<< propsQ
277 isCode = fromMaybe false (mdxTypeQ <#> eq "code")
278 codeQ = childrenQ2
279 height =
280 (fromMaybe 200 >>> show >>> (_ <> "px")) do
281 code <- codeQ
282 pure
283 ( String.split (String.Pattern "\n") code
284 # Array.length
285 # \x -> (x * 12) + 100
286 )
287 language = fromMaybe "" (classNameQ >>= String.stripPrefix (String.Pattern "language-"))
288 segmentsQ = parseSegments (codeQ ?|| "")
289 case isCode, language, segmentsQ of
290 true, "purescript", Just initialSegments -> element quiz { initialSegments, onFailure, onSuccess }
291 true, _, _ ->
292 element editor
293 { initialCode: fromMaybe "" codeQ
294 , height
295 , language
296 }
297 false, _, _ -> element (unsafePerformEffect $ unsafeCreateDOMComponent "pre") props
298 }
299 pure
300 $ element mdxProvider
301 { children: contentMDX
302 , components: mdxComponents
303 }
305type QuizProps =
306 { initialSegments ∷ Array (Array Segment)
307 , onFailure ∷ String -> Array JSX -> Effect Unit
308 , onSuccess ∷ Effect Unit
309 }
311mkQuiz ∷ ∀ r. { | Compiler r } -> Effect (ReactComponent QuizProps)
312mkQuiz compiler = do
313 fillInTheGaps <- FillInTheGaps.makeComponent
314 reactComponent "Quiz" \({ initialSegments, onFailure, onSuccess } ∷ QuizProps) -> React.do
315 segments /\ updateSegments <- useState initialSegments
316 solvedWith /\ updateSolvedWith <- useState Nothing
317 pure
318 $ element fillInTheGaps
319 { segments
320 , run:
321 launchAff_ do
322 let code = toCode segments
323 result <- compiler.compileAndRun { code }
324 liftEffect case result of
325 Right r
326 | String.stripSuffix (String.Pattern "\n") r.stdout == (findResult $ join segments) -> do
327 updateSolvedWith (const $ String.stripSuffix (String.Pattern "\n") r.stdout)
328 onSuccess
329 Right r
330 | r.stdout /= "\n" -> onFailure "Oh shit!" [ R.text r.stdout ]
331 Right r -> onFailure "Oh shit!" [ R.text r.stderr ]
332 Left (cr ∷ CompileResult) -> onFailure "Oh shit!" [ R.text (intercalate ", " (cr.result <#> _.message)) ]
333 , updateSegments:
334 \update -> do
335 let updated = update segments
336 unless (segments == updated) do updateSegments (const updated)
337 , solvedWith
338 }
340foreign import mdxProvider ∷
341 ∀ r.
342 ReactComponent
343 { components ∷ { | r } -- TODO Don't lie
344 , children ∷ ReactChildren MDX
345 }