git.iko.soy/rowtype-yoga/psfp
on ef89337 help sign in
rowtype-yoga/psfp/blog/src/components/MDXProvider.purs
225 lines 8.3 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(--s-1) + 2.4vw), var(--s1))"
104 , lineHeight: E.var "--line-height-small"
105 , "-ms-hyphens": E.str "auto"
106 , "-webkit-hyphens": E.str "auto"
107 , hyphens: E.str "auto"
108 , overflow: E.str "hidden"
109 }
110 , className: "blog-p"
111 , children: parChildren
112 }
113 )
114 let
115 mdxComponents =
116 { "Sc":
117 \(props :: { children :: String }) ->
118 smallCaps props.children
119 , h1:
120 \(props ∷ { | M.MotionProps Props_h1 }) ->
121 React.element M.h1 (props { layout = M.layout true })
122 , h2:
123 \(props ∷ { | M.MotionProps Props_h2 }) ->
124 React.element M.h2 (props { layout = M.layout true })
125 , h3:
126 \(props ∷ { | M.MotionProps Props_h3 }) ->
127 React.element M.h3 (props { layout = M.layout true })
128 , h4:
129 \(props ∷ { | M.MotionProps Props_h4 }) ->
130 React.element M.h4 (props { layout = M.layout true })
131 , hr: (const $ R.hr {})
132 , p:
133 \(props ∷ { children :: Array JSX }) ->
134 paragraph props.children
135 , inlineCode:
136 \props -> do
137 R.span { children: props.children }
138 , pre:
139 mkFn2 \(props ∷ PreProps) other -> do
140 let
141 childrenQ = Nullable.toMaybe props.children
143 propsQ = (_.props >>> Nullable.toMaybe) =<< childrenQ
145 mdxTypeQ = (_.mdxType >>> Nullable.toMaybe) =<< propsQ
147 childrenQ2 = (_.children >>> Nullable.toMaybe) =<< propsQ
149 classNameQ = (_.className >>> Nullable.toMaybe) =<< propsQ
151 isCode = fromMaybe false (mdxTypeQ <#> eq "code")
153 codeQ = childrenQ2
155 height =
156 (fromMaybe 200 >>> show >>> (_ <> "px")) do
157 code <- codeQ
158 pure
159 ( String.split (String.Pattern "\n") code
160 # Array.length
161 # \x -> (x * 12) + 100
162 )
164 language = fromMaybe "" (classNameQ >>= String.stripPrefix (String.Pattern "language-"))
166 segmentsQ = parseSegments (codeQ ?|| "")
167 case isCode, language, segmentsQ of
168 true, "purescript", Just initialSegments -> element quiz { initialSegments, onFailure, onSuccess }
169 true, _, _ ->
170 element editor
171 { initialCode: fromMaybe "" codeQ
172 , height
173 , language
174 }
175 false, _, _ -> element (unsafePerformEffect $ unsafeCreateDOMComponent "pre") props
176 }
177 pure
178 $ element mdxProvider
179 { children: contentMDX
180 , components: mdxComponents
181 }
183type QuizProps
184 = { initialSegments ∷ Array (Array Segment)
185 , onFailure ∷ String -> Array JSX -> Effect Unit
186 , onSuccess ∷ Effect Unit
187 }
189mkQuiz ∷ ∀ r. { | Compiler r } -> Effect (ReactComponent QuizProps)
190mkQuiz compiler = do
191 fillInTheGaps <- FillInTheGaps.makeComponent
192 reactComponent "Quiz" \({ initialSegments, onFailure, onSuccess } ∷ QuizProps) -> React.do
193 segments /\ updateSegments <- useState initialSegments
194 solvedWith /\ updateSolvedWith <- useState Nothing
195 pure
196 $ element fillInTheGaps
197 { segments
198 , run:
199 launchAff_ do
200 let
201 code = toCode segments
202 result <- compiler.compileAndRun { code }
203 liftEffect case result of
204 Right r
205 | String.stripSuffix (String.Pattern "\n") r.stdout == (findResult $ join segments) -> do
206 updateSolvedWith (const $ String.stripSuffix (String.Pattern "\n") r.stdout)
207 onSuccess
208 Right r
209 | r.stdout /= "\n" -> onFailure "Oh shit!" [ R.text r.stdout ]
210 Right r -> onFailure "Oh shit!" [ R.text r.stderr ]
211 Left (cr ∷ CompileResult) -> onFailure "Oh shit!" [ R.text (intercalate ", " (cr.result <#> _.message)) ]
212 , updateSegments:
213 \update -> do
214 let
215 updated = update segments
216 unless (segments == updated) do updateSegments (const updated)
217 , solvedWith
218 }
220foreign import mdxProvider ∷
221 ∀ r.
222 ReactComponent
223 { components ∷ { | r }
224 , children ∷ ReactChildren MDX
225 }