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