git.iko.soy/rowtype-yoga/psfp
on 0c34f9c help sign in
rowtype-yoga/psfp/blog/src/components/FillInTheGaps.purs
182 lines 5.7 kB history raw
1module FillInTheGaps where
3import Prelude
4import Data.Array (foldMap, intercalate)
5import Data.Array as A
6import Data.Either (Either(..))
7import Data.Foldable (foldl, for_)
8import Data.Lens (over, (%~))
9import Data.Lens.Index (ix)
10import Data.Maybe (Maybe(..), fromMaybe, fromMaybe')
11import Data.Monoid (guard)
12import Data.String (Pattern(..), split)
13import Data.String as S
14import Data.String.Regex (Regex)
15import Data.String.Regex as Regex
16import Data.String.Regex.Flags as RegexFlags
17import Data.String.Regex.Unsafe (unsafeRegex)
18import Data.Tuple.Nested ((/\))
19import Debug.Trace (spy)
20import Effect (Effect)
21import Effect.Aff (launchAff_)
22import Effect.Class (liftEffect)
23import Justifill (justifill)
24import Milkis as M
25import Milkis.Impl (FetchImpl)
26import Milkis.Impl.Window (windowFetch)
27import Partial.Unsafe (unsafeCrashWith)
28import React.Basic (JSX, ReactComponent, element, fragment)
29import React.Basic.DOM (form_)
30import React.Basic.DOM as R
31import React.Basic.Events (handler_)
32import React.Basic.Helpers (jsx)
33import React.Basic.Hooks (component, useEffect, useState)
34import React.Basic.Hooks as React
35import React.Basic.Hooks.Aff (useAff)
36import Yoga.Button.Component (ButtonType(..), mkButton)
37import Yoga.CompileEditor.Component (compileAndRun)
38import Yoga.Helpers ((?||))
39import Yoga.InlineCode.Component as InlineCode
40import Yoga.Modal.Component as Modal
42data Segment
43 = ExpectedResult String
44 | Start
45 | End
46 | Filler String
47 | Hole Int String
49derive instance eqSegment ∷ Eq Segment
50getResult ∷ Segment -> Maybe String
51getResult = case _ of
52 ExpectedResult r -> Just r
53 _ -> Nothing
55findResult ∷ Array Segment -> String
56findResult = fromMaybe' (\_ -> unsafeCrashWith "Even teachers make mistakes") <<< A.findMap getResult
58toCode ∷ (Array (Array Segment)) -> String
59toCode lines = intercalate "\n" mapped
60 where
61 mapped = lines <#> (intercalate "" <<< map segmentToCode)
62 segmentToCode = case _ of
63 Filler s -> s
64 Hole _ s -> s
65 _ -> ""
67complete ∷ (Array (Array Segment)) -> Boolean
68complete arr = foldl f true (join arr)
69 where
70 f acc seg =
71 acc
72 && case seg of
73 Hole _ s -> s /= ""
74 _ -> true
76visibleRange ∷ Array (Array Segment) -> { end ∷ Int, start ∷ Int }
77visibleRange arr = { start, end }
78 where
79 start = A.findIndex (_ == [ Start ]) arr ?|| 0
80 end = A.findIndex (_ == [ End ]) arr ?|| A.length arr
82renderSegments ∷ ReactComponent InlineCode.Props -> ((Array (Array Segment) -> Array (Array Segment)) -> Effect Unit) -> Array (Array Segment) -> JSX
83renderSegments ic update arrs = R.div_ (A.mapWithIndex renderLine arrs)
84 where
85 { start, end } = visibleRange arrs
86 renderLine i l = R.div_ (A.mapWithIndex (renderSegment i) l)
87 renderSegment i j s =
88 if between start end i then case s of
89 Filler s' -> R.code_ [ R.text s' ]
90 Hole width _ ->
91 element ic
92 $ justifill
93 { width
94 , onSubmit: update <<< updateSegments i j
95 }
96 _ -> mempty
97 else
98 mempty
100updateSegments ∷ Int -> Int -> String -> Array (Array Segment) -> Array (Array Segment)
101updateSegments i j v = (ix (spy "i" i) <<< ix (spy "j" j)) %~ f
102 where
103 f = case _ of
104 Hole h _ -> Hole h v
105 _ -> unsafeCrashWith "Updated a non-hole"
107holeRegex ∷ Regex
108holeRegex = unsafeRegex "({-.*?-})" RegexFlags.global
110resultRegex ∷ Regex
111resultRegex = unsafeRegex "--result" RegexFlags.global
113startRegex ∷ Regex
114startRegex = unsafeRegex "--start here" RegexFlags.global
116endRegex ∷ Regex
117endRegex = unsafeRegex "--end here" RegexFlags.global
119rawSegments ∷ String -> Array String
120rawSegments = Regex.split holeRegex
122toSegment ∷ String -> Segment
123toSegment = case _ of
124 x
125 | Regex.test holeRegex x -> Hole (S.length x - 4) ""
126 x
127 | S.indexOf (Pattern "--result ") x == Just 0 -> ExpectedResult ((S.stripPrefix (Pattern "--result ") x) ?|| "")
128 x
129 | Regex.test startRegex x -> Start
130 x
131 | Regex.test endRegex x -> End
132 other -> Filler other
134mkFillInTheGaps ∷ FetchImpl -> Effect (ReactComponent { code ∷ String })
135mkFillInTheGaps fetch = do
136 ic <- InlineCode.makeComponent
137 modal <- Modal.makeComponent
138 button <- mkButton
139 component "FillInTheGaps" \{ code } -> React.do
140 let
141 lines = split (Pattern "\n") code
143 initialSegments = lines <#> \line -> rawSegments line <#> toSegment
144 segments /\ modifySegments <- useState initialSegments
145 result /\ modifyResult <- useState Nothing
146 let
147 expectedResult = findResult (join segments)
149 onClick =
150 launchAff_ do
151 do
152 res <- compileAndRun (M.fetch fetch) { code: toCode segments }
153 modifyResult (const (Just $ res)) # liftEffect
154 pure
155 $ fragment
156 [ renderSegments ic (modifySegments) segments
157 , jsx button
158 { onClick: handler_ onClick
159 , buttonType:
160 if complete (spy "segsm" segments) then
161 HighlightedButton
162 else
163 HighlightedButton
164 }
165 [ R.text "Try it" ]
166 , result
167 # foldMap \r ->
168 jsx modal
169 { title:
170 case r of
171 Right { stdout }
172 | stdout == expectedResult -> "Hooray!"
173 Left l -> "Does not compile"
174 Right _ -> "Not " <> (findResult (spy "segs" $ join segments))
175 }
176 [ R.text $ compileResultToString result ]
177 ]
179compileResultToString = case _ of
180 Nothing -> ""
181 Just (Left cr) -> cr.result <#> _.message # intercalate "/n"
182 Just (Right r) -> r.stdout