git.iko.soy/rowtype-yoga/psfp
on 6c57a55 help sign in
rowtype-yoga/psfp/blog/src/components/PSLayout.purs
297 lines 9.5 kB history raw
1module PSLayout where
3import Prelude
5import Data.Array (foldMap)
6import Data.Array as A
7import Data.Array as Array
8import Data.Array.NonEmpty as NEA
9import Data.Either (Either(..))
10import Data.Maybe (Maybe(..), fromMaybe, isJust)
11import Data.Nullable (Nullable)
12import Data.Nullable as Nullable
13import Data.String as String
14import Data.Tuple.Nested ((/\))
15import Effect (Effect)
16import Effect.Aff (launchAff_)
17import Effect.Class (liftEffect)
18import JSS (jss, jssClasses)
19import Justifill (justifill)
20import Milkis.Impl (FetchImpl)
21import React.Basic (JSX, ReactComponent, fragment)
22import React.Basic.DOM (unsafeCreateDOMComponent)
23import React.Basic.DOM as R
24import React.Basic.Helpers (jsx)
25import React.Basic.Hooks (ReactChildren, component, componentWithChildren, element, reactChildrenToArray, useEffect, useState)
26import React.Basic.Hooks as React
27import Unsafe.Coerce (unsafeCoerce)
28import Yoga.Box.Component as Box
29import Yoga.ClickAway.Component as ClickAway
30import Yoga.CompileEditor.Component (mkCompileEditor)
31import Yoga.Compiler.Api (apiCompiler)
32import Yoga.Compiler.Types (Compiler)
33import Yoga.FillInTheGaps.Component as FillInTheGaps
34import Yoga.FillInTheGaps.Logic (findResult, parseSegments, toCode)
35import Yoga.Header.Component (mkHeader)
36import Yoga.Helpers ((?||))
37import Yoga.InlineCode.Component as InlineCode
38import Yoga.Modal.Component as Modal
39import Yoga.Theme (fromTheme)
40import Yoga.Theme.CSSBaseline (mkCssBaseline)
41import Yoga.Theme.Default (darkTheme)
42import Yoga.Theme.Provider (mkThemeProvider)
43import Yoga.Theme.Styles (makeStylesJSS)
44import Yoga.Theme.Types (CSSTheme)
45import Yoga.Typography.Header (HeadingLevel(..), mkH)
46import Yoga.Typography.Paragraph (mkP)
47import Yoga.WithSidebar.Component (makeComponent) as WithSidebar
49type SiteQueryResult
50 = { site ∷
51 { siteMetadata ∷
52 { title ∷ String
53 , menuLinks ∷ Array { name ∷ String, link ∷ String }
54 }
55 }
56 }
58type PreProps
59 = { children ∷
60 Nullable
61 { props ∷
62 Nullable
63 { mdxType ∷ Nullable String
64 , children ∷ Nullable String
65 , className ∷ Nullable String
66 }
67 }
68 }
70mkLayout ∷
71 FetchImpl ->
72 Effect
73 ( ReactComponent
74 { children ∷ ReactChildren JSX
75 , siteInfo ∷ SiteQueryResult
76 }
77 )
78mkLayout fetchImpl = do
79 themeProvider <- mkThemeProvider
80 mdxProviderComponent <- mkMdxProviderComponent (apiCompiler fetchImpl)
81 componentWithChildren "MDXLayout" \{ children, siteInfo } -> React.do
82 pure
83 $ element themeProvider
84 { theme: fromTheme darkTheme
85 , children:
86 [ element mdxProviderComponent
87 { children
88 , siteInfo
89 }
90 ]
91 }
93mkSecret ∷ Effect (ReactComponent { kids ∷ Array JSX, visible ∷ Boolean, register ∷ Effect Unit })
94mkSecret = do
95 component "Secret" \{ kids, visible, register } -> React.do
96 useEffect visible do
97 unless visible register
98 pure mempty
99 pure
100 $ R.div
101 { style: R.css { visibility: if visible then "visible" else "hidden" }
102 , children: kids
103 }
105isQuiz ∷ JSX -> Boolean
106isQuiz a =
107 (unsafeCoerce a).props.mdxType == "pre"
108 && ((unsafeCoerce a).props.children.props.className == "language-purescript")
109 && ((unsafeCoerce a).props.children.props.mdxType == "code")
110 && ((unsafeCoerce a).props.children.props.children # parseSegments # isJust)
112mkMdxProviderComponent ∷
113 ∀ r.
114 { | Compiler r } ->
115 Effect
116 ( ReactComponent
117 { children ∷ ReactChildren JSX
118 , siteInfo ∷ SiteQueryResult
119 }
120 )
121mkMdxProviderComponent compiler = do
122 cssBaseline <- mkCssBaseline
123 editor <- mkCompileEditor compiler
124 fillInTheGaps <- FillInTheGaps.makeComponent
125 box <- Box.makeComponent
126 sidebar <- mkSidebar
127 header <- mkHeader
128 yogaInlineCode <- InlineCode.makeComponent
129 modal <- Modal.makeComponent
130 clickAway <- ClickAway.makeComponent
131 h <- mkH
132 p <- mkP
133 secret <- mkSecret
134 useStyles <-
135 makeStylesJSS
136 $ jssClasses \(theme ∷ CSSTheme) ->
137 { code:
138 { fontFamily: theme.codeFontFamily # NEA.head
139 , backgroundColor: theme.interfaceColour
140 , fontSize: "10pt"
141 , border: "1px solid #383c39"
142 , padding: "3px"
143 , borderRadius: "3px"
144 }
145 , flexer:
146 { display: "flex"
147 , flexDirection: "row"
148 }
149 }
150 componentWithChildren "MDXProviderComponent" \{ children, siteInfo } -> React.do
151 classes <- useStyles {}
152 visibleThrough /\ updateVisible <- useState 1
153 questions /\ updateQuestions <- useState []
154 maybeModal /\ updateModal <- useState Nothing
155 let
156 baseline child = element cssBaseline { kids: child }
158 kids = reactChildrenToArray children
160 foldVisible ∷ { i ∷ Int, acc ∷ Array JSX } -> JSX -> { i ∷ Int, acc ∷ Array JSX }
161 foldVisible { i, acc } a =
162 if i >= visibleThrough then
163 { i, acc }
164 else
165 if isQuiz a then
166 { i: i + 1, acc: A.snoc acc a }
167 else
168 { i, acc: A.snoc acc a }
170 visibleKids = kids # A.foldl foldVisible { i: 0, acc: [] ∷ Array JSX } # _.acc
172 siteInfoJSX =
173 R.div
174 { children:
175 [ jsx header { className: "" } [ R.text siteInfo.site.siteMetadata.title ]
176 , element sidebar { links: siteInfo.site.siteMetadata.menuLinks }
177 , jsx box {} visibleKids
178 ]
179 }
181 mdxComponents =
182 { h1:
183 \props ->
184 element h ({ level: H2, text: props.children, className: Nothing })
185 , h2:
186 \props ->
187 element h { level: H3, text: props.children, className: Nothing }
188 , h3:
189 \props ->
190 element h { level: H4, text: props.children, className: Nothing }
191 , hr: (const $ R.hr {})
192 , p:
193 \props ->
194 R.div
195 { children: [ element p { text: props.children } ]
196 }
197 , inlineCode:
198 \props -> do
199 R.span { className: classes.code, children: props.children }
200 , pre:
201 \(props ∷ PreProps) -> do
202 let
203 childrenQ = Nullable.toMaybe props.children
205 propsQ = (_.props >>> Nullable.toMaybe) =<< childrenQ
207 mdxTypeQ = (_.mdxType >>> Nullable.toMaybe) =<< propsQ
209 childrenQ2 = (_.children >>> Nullable.toMaybe) =<< propsQ
211 classNameQ = (_.className >>> Nullable.toMaybe) =<< propsQ
213 isCode = fromMaybe false (mdxTypeQ <#> eq "code")
215 codeQ = childrenQ2
217 height =
218 (fromMaybe 200 >>> show >>> (_ <> "px")) do
219 code <- codeQ
220 pure
221 ( String.split (String.Pattern "\n") code
222 # Array.length
223 # \x -> (x * 12) + 100
224 )
226 language = fromMaybe "" (classNameQ >>= String.stripPrefix (String.Pattern "language-"))
228 segmentsQ = parseSegments (codeQ ?|| "")
229 case isCode, language, segmentsQ of
230 true, "purescript", Just initialSegments ->
231 jsx box {}
232 [ element fillInTheGaps
233 { initialSegments
234 , incantate: \segments -> launchAff_ do
235 let code = toCode segments
236 result <- compiler.compileAndRun { code }
237 liftEffect case result of
238 Right r | String.stripSuffix (String.Pattern "\n") r.stdout == (findResult $ join segments) ->
239 updateVisible (_ + 1)
240 _ ->
241 updateModal (const $ Just { title: "Failed", kids: [R.text "Try again"] })
242 }
243 ]
244 true, _, _ ->
245 element editor
246 { initialCode: fromMaybe "" codeQ
247 , height
248 , language
249 }
250 false, _, _ -> element (unsafeCreateDOMComponent "pre") props
251 }
252 pure
253 $ baseline
254 [ element mdxProvider
255 { children:
256 [ siteInfoJSX
257 ]
258 , components: mdxComponents
259 }
260 , maybeModal # foldMap
261 (\modalProps ->
262 fragment [
263 element clickAway { allowEscape: Just true, onClick: updateModal (const Nothing), style: Nothing },
264 element modal (justifill modalProps)
265 ]
266 )
267 ]
269mkSidebar = do
270 withSidebar <- WithSidebar.makeComponent
271 useStyles <-
272 makeStylesJSS
273 $ jssClasses \(theme ∷ CSSTheme) ->
274 { flexer:
275 jss
276 { display: "flex"
277 , flexDirection: "row"
278 , width: "300px"
279 , height: "300px"
280 }
281 }
282 component "Sidebar" \{ links } -> React.do
283 classes <- useStyles {}
284 pure
285 $ element withSidebar
286 ( justifill
287 { sidebarChildren: [ R.div_ [ R.text "hahahaha" ] ]
288 , notSidebarChildren: [] ∷ Array JSX
289 }
290 )
292foreign import mdxProvider ∷
293 ∀ r.
294 ReactComponent
295 { components ∷ { | r } -- TODO Don't lie
296 , children ∷ Array JSX
297 }