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