git.iko.soy/rowtype-yoga/psfp
on f86fac1 help sign in
rowtype-yoga/psfp/blog/src/components/MDXProvider.purs
209 lines 8.0 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"
78 onSuccess = updateVisible (_ + one)
79 mapVisible ∷ Int -> MDX -> _
80 mapVisible i kid =
81 { accum: i + if isQuiz kid then one else zero
82 , value: if (i < visibleUntil) then Just kid else Nothing
83 }
84 visibleKids ∷ Array MDX
85 visibleKids =
86 reactChildrenToArray children
87 # mapAccumL mapVisible zero
88 # _.value
89 # Array.catMaybes
90 contentMDX ∷ ReactChildren MDX
91 contentMDX = reactChildrenFromArray visibleKids
92 paragraph parChildren =
93 E.element M.p
94 ( { layout: M.layout true
95 , css:
96 E.css
97 { fontFamily: E.str "Cormorant Garamond"
98 , fontSize: E.str "min(calc(var(--s-1) + 2.4vw), var(--s1))"
99 , lineHeight: E.var "--line-height-small"
100 , "-msHyphens": E.str "auto"
101 , "-webkitHyphens": E.str "auto"
102 , hyphens: E.str "auto"
103 , overflow: E.str "hidden"
104 }
105 , className: "blog-p"
106 , children: parChildren
107 }
108 )
109 let
110 mdxComponents =
111 { "Sc":
112 \(props ∷ { children ∷ String }) ->
113 smallCaps props.children
114 , h1:
115 \(props ∷ { | M.MotionProps Props_h1 }) ->
116 React.element M.h1 (props { layout = M.layout true })
117 , h2:
118 \(props ∷ { | M.MotionProps Props_h2 }) ->
119 React.element M.h2 (props { layout = M.layout true })
120 , h3:
121 \(props ∷ { | M.MotionProps Props_h3 }) ->
122 React.element M.h3 (props { layout = M.layout true })
123 , h4:
124 \(props ∷ { | M.MotionProps Props_h4 }) ->
125 React.element M.h4 (props { layout = M.layout true })
126 , hr: (const $ R.hr {})
127 , p:
128 \(props ∷ { children ∷ Array JSX }) ->
129 paragraph props.children
130 , inlineCode:
131 \props -> do
132 R.span { children: props.children }
133 , pre:
134 mkFn2 \(props ∷ PreProps) other -> do
135 let
136 childrenQ = Nullable.toMaybe props.children
137 propsQ = (_.props >>> Nullable.toMaybe) =<< childrenQ
138 mdxTypeQ = (_.mdxType >>> Nullable.toMaybe) =<< propsQ
139 childrenQ2 = (_.children >>> Nullable.toMaybe) =<< propsQ
140 classNameQ = (_.className >>> Nullable.toMaybe) =<< propsQ
141 isCode = fromMaybe false (mdxTypeQ <#> eq "code")
142 codeQ = childrenQ2
143 height =
144 (fromMaybe 200 >>> show >>> (_ <> "px")) do
145 code <- codeQ
146 pure
147 ( String.split (String.Pattern "\n") code
148 # Array.length
149 # \x -> (x * 12) + 100
150 )
151 language = fromMaybe "" (classNameQ >>= String.stripPrefix (String.Pattern "language-"))
152 segmentsQ = parseSegments (codeQ ?|| "")
153 case isCode, language, segmentsQ of
154 true, "purescript", Just initialSegments -> element quiz { initialSegments, onFailure, onSuccess }
155 true, _, _ ->
156 element editor
157 { initialCode: fromMaybe "" codeQ
158 , height
159 , language
160 }
161 false, _, _ -> element (unsafePerformEffect $ unsafeCreateDOMComponent "pre") props
162 }
163 pure
164 $ element mdxProvider
165 { children: contentMDX
166 , components: mdxComponents
167 }
169type QuizProps =
170 { initialSegments ∷ Array (Array Segment)
171 , onFailure ∷ String -> Array JSX -> Effect Unit
172 , onSuccess ∷ Effect Unit
173 }
175mkQuiz ∷ ∀ r. { | Compiler r } -> Effect (ReactComponent QuizProps)
176mkQuiz compiler = do
177 fillInTheGaps <- FillInTheGaps.makeComponent
178 reactComponent "Quiz" \({ initialSegments, onFailure, onSuccess } ∷ QuizProps) -> React.do
179 segments /\ updateSegments <- useState initialSegments
180 solvedWith /\ updateSolvedWith <- useState Nothing
181 pure
182 $ element fillInTheGaps
183 { segments
184 , run:
185 launchAff_ do
186 let code = toCode segments
187 result <- compiler.compileAndRun { code }
188 liftEffect case result of
189 Right r
190 | String.stripSuffix (String.Pattern "\n") r.stdout == (findResult $ join segments) -> do
191 updateSolvedWith (const $ String.stripSuffix (String.Pattern "\n") r.stdout)
192 onSuccess
193 Right r
194 | r.stdout /= "\n" -> onFailure "Oh shit!" [ R.text r.stdout ]
195 Right r -> onFailure "Oh shit!" [ R.text r.stderr ]
196 Left (cr ∷ CompileResult) -> onFailure "Oh shit!" [ R.text (intercalate ", " (cr.result <#> _.message)) ]
197 , updateSegments:
198 \update -> do
199 let updated = update segments
200 unless (segments == updated) do updateSegments (const updated)
201 , solvedWith
202 }
204foreign import mdxProvider ∷
205 ∀ r.
206 ReactComponent
207 { components ∷ { | r }
208 , children ∷ ReactChildren MDX
209 }