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