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