git.iko.soy/rowtype-yoga/psfp
on 2683ce6 help sign in
rowtype-yoga/psfp/blog/src/components/PSLayout.purs
273 lines 10.0 kB history raw
1module PSLayout where
3import Prelude
4import Components.Container as Container
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 Effect (Effect)
18import Effect.Aff (launchAff_)
19import Effect.Class (liftEffect)
20import Effect.Unsafe (unsafePerformEffect)
21import JSS (jssClasses)
22import Justifill (justifill)
23import Milkis.Impl (FetchImpl)
24import React.Basic (JSX, ReactComponent, fragment)
25import React.Basic.DOM (Props_h1, Props_h2, Props_h3, Props_p, css, unsafeCreateDOMComponent)
26import React.Basic.DOM as R
27import React.Basic.Helpers (jsx)
28import React.Basic.Hooks (ReactChildren, element, memo, mkReducer, reactChildrenFromArray, reactChildrenToArray, reactComponent, reactComponentWithChildren, useReducer, useState)
29import React.Basic.Hooks as React
30import Shared.Models.Body (CompileResult)
31import Unsafe.Coerce (unsafeCoerce)
32import Yoga (el)
33import Yoga.Box.Component as Box
34import Yoga.ClickAway.Component as ClickAway
35import Yoga.CloseIcon.Component as CloseIcon
36import Yoga.CompileEditor.Component (mkCompileEditor)
37import Yoga.Compiler.Api (apiCompiler)
38import Yoga.Compiler.Types (Compiler)
39import Yoga.Cover.Component as Cover
40import Yoga.FillInTheGaps.Component as FillInTheGaps
41import Yoga.FillInTheGaps.Logic (Segment, findResult, parseSegments, toCode)
42import Yoga.Header.Component (mkHeader)
43import Yoga.Helpers ((?||))
44import Yoga.Imposter.Component as Imposter
45import Yoga.InlineCode.Component as InlineCode
46import Yoga.Modal.Component as Modal
47import Yoga.Theme (fromTheme)
48import Yoga.Theme.CSSBaseline (mkCssBaseline)
49import Yoga.Theme.Default (darkTheme)
50import Yoga.Theme.Default as Default
51import Yoga.Theme.Provider (mkThemeProvider)
52import Yoga.Theme.Styles (makeStylesJSS)
53import Yoga.Theme.Types (CSSTheme)
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 <- Modal.makeComponent
89 imposter <- Imposter.makeComponent
90 cover <- Cover.makeComponent
91 clickAway <- ClickAway.makeComponent
92 reducer <-
93 mkReducer case _, _ of
94 _, ShowModal props -> Just props
95 _, HideModal -> Nothing
96 mdxProviderComponent <- memo $ mkMdxProviderComponent (apiCompiler fetchImpl)
97 reactComponentWithChildren "MDXLayout" \{ children, siteInfo } -> React.do
98 (maybeModalProps ∷ Maybe Modal.Props) /\ dispatch <- useReducer Nothing reducer
99 pure
100 $ el themeProvider
101 { theme: fromTheme darkTheme }
102 [ el R.div'
103 { style: css { maxWidth: "none" } }
104 [ maybeModalProps
105 # foldMap \modalProps ->
106 fragment
107 [ element clickAway { allowEscape: Just true, onClick: dispatch HideModal, style: Nothing }
108 , element modal (justifill modalProps)
109 ]
110 , element Container.component
111 { children:
112 reactChildrenFromArray
113 [ element mdxProviderComponent
114 { children
115 , siteInfo
116 , showModal: dispatch <<< ShowModal
117 , hideModal: dispatch HideModal
118 }
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)
131type MdxProviderProps =
132 { children ∷ ReactChildren JSX
133 , siteInfo ∷ SiteQueryResult
134 , showModal ∷ Modal.Props -> Effect Unit
135 , hideModal ∷ Effect Unit
136 }
138mkMdxProviderComponent ∷ ∀ r. { | Compiler r } -> Effect (ReactComponent MdxProviderProps)
139mkMdxProviderComponent compiler = do
140 cssBaseline <- memo (mkCssBaseline Default.fontFaces)
141 editor <- memo $ mkCompileEditor compiler
142 box <- memo $ Box.makeComponent
143 header <- memo mkHeader
144 yogaInlineCode <- InlineCode.makeComponent
145 quiz <- memo $ mkQuiz compiler
146 closeIcon <- CloseIcon.makeComponent
147 reactComponentWithChildren "MDXProviderComponent" \({ children, siteInfo, showModal, hideModal } ∷ MdxProviderProps) -> React.do
148 visibleUntil /\ updateVisible <- useState 1
149 let
150 onFailure title kids =
151 showModal
152 ( justifill
153 { title
154 , icon: element closeIcon { onClick: hideModal, style: Nothing }
155 , kids
156 } ∷
157 Modal.Props
158 )
159 onSuccess = updateVisible (_ + one)
160 mapVisible i kid =
161 { accum: i + if isQuiz kid then one else zero
162 , value: guard (i < visibleUntil) (pure kid)
163 }
164 visibleKids ∷ Array JSX
165 visibleKids =
166 reactChildrenToArray children
167 # mapAccumL mapVisible zero
168 # _.value
169 # Array.catMaybes
170 siteInfoJSX =
171 R.div
172 { children:
173 [ jsx header { className: "" } [ R.text siteInfo.siteMetadata.title ]
174 , jsx box {} visibleKids
175 ]
176 }
177 mdxComponents /\ _ <-
178 useState
179 { h1:
180 \(props ∷ { | Props_h1 }) -> R.h1 props
181 , h2:
182 \(props ∷ { | Props_h2 }) -> R.h2 props
183 , h3:
184 \(props ∷ { | Props_h3 }) -> R.h3 props
185 , hr: (const $ R.hr {})
186 , p:
187 \(props ∷ { | Props_p }) -> R.p props
188 , inlineCode:
189 \props -> do
190 R.span { children: props.children }
191 , pre:
192 mkFn2 \(props ∷ PreProps) other -> do
193 let
194 childrenQ = Nullable.toMaybe props.children
195 propsQ = (_.props >>> Nullable.toMaybe) =<< childrenQ
196 mdxTypeQ = (_.mdxType >>> Nullable.toMaybe) =<< propsQ
197 childrenQ2 = (_.children >>> Nullable.toMaybe) =<< propsQ
198 classNameQ = (_.className >>> Nullable.toMaybe) =<< propsQ
199 isCode = fromMaybe false (mdxTypeQ <#> eq "code")
200 codeQ = childrenQ2
201 height =
202 (fromMaybe 200 >>> show >>> (_ <> "px")) do
203 code <- codeQ
204 pure
205 ( String.split (String.Pattern "\n") code
206 # Array.length
207 # \x -> (x * 12) + 100
208 )
209 language = fromMaybe "" (classNameQ >>= String.stripPrefix (String.Pattern "language-"))
210 segmentsQ = parseSegments (codeQ ?|| "")
211 case isCode, language, segmentsQ of
212 true, "purescript", Just initialSegments -> element quiz { initialSegments, onFailure, onSuccess }
213 true, _, _ ->
214 element editor
215 { initialCode: fromMaybe "" codeQ
216 , height
217 , language
218 }
219 false, _, _ -> element (unsafePerformEffect $ unsafeCreateDOMComponent "pre") props
220 }
221 pure
222 $ element mdxProvider
223 { children: pure $ jsx cssBaseline {} [ siteInfoJSX ]
224 , components: mdxComponents
225 }
227type QuizProps =
228 { initialSegments ∷ Array (Array Segment)
229 , onFailure ∷ String -> Array JSX -> Effect Unit
230 , onSuccess ∷ Effect Unit
231 }
233mkQuiz ∷ ∀ r. { | Compiler r } -> Effect (ReactComponent QuizProps)
234mkQuiz compiler = do
235 fillInTheGaps <- FillInTheGaps.makeComponent
236 box <- Box.makeComponent
237 reactComponent "Quiz" \({ initialSegments, onFailure, onSuccess } ∷ QuizProps) -> React.do
238 segments /\ updateSegments <- useState initialSegments
239 solvedWith /\ updateSolvedWith <- useState Nothing
240 pure
241 $ jsx box {}
242 [ element fillInTheGaps
243 { segments
244 , incantate:
245 launchAff_ do
246 let code = toCode segments
247 result <- compiler.compileAndRun { code }
248 liftEffect case result of
249 Right r
250 | String.stripSuffix (String.Pattern "\n") r.stdout == (findResult $ join segments) -> do
251 updateSolvedWith (const $ String.stripSuffix (String.Pattern "\n") r.stdout)
252 onSuccess
253 Right r
254 | r.stdout /= "\n" -> onFailure "Oh shit!" [ R.text r.stdout ]
255 Right r -> onFailure "Oh shit!" [ R.text r.stderr ]
256 Left (cr ∷ CompileResult) -> onFailure "Oh shit!" [ R.text (intercalate ", " (cr.result <#> _.message)) ]
257 , updateSegments:
258 \update -> do
259 let updated = update segments
260 case segments, updated of
261 old, new
262 | new == old -> mempty
263 _, _ -> updateSegments (const updated)
264 , solvedWith
265 }
266 ]
268foreign import mdxProvider ∷
269 ∀ r.
270 ReactComponent
271 { components ∷ { | r } -- TODO Don't lie
272 , children ∷ Array JSX
273 }