git.iko.soy/rowtype-yoga/psfp
on 64d8094 help sign in
rowtype-yoga/psfp/blog/src/components/FillInTheGaps.purs
232 lines 8.0 kB history raw
1module FillInTheGaps where
3import Prelude
5import Data.Array (foldMap, intercalate)
6import Data.Array as A
7import Data.Either (Either(..))
8import Data.Foldable (foldl)
9import Data.Function.Uncurried (mkFn2)
10import Data.Lens ((%~))
11import Data.Lens.Index (ix)
12import Data.Maybe (Maybe(..), fromMaybe', isJust, isNothing)
13import Data.Monoid (guard)
14import Data.String (Pattern(..), split)
15import Data.String as S
16import Data.String.Regex (Regex)
17import Data.String.Regex as Regex
18import Data.String.Regex.Flags as RegexFlags
19import Data.String.Regex.Unsafe (unsafeRegex)
20import Data.Tuple.Nested ((/\))
21import Debug.Trace (spy)
22import Effect (Effect)
23import Effect.Aff (launchAff_)
24import Effect.Class (liftEffect)
25import Justifill (justifill)
26import Milkis as M
27import Milkis.Impl (FetchImpl)
28import Partial.Unsafe (unsafeCrashWith)
29import React.Basic (JSX, ReactComponent, element, fragment)
30import React.Basic.DOM (css)
31import React.Basic.DOM as R
32import React.Basic.DOM.Events (preventDefault)
33import React.Basic.Events (handler, handler_)
34import React.Basic.Helpers (jsx)
35import React.Basic.Hooks (component, useState)
36import React.Basic.Hooks as React
37import React.Basic.Hooks.Spring (animatedDiv, useTransition)
38import Shared.Models.Body (CompileResult, RunResult)
39import Yoga.Button.Component (ButtonType(..), mkButton)
40import Yoga.ClickAway.Component as ClickAway
41import Yoga.CloseIcon.Component as CloseIcon
42import Yoga.Cluster.Component as Cluster
43import Yoga.CompileEditor.Component (compileAndRun)
44import Yoga.Helpers ((?||))
45import Yoga.InlineCode.Component as InlineCode
46import Yoga.Modal.Component as Modal
48data Segment
49 = ExpectedResult String
50 | Start
51 | End
52 | Filler String
53 | Hole Int String
55derive instance eqSegment ∷ Eq Segment
56getResult ∷ Segment -> Maybe String
57getResult = case _ of
58 ExpectedResult r -> Just r
59 _ -> Nothing
61findResult ∷ Array Segment -> String
62findResult = fromMaybe' (\_ -> unsafeCrashWith "Even teachers make mistakes") <<< A.findMap getResult
64toCode ∷ (Array (Array Segment)) -> String
65toCode lines = intercalate "\n" mapped
66 where
67 mapped = lines <#> (intercalate "" <<< map segmentToCode)
68 segmentToCode = case _ of
69 Filler s -> s
70 Hole _ s -> s
71 _ -> ""
73complete ∷ (Array (Array Segment)) -> Boolean
74complete arr = foldl f true (join arr)
75 where
76 f acc seg =
77 acc
78 && case seg of
79 Hole _ s -> s /= ""
80 _ -> true
82visibleRange ∷ Array (Array Segment) -> { end ∷ Int, start ∷ Int }
83visibleRange arr = { start, end }
84 where
85 start = A.findIndex (_ == [ Start ]) arr ?|| 0
86 end = A.findIndex (_ == [ End ]) arr ?|| A.length arr
88renderSegments ∷ ReactComponent InlineCode.Props -> ((Array (Array Segment) -> Array (Array Segment)) -> Effect Unit) -> Array (Array Segment) -> JSX
89renderSegments ic update arrs = R.div_ (A.mapWithIndex renderLine arrs)
90 where
91 { start, end } = visibleRange arrs
92 renderLine i l = R.div_ (A.mapWithIndex (renderSegment i) l)
93 renderSegment i j s =
94 if between start end i then case s of
95 Filler s' -> R.code_ [ R.text s' ]
96 Hole width _ ->
97 element ic
98 $ justifill
99 { width
100 , onSubmit: update <<< updateSegments i j
101 }
102 _ -> mempty
103 else
104 mempty
106updateSegments ∷ Int -> Int -> String -> Array (Array Segment) -> Array (Array Segment)
107updateSegments i j v = (ix i <<< ix j) %~ f
108 where
109 f = case _ of
110 Hole h _ -> Hole h v
111 _ -> unsafeCrashWith "Updated a non-hole"
113holeRegex ∷ Regex
114holeRegex = unsafeRegex "({-.*?-})" RegexFlags.global
116resultRegex ∷ Regex
117resultRegex = unsafeRegex "--result" RegexFlags.global
119startRegex ∷ Regex
120startRegex = unsafeRegex "--start here" RegexFlags.global
122endRegex ∷ Regex
123endRegex = unsafeRegex "--end here" RegexFlags.global
125rawSegments ∷ String -> Array String
126rawSegments = Regex.split holeRegex
128toSegment ∷ String -> Segment
129toSegment = case _ of
130 x
131 | Regex.test holeRegex x -> Hole (S.length x - 4) ""
132 x
133 | S.indexOf (Pattern "--result ") x == Just 0 -> ExpectedResult ((S.stripPrefix (Pattern "--result ") x) ?|| "")
134 x
135 | Regex.test startRegex x -> Start
136 x
137 | Regex.test endRegex x -> End
138 other -> Filler other
140mkFillInTheGaps ∷ FetchImpl -> Effect (ReactComponent { code ∷ String })
141mkFillInTheGaps fetch = do
142 ic <- InlineCode.makeComponent
143 modal <- Modal.makeComponent
144 closeIcon <- CloseIcon.makeComponent
145 cluster <- Cluster.makeComponent
146 clickAway <- ClickAway.makeComponent
147 button <- mkButton
148 component "FillInTheGaps" \{ code } -> React.do
149 let
150 lines = split (Pattern "\n") code
152 initialSegments = lines <#> \line -> rawSegments line <#> toSegment
153 segments /\ modifySegments <- useState initialSegments
154 result /\ modifyResult <- useState Nothing
155 modalTransitions <-
156 useTransition [ result ] (Just show)
157 $ css
158 { from: { opacity: 0.0, transform: "translate3d(-50%, -50%, 0) scale3d(0.3, 0.3, 1.0)" }
159 , enter: { opacity: 1.0, transform: "translate3d(-50%, -50%, 0) scale3d(1.0, 1.0, 1.0)" }
160 , leave: { opacity: 0.0, transform: "translate3d(-50%, -50%, 0) scale3d(0.3, 0.3, 1.0)" }
161 , config: mkFn2 \_ state ->
162 case spy "state" state of
163 "leave" -> { mass: 1.0, tension: 140, friction: 15 }
164 _ -> { mass: 1.0, tension: 170, friction: 20 }
165 }
166 clickAwayTransitions <-
167 useTransition [ result ] (Just show)
168 $ css
169 { from: { opacity: 0.0 }
170 , enter: { opacity: 1.0 }
171 , leave: { opacity: 0.0 }
172 , config: mkFn2 \_ state ->
173 case spy "state" state of
174 "leave" -> { mass: 1.0, tension: 140, friction: 15 }
175 _ -> { mass: 1.0, tension: 170, friction: 20 }
176 }
177 let
178 expectedResult = findResult (join segments)
180 onClick =
181 launchAff_ do
182 do
183 res <- compileAndRun (M.fetch fetch) { code: toCode segments }
184 modifyResult (const (Just $ res)) # liftEffect
185 pure
186 $ fragment
187 $ [ renderSegments ic (modifySegments) segments
188 , jsx cluster {}
189 [ R.div_
190 [ jsx button
191 { onClick: handler_ onClick
192 , buttonType:
193 if complete segments && isNothing result then
194 HighlightedButton
195 else
196 DisabledButton
197 }
198 [ R.text "Try it" ]
199 ]
200 ]
201 , fragment
202 $ clickAwayTransitions
203 >>= \{ item, key, props } ->
204 guard (isJust item)
205 $ join item
206 # foldMap \_ ->
207 [element clickAway (justifill { allowEscape: true, style: props, onClick: modifyResult (const Nothing) })]
208 , fragment
209 $ modalTransitions
210 >>= \{ item, key, props } ->
211 guard (isJust item)
212 $ join item
213 # foldMap \r ->
214 [ jsx modal
215 { title:
216 case r of
217 (Right { stdout })
218 | S.stripSuffix (S.Pattern "\n") stdout == Just expectedResult -> "Hooray!"
219 (Left l) -> "Does not compile"
220 (Right _) -> "Not " <> (findResult $ join segments)
221 , icon: element closeIcon { onClick: modifyResult (const Nothing), style: Nothing }
222 , style: props
223 }
224 [ R.text $ compileResultToString result ]
225 ]
226 ]
228compileResultToString ∷ Maybe (Either CompileResult RunResult) -> String
229compileResultToString = case _ of
230 Nothing -> ""
231 Just (Left cr) -> cr.result <#> _.message # intercalate "/n"
232 Just (Right r) -> r.stdout