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