git.iko.soy/rowtype-yoga/psfp
on 3e952f7 help sign in
rowtype-yoga/psfp/blog/src/components/PSLayout.purs
287 lines 10 kB history raw
1module PSLayout where
3import Prelude
4import Data.Array (foldMap, intercalate)
5import Data.Array as Array
6import Data.Array.NonEmpty as NEA
7import Data.Either (Either(..))
8import Data.Function.Uncurried (mkFn2)
9import Data.Maybe (Maybe(..), fromMaybe, isJust)
10import Data.Monoid (guard)
11import Data.Nullable (Nullable)
12import Data.Nullable as Nullable
13import Data.String as String
14import Data.Traversable (mapAccumL)
15import Data.Tuple.Nested ((/\))
16import Effect (Effect)
17import Effect.Aff (launchAff_)
18import Effect.Class (liftEffect)
19import JSS (jssClasses)
20import Justifill (justifill)
21import Milkis.Impl (FetchImpl)
22import React.Basic (JSX, ReactComponent, fragment)
23import React.Basic.DOM (css, unsafeCreateDOMComponent)
24import React.Basic.DOM as R
25import React.Basic.Helpers (jsx)
26import React.Basic.Hooks (ReactChildren, component, componentWithChildren, element, memo, reactChildrenToArray, useReducer, useState)
27import React.Basic.Hooks as React
28import Shared.Models.Body (CompileResult)
29import Unsafe.Coerce (unsafeCoerce)
30import Yoga.Box.Component as Box
31import Yoga.ClickAway.Component as ClickAway
32import Yoga.CloseIcon.Component as CloseIcon
33import Yoga.Cluster.Component as Cluster
34import Yoga.CompileEditor.Component (mkCompileEditor)
35import Yoga.Compiler.Api (apiCompiler)
36import Yoga.Compiler.Types (Compiler)
37import Yoga.Cover.Component as Cover
38import Yoga.FillInTheGaps.Component as FillInTheGaps
39import Yoga.FillInTheGaps.Logic (findResult, parseSegments, toCode)
40import Yoga.Header.Component (mkHeader)
41import Yoga.Helpers ((?||))
42import Yoga.Imposter.Component as Imposter
43import Yoga.InlineCode.Component as InlineCode
44import Yoga.Modal.Component as Modal
45import Yoga.Theme (fromTheme)
46import Yoga.Theme.CSSBaseline (mkCssBaseline)
47import Yoga.Theme.Default (darkTheme)
48import Yoga.Theme.Default as Default
49import Yoga.Theme.Provider (mkThemeProvider)
50import Yoga.Theme.Styles (makeStylesJSS)
51import Yoga.Theme.Types (CSSTheme)
52import Yoga.Typography.Header (HeadingLevel(..), mkH)
53import Yoga.Typography.Paragraph (mkP)
55type SiteQueryResult =
56 { siteMetadata ∷
57 { title ∷ String
58 , menuLinks ∷ Array { name ∷ String, link ∷ String }
59 }
60 }
62type PreProps =
63 { children ∷
64 Nullable
65 { props ∷
66 Nullable
67 { mdxType ∷ Nullable String
68 , children ∷ Nullable String
69 , className ∷ Nullable String
70 }
71 }
72 }
74data ShowModal
75 = ShowModal Modal.Props
76 | HideModal
78mkLayout ∷
79 FetchImpl ->
80 Effect
81 ( ReactComponent
82 { children ∷ ReactChildren JSX
83 , siteInfo ∷ SiteQueryResult
84 }
85 )
86mkLayout fetchImpl = do
87 themeProvider <- mkThemeProvider
88 modal <- memo Modal.makeComponent
89 imposter <- memo Imposter.makeComponent
90 cover <- memo Cover.makeComponent
91 cluster <- memo Cluster.makeComponent
92 clickAway <- memo ClickAway.makeComponent
93 mdxProviderComponent <- memo $ mkMdxProviderComponent (apiCompiler fetchImpl)
94 componentWithChildren "MDXLayout" \{ children, siteInfo } -> React.do
95 (maybeModalProps ∷ Maybe Modal.Props) /\ dispatch <-
96 useReducer Nothing case _, _ of
97 _, ShowModal props -> Just props
98 _, HideModal -> Nothing
99 pure
100 $ element themeProvider
101 { theme: fromTheme darkTheme
102 , children:
103 [ R.div
104 { style: css { maxWidth: "none" }
105 , children:
106 [ maybeModalProps
107 # foldMap \modalProps ->
108 fragment
109 [ element clickAway { allowEscape: Just true, onClick: dispatch HideModal, style: Nothing }
110 , element modal (justifill modalProps)
111 ]
112 , element mdxProviderComponent
113 { children
114 , siteInfo
115 , showModal: dispatch <<< ShowModal
116 , hideModal: dispatch HideModal
117 }
118 ]
119 }
120 ]
121 }
123isQuiz ∷ JSX -> Boolean
124isQuiz a =
125 (unsafeCoerce a).props.mdxType == "pre"
126 && ((unsafeCoerce a).props.children.props.className == "language-purescript")
127 && ((unsafeCoerce a).props.children.props.mdxType == "code")
128 && ((unsafeCoerce a).props.children.props.children # parseSegments # isJust)
130type MdxProviderProps =
131 { children ∷ ReactChildren JSX
132 , siteInfo ∷ SiteQueryResult
133 , showModal ∷ Modal.Props -> Effect Unit
134 , hideModal ∷ Effect Unit
135 }
137mkMdxProviderComponent ∷ ∀ r. { | Compiler r } -> Effect (ReactComponent MdxProviderProps)
138mkMdxProviderComponent compiler = do
139 cssBaseline <- memo (mkCssBaseline Default.fontFaces)
140 editor <- memo $ mkCompileEditor compiler
141 box <- memo $ Box.makeComponent
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 } ∷ MdxProviderProps) -> 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 } ∷
171 Modal.Props
172 )
173 onSuccess = updateVisible (_ + one)
174 mapVisible i kid =
175 { accum: i + if isQuiz kid then one else zero
176 , value: guard (i < visibleUntil) (pure kid)
177 }
178 visibleKids ∷ Array JSX
179 visibleKids =
180 reactChildrenToArray children
181 # mapAccumL mapVisible zero
182 # _.value
183 # Array.catMaybes
184 siteInfoJSX =
185 R.div
186 { children:
187 [ jsx header { className: "" } [ R.text siteInfo.siteMetadata.title ]
188 , jsx box {} visibleKids
189 ]
190 }
191 mdxComponents /\ _ <-
192 useState
193 { h1:
194 \props ->
195 element h ({ level: H2, text: props.children, className: Nothing })
196 , h2:
197 \props ->
198 element h { level: H3, text: props.children, className: Nothing }
199 , h3:
200 \props ->
201 element h { level: H4, text: props.children, className: Nothing }
202 , hr: (const $ R.hr {})
203 , p:
204 \props ->
205 R.div
206 { children: [ element p { text: props.children } ]
207 }
208 , inlineCode:
209 \props -> do
210 R.span { className: classes.code, children: props.children }
211 , pre:
212 mkFn2 \(props ∷ PreProps) other -> do
213 let
214 childrenQ = Nullable.toMaybe props.children
215 propsQ = (_.props >>> Nullable.toMaybe) =<< childrenQ
216 mdxTypeQ = (_.mdxType >>> Nullable.toMaybe) =<< propsQ
217 childrenQ2 = (_.children >>> Nullable.toMaybe) =<< propsQ
218 classNameQ = (_.className >>> Nullable.toMaybe) =<< propsQ
219 isCode = fromMaybe false (mdxTypeQ <#> eq "code")
220 codeQ = childrenQ2
221 height =
222 (fromMaybe 200 >>> show >>> (_ <> "px")) do
223 code <- codeQ
224 pure
225 ( String.split (String.Pattern "\n") code
226 # Array.length
227 # \x -> (x * 12) + 100
228 )
229 language = fromMaybe "" (classNameQ >>= String.stripPrefix (String.Pattern "language-"))
230 segmentsQ = parseSegments (codeQ ?|| "")
231 case isCode, language, segmentsQ of
232 true, "purescript", Just initialSegments -> element quiz { initialSegments, onFailure, onSuccess }
233 true, _, _ ->
234 element editor
235 { initialCode: fromMaybe "" codeQ
236 , height
237 , language
238 }
239 false, _, _ -> element (unsafeCreateDOMComponent "pre") props
240 }
241 pure
242 $ element mdxProvider
243 { children: pure $ jsx cssBaseline {} [ siteInfoJSX ]
244 , components: mdxComponents
245 }
247mkQuiz ∷ _ -> Effect (ReactComponent _)
248mkQuiz compiler = do
249 fillInTheGaps <- FillInTheGaps.makeComponent
250 box <- Box.makeComponent
251 component "Quiz" \({ initialSegments, onFailure, onSuccess } ∷ { initialSegments ∷ _, onFailure ∷ _, onSuccess ∷ _ }) -> React.do
252 segments /\ updateSegments <- useState initialSegments
253 solvedWith /\ updateSolvedWith <- useState Nothing
254 pure
255 $ jsx box {}
256 [ element fillInTheGaps
257 { segments
258 , incantate:
259 launchAff_ do
260 let code = toCode segments
261 result <- compiler.compileAndRun { code }
262 liftEffect case result of
263 Right r
264 | String.stripSuffix (String.Pattern "\n") r.stdout == (findResult $ join segments) -> do
265 updateSolvedWith (const $ String.stripSuffix (String.Pattern "\n") r.stdout)
266 onSuccess
267 Right r
268 | r.stdout /= "\n" -> onFailure "Oh shit!" [ R.text r.stdout ]
269 Right r -> onFailure "Oh shit!" [ R.text r.stderr ]
270 Left (cr ∷ CompileResult) -> onFailure "Oh shit!" [ R.text (intercalate ", " (cr.result <#> _.message)) ]
271 , updateSegments:
272 \update -> do
273 let updated = update segments
274 case segments, updated of
275 old, new
276 | new == old -> mempty
277 _, _ -> updateSegments (const updated)
278 , solvedWith
279 }
280 ]
282foreign import mdxProvider ∷
283 ∀ r.
284 ReactComponent
285 { components ∷ { | r } -- TODO Don't lie
286 , children ∷ Array JSX
287 }