git.iko.soy/rowtype-yoga/psfp
on a333b88 help sign in
rowtype-yoga/psfp/blog/src/components/MDXProvider.purs
223 lines 8.2 kB history raw
1module MDXProvider where
3import Prelude
4import Data.Array (intercalate)
5import Data.Array as Array
6import Data.Either (Either(..))
7import Data.Function.Uncurried (mkFn2)
8import Data.Maybe (Maybe(..), fromMaybe, isJust)
9import Data.Nullable (Nullable)
10import Data.Nullable as Nullable
11import Data.String as String
12import Data.Traversable (mapAccumL)
13import Data.Tuple.Nested ((/\))
14import Effect (Effect)
15import Effect.Aff (launchAff_)
16import Effect.Class (liftEffect)
17import Effect.Class.Console (log)
18import Effect.Unsafe (unsafePerformEffect)
19import Framer.Motion as M
20import MDX (MDX(..))
21import Milkis.Impl (FetchImpl)
22import React.Basic (JSX, ReactComponent)
23import React.Basic.DOM (Props_h1, Props_h2, Props_h3, Props_h4, Props_p, Props_a, unsafeCreateDOMComponent)
24import React.Basic.DOM as R
25import React.Basic.Emotion as E
26import React.Basic.Hooks (ReactChildren, element, memo, reactChildrenFromArray, reactChildrenToArray, reactComponent, reactComponentWithChildren, useState)
27import React.Basic.Hooks as React
28import Shared.Models.Body (CompileResult)
29import Typography.SmallCaps (mkSmallCaps)
30import Unsafe.Coerce (unsafeCoerce)
31import Yoga.CompileEditor.Component (mkCompileEditor)
32import Yoga.Compiler.Api (apiCompiler)
33import Yoga.Compiler.Types (Compiler)
34import Yoga.FillInTheGaps.Component as FillInTheGaps
35import Yoga.FillInTheGaps.Logic (Segment, findResult, parseSegments, toCode)
36import Yoga.Helpers ((?||))
37import Yoga as Y
39type PreProps
40 = { children ∷
41 Nullable
42 { props ∷
43 Nullable
44 { mdxType ∷ Nullable String
45 , children ∷ Nullable String
46 , className ∷ Nullable String
47 }
48 }
49 }
51isQuiz ∷ MDX -> Boolean
52isQuiz (MDX a) =
53 a.props.mdxType == "pre"
54 && ((unsafeCoerce a).props.children.props.className == "language-purescript")
55 && ((unsafeCoerce a).props.children.props.mdxType == "code")
56 && ((unsafeCoerce a).props.children.props.children # parseSegments # isJust)
58type MdxProviderProps
59 = { children ∷ ReactChildren MDX
60 }
62mkLiveMdxProviderComponent ∷ FetchImpl -> Effect (ReactComponent MdxProviderProps)
63mkLiveMdxProviderComponent fetchImpl = mkMdxProviderComponent (apiCompiler fetchImpl)
65mkMdxProviderComponent ∷
66 ∀ r.
67 { | Compiler r } ->
68 Effect (ReactComponent MdxProviderProps)
69mkMdxProviderComponent compiler = do
70 editor <- memo $ mkCompileEditor compiler
71 quiz <- memo $ mkQuiz compiler
72 smallCaps <- mkSmallCaps
73 reactComponentWithChildren "MDXProviderComponent" do
74 \{ children } -> React.do
75 visibleUntil /\ updateVisible <- useState 1
76 let
77 onFailure title kids = log "Oopsie daisy"
79 onSuccess = updateVisible (_ + one)
81 mapVisible ∷ Int -> MDX -> _
82 mapVisible i kid =
83 { accum: i + if isQuiz kid then one else zero
84 , value: if (i < visibleUntil) then Just kid else Nothing
85 }
87 visibleKids ∷ Array MDX
88 visibleKids =
89 reactChildrenToArray children
90 # mapAccumL mapVisible zero
91 # _.value
92 # Array.catMaybes
94 contentMDX ∷ ReactChildren MDX
95 contentMDX = reactChildrenFromArray visibleKids
97 paragraph parChildren =
98 E.element M.p
99 ( { layout: M.layout true
100 , css:
101 E.css
102 { fontFamily: E.str "Cormorant Garamond"
103 , fontSize: E.str "min(calc(var(--s0) + 4vw), var(--s1))"
104 , "-ms-hyphens": E.str "auto"
105 , "-webkit-hyphens": E.str "auto"
106 , hyphens: E.str "auto"
107 }
108 , className: "blog-p"
109 , children: parChildren
110 }
111 )
112 let
113 mdxComponents =
114 { "Sc":
115 \(props :: { children :: String }) ->
116 smallCaps props.children
117 , h1:
118 \(props ∷ { | M.MotionProps Props_h1 }) ->
119 React.element M.h1 (props { layout = M.layout true })
120 , h2:
121 \(props ∷ { | M.MotionProps Props_h2 }) ->
122 React.element M.h2 (props { layout = M.layout true })
123 , h3:
124 \(props ∷ { | M.MotionProps Props_h3 }) ->
125 React.element M.h3 (props { layout = M.layout true })
126 , h4:
127 \(props ∷ { | M.MotionProps Props_h4 }) ->
128 React.element M.h4 (props { layout = M.layout true })
129 , hr: (const $ R.hr {})
130 , p:
131 \(props ∷ { children :: Array JSX }) ->
132 paragraph props.children
133 , inlineCode:
134 \props -> do
135 R.span { children: props.children }
136 , pre:
137 mkFn2 \(props ∷ PreProps) other -> do
138 let
139 childrenQ = Nullable.toMaybe props.children
141 propsQ = (_.props >>> Nullable.toMaybe) =<< childrenQ
143 mdxTypeQ = (_.mdxType >>> Nullable.toMaybe) =<< propsQ
145 childrenQ2 = (_.children >>> Nullable.toMaybe) =<< propsQ
147 classNameQ = (_.className >>> Nullable.toMaybe) =<< propsQ
149 isCode = fromMaybe false (mdxTypeQ <#> eq "code")
151 codeQ = childrenQ2
153 height =
154 (fromMaybe 200 >>> show >>> (_ <> "px")) do
155 code <- codeQ
156 pure
157 ( String.split (String.Pattern "\n") code
158 # Array.length
159 # \x -> (x * 12) + 100
160 )
162 language = fromMaybe "" (classNameQ >>= String.stripPrefix (String.Pattern "language-"))
164 segmentsQ = parseSegments (codeQ ?|| "")
165 case isCode, language, segmentsQ of
166 true, "purescript", Just initialSegments -> element quiz { initialSegments, onFailure, onSuccess }
167 true, _, _ ->
168 element editor
169 { initialCode: fromMaybe "" codeQ
170 , height
171 , language
172 }
173 false, _, _ -> element (unsafePerformEffect $ unsafeCreateDOMComponent "pre") props
174 }
175 pure
176 $ element mdxProvider
177 { children: contentMDX
178 , components: mdxComponents
179 }
181type QuizProps
182 = { initialSegments ∷ Array (Array Segment)
183 , onFailure ∷ String -> Array JSX -> Effect Unit
184 , onSuccess ∷ Effect Unit
185 }
187mkQuiz ∷ ∀ r. { | Compiler r } -> Effect (ReactComponent QuizProps)
188mkQuiz compiler = do
189 fillInTheGaps <- FillInTheGaps.makeComponent
190 reactComponent "Quiz" \({ initialSegments, onFailure, onSuccess } ∷ QuizProps) -> React.do
191 segments /\ updateSegments <- useState initialSegments
192 solvedWith /\ updateSolvedWith <- useState Nothing
193 pure
194 $ element fillInTheGaps
195 { segments
196 , run:
197 launchAff_ do
198 let
199 code = toCode segments
200 result <- compiler.compileAndRun { code }
201 liftEffect case result of
202 Right r
203 | String.stripSuffix (String.Pattern "\n") r.stdout == (findResult $ join segments) -> do
204 updateSolvedWith (const $ String.stripSuffix (String.Pattern "\n") r.stdout)
205 onSuccess
206 Right r
207 | r.stdout /= "\n" -> onFailure "Oh shit!" [ R.text r.stdout ]
208 Right r -> onFailure "Oh shit!" [ R.text r.stderr ]
209 Left (cr ∷ CompileResult) -> onFailure "Oh shit!" [ R.text (intercalate ", " (cr.result <#> _.message)) ]
210 , updateSegments:
211 \update -> do
212 let
213 updated = update segments
214 unless (segments == updated) do updateSegments (const updated)
215 , solvedWith
216 }
218foreign import mdxProvider ∷
219 ∀ r.
220 ReactComponent
221 { components ∷ { | r }
222 , children ∷ ReactChildren MDX
223 }