@@ -1,52 +1,171 @@
11module FillInTheGaps where
22
33import Prelude
4−
4+import Data.Array (foldMap, intercalate)
55import Data.Array as A
6−import Data.Maybe (fromMaybe)
6+import Data.Either (Either(..))
7+import Data.Foldable (foldl, for_)
8+import Data.Maybe (Maybe(..), fromMaybe, fromMaybe')
9+import Data.Monoid (guard)
710import Data.String (Pattern(..), split)
11+import Data.String as S
12+import Data.String.Regex (Regex)
13+import Data.String.Regex as Regex
14+import Data.String.Regex.Flags as RegexFlags
15+import Data.String.Regex.Unsafe (unsafeRegex)
816import Data.Tuple.Nested ((/\))
917import Effect (Effect)
18+import Effect.Aff (launchAff_)
19+import Effect.Class (liftEffect)
1020import Justifill (justifill)
21+import Milkis as M
22+import Milkis.Impl (FetchImpl)
23+import Milkis.Impl.Window (windowFetch)
1124import Partial.Unsafe (unsafeCrashWith)
12−import React.Basic (JSX, ReactComponent, element)
25+import React.Basic (JSX, ReactComponent, element, fragment)
26+import React.Basic.DOM (form_)
1327import React.Basic.DOM as R
14−import React.Basic.Hooks (component, useState)
28+import React.Basic.Events (handler_)
29+import React.Basic.Helpers (jsx)
30+import React.Basic.Hooks (component, useEffect, useState)
1531import React.Basic.Hooks as React
16−import Yoga.Helpers (intersperse)
32+import React.Basic.Hooks.Aff (useAff)
33+import Yoga.Button.Component (ButtonType(..), mkButton)
34+import Yoga.CompileEditor.Component (compileAndRun)
35+import Yoga.Helpers ((?||))
1736import Yoga.InlineCode.Component as InlineCode
37+import Yoga.Modal.Component as Modal
38+
39+data Segment
40+ = ExpectedResult String
41+ | Start
42+ | End
43+ | Filler String
44+ | Hole Int String
45+
46+derive instance eqSegment ∷ Eq Segment
47+getResult ∷ Segment -> Maybe String
48+getResult = case _ of
49+ ExpectedResult r -> Just r
50+ _ -> Nothing
1851
19−data Segment = Filler String | Hole String
52+findResult ∷ Array Segment -> String
53+findResult = fromMaybe' (\_ -> unsafeCrashWith "Even teachers make mistakes") <<< A.findMap getResult
54+
55+toCode ∷ (Array (Array Segment)) -> String
56+toCode 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+ _ -> ""
2063
21−renderSegments :: ReactComponent InlineCode.Props -> ((Array (Array Segment) -> Array (Array Segment)) -> Effect Unit) -> Array (Array Segment) -> JSX
22−renderSegments ic update arrs = R.div_ (arrs `flip A.mapWithIndex` renderLine)
64+complete ∷ (Array (Array Segment)) -> Boolean
65+complete arr = foldl f true (join arr)
2366 where
24− renderLine i l = R.div_ (l `flip A.mapWithIndex` renderSegment i)
67+ f acc seg =
68+ acc
69+ && case seg of
70+ Hole _ s -> s /= ""
71+ _ -> true
72+
73+renderSegments ∷ ReactComponent InlineCode.Props -> ((Array (Array Segment) -> Array (Array Segment)) -> Effect Unit) -> Array (Array Segment) -> JSX
74+renderSegments 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)
2581 renderSegment i j = case _ of
26− Filler s -> R.span_ [R.text s]
27− Hole _ -> element ic $ justifill { onSubmit: \s -> update (updateSegments i j s) }
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
2885
29−updateSegments :: Int -> Int -> String -> Array (Array Segment) -> Array (Array Segment)
86+updateSegments ∷ Int -> Int -> String -> Array (Array Segment) -> Array (Array Segment)
3087updateSegments i j v arrs = fromMaybe [] (A.modifyAt i (updateLine j v) arrs)
3188
32−updateLine :: Int -> String -> Array Segment -> Array Segment
89+updateLine ∷ Int -> String -> Array Segment -> Array Segment
3390updateLine idx v arr = fromMaybe [] (A.modifyAt idx f arr)
3491 where
3592 f = case _ of
36− Filler s -> unsafeCrashWith "Updated a filler"
37− Hole _ -> Hole v
38−
39−mkFillInTheGaps :: Effect (ReactComponent { code :: String })
40−mkFillInTheGaps = do
93+ Hole h _ -> Hole h v
94+ _ -> unsafeCrashWith "Updated a non-hole"
95+
96+holeRegex ∷ Regex
97+holeRegex = unsafeRegex "({-.*?-})" RegexFlags.global
98+
99+resultRegex ∷ Regex
100+resultRegex = unsafeRegex "--result" RegexFlags.global
101+
102+startRegex ∷ Regex
103+startRegex = unsafeRegex "--start here" RegexFlags.global
104+
105+endRegex ∷ Regex
106+endRegex = unsafeRegex "--end here" RegexFlags.global
107+
108+rawSegments ∷ String -> Array String
109+rawSegments = Regex.split holeRegex
110+
111+toSegment ∷ String -> Segment
112+toSegment = 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
122+
123+mkFillInTheGaps ∷ FetchImpl -> Effect (ReactComponent { code ∷ String })
124+mkFillInTheGaps fetch = do
41125 ic <- InlineCode.makeComponent
42− component "FillInTheGaps" \{ code } -> React.do
43− let
44− separator = "???"
126+ modal <- Modal.makeComponent
127+ button <- mkButton
128+ component "FillInTheGaps" \{ code } -> React.do
129+ let
45130 lines = split (Pattern "\n") code
46− rawSegments = split (Pattern separator) >>> intersperse separator
47− toSegment = case _ of
48− x | x == separator -> Hole ""
49− other -> Filler other
131+
50132 initialSegments = lines <#> \line -> rawSegments line <#> toSegment
51133 segments /\ modifySegments <- useState initialSegments
52− pure $ renderSegments ic (modifySegments) segments
134+ result /\ modifyResult <- useState Nothing
135+ let
136+ expectedResult = findResult (join segments)
137+
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+ ]
167+
168+compileResultToString = case _ of
169+ Nothing -> ""
170+ Just (Left cr) -> cr.result <#> _.message # intercalate "/n"
171+ Just (Right r) -> r.stdout