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