mirror of
https://github.com/rowtype-yoga/psfp.git
synced 2024-09-11 16:25:36 +03:00
Ch-ch-changes
This commit is contained in:
parent
64d809485f
commit
21162af38f
@ -1,232 +0,0 @@
|
||||
module FillInTheGaps where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.Array (foldMap, intercalate)
|
||||
import Data.Array as A
|
||||
import Data.Either (Either(..))
|
||||
import Data.Foldable (foldl)
|
||||
import Data.Function.Uncurried (mkFn2)
|
||||
import Data.Lens ((%~))
|
||||
import Data.Lens.Index (ix)
|
||||
import Data.Maybe (Maybe(..), fromMaybe', isJust, isNothing)
|
||||
import Data.Monoid (guard)
|
||||
import Data.String (Pattern(..), split)
|
||||
import Data.String as S
|
||||
import Data.String.Regex (Regex)
|
||||
import Data.String.Regex as Regex
|
||||
import Data.String.Regex.Flags as RegexFlags
|
||||
import Data.String.Regex.Unsafe (unsafeRegex)
|
||||
import Data.Tuple.Nested ((/\))
|
||||
import Debug.Trace (spy)
|
||||
import Effect (Effect)
|
||||
import Effect.Aff (launchAff_)
|
||||
import Effect.Class (liftEffect)
|
||||
import Justifill (justifill)
|
||||
import Milkis as M
|
||||
import Milkis.Impl (FetchImpl)
|
||||
import Partial.Unsafe (unsafeCrashWith)
|
||||
import React.Basic (JSX, ReactComponent, element, fragment)
|
||||
import React.Basic.DOM (css)
|
||||
import React.Basic.DOM as R
|
||||
import React.Basic.DOM.Events (preventDefault)
|
||||
import React.Basic.Events (handler, handler_)
|
||||
import React.Basic.Helpers (jsx)
|
||||
import React.Basic.Hooks (component, useState)
|
||||
import React.Basic.Hooks as React
|
||||
import React.Basic.Hooks.Spring (animatedDiv, useTransition)
|
||||
import Shared.Models.Body (CompileResult, RunResult)
|
||||
import Yoga.Button.Component (ButtonType(..), mkButton)
|
||||
import Yoga.ClickAway.Component as ClickAway
|
||||
import Yoga.CloseIcon.Component as CloseIcon
|
||||
import Yoga.Cluster.Component as Cluster
|
||||
import Yoga.CompileEditor.Component (compileAndRun)
|
||||
import Yoga.Helpers ((?||))
|
||||
import Yoga.InlineCode.Component as InlineCode
|
||||
import Yoga.Modal.Component as Modal
|
||||
|
||||
data Segment
|
||||
= ExpectedResult String
|
||||
| Start
|
||||
| End
|
||||
| Filler String
|
||||
| Hole Int String
|
||||
|
||||
derive instance eqSegment ∷ Eq Segment
|
||||
getResult ∷ Segment -> Maybe String
|
||||
getResult = case _ of
|
||||
ExpectedResult r -> Just r
|
||||
_ -> Nothing
|
||||
|
||||
findResult ∷ Array Segment -> String
|
||||
findResult = fromMaybe' (\_ -> unsafeCrashWith "Even teachers make mistakes") <<< A.findMap getResult
|
||||
|
||||
toCode ∷ (Array (Array Segment)) -> String
|
||||
toCode lines = intercalate "\n" mapped
|
||||
where
|
||||
mapped = lines <#> (intercalate "" <<< map segmentToCode)
|
||||
segmentToCode = case _ of
|
||||
Filler s -> s
|
||||
Hole _ s -> s
|
||||
_ -> ""
|
||||
|
||||
complete ∷ (Array (Array Segment)) -> Boolean
|
||||
complete arr = foldl f true (join arr)
|
||||
where
|
||||
f acc seg =
|
||||
acc
|
||||
&& case seg of
|
||||
Hole _ s -> s /= ""
|
||||
_ -> true
|
||||
|
||||
visibleRange ∷ Array (Array Segment) -> { end ∷ Int, start ∷ Int }
|
||||
visibleRange arr = { start, end }
|
||||
where
|
||||
start = A.findIndex (_ == [ Start ]) arr ?|| 0
|
||||
end = A.findIndex (_ == [ End ]) arr ?|| A.length arr
|
||||
|
||||
renderSegments ∷ ReactComponent InlineCode.Props -> ((Array (Array Segment) -> Array (Array Segment)) -> Effect Unit) -> Array (Array Segment) -> JSX
|
||||
renderSegments ic update arrs = R.div_ (A.mapWithIndex renderLine arrs)
|
||||
where
|
||||
{ start, end } = visibleRange arrs
|
||||
renderLine i l = R.div_ (A.mapWithIndex (renderSegment i) l)
|
||||
renderSegment i j s =
|
||||
if between start end i then case s of
|
||||
Filler s' -> R.code_ [ R.text s' ]
|
||||
Hole width _ ->
|
||||
element ic
|
||||
$ justifill
|
||||
{ width
|
||||
, onSubmit: update <<< updateSegments i j
|
||||
}
|
||||
_ -> mempty
|
||||
else
|
||||
mempty
|
||||
|
||||
updateSegments ∷ Int -> Int -> String -> Array (Array Segment) -> Array (Array Segment)
|
||||
updateSegments i j v = (ix i <<< ix j) %~ f
|
||||
where
|
||||
f = case _ of
|
||||
Hole h _ -> Hole h v
|
||||
_ -> unsafeCrashWith "Updated a non-hole"
|
||||
|
||||
holeRegex ∷ Regex
|
||||
holeRegex = unsafeRegex "({-.*?-})" RegexFlags.global
|
||||
|
||||
resultRegex ∷ Regex
|
||||
resultRegex = unsafeRegex "--result" RegexFlags.global
|
||||
|
||||
startRegex ∷ Regex
|
||||
startRegex = unsafeRegex "--start here" RegexFlags.global
|
||||
|
||||
endRegex ∷ Regex
|
||||
endRegex = unsafeRegex "--end here" RegexFlags.global
|
||||
|
||||
rawSegments ∷ String -> Array String
|
||||
rawSegments = Regex.split holeRegex
|
||||
|
||||
toSegment ∷ String -> Segment
|
||||
toSegment = case _ of
|
||||
x
|
||||
| Regex.test holeRegex x -> Hole (S.length x - 4) ""
|
||||
x
|
||||
| S.indexOf (Pattern "--result ") x == Just 0 -> ExpectedResult ((S.stripPrefix (Pattern "--result ") x) ?|| "")
|
||||
x
|
||||
| Regex.test startRegex x -> Start
|
||||
x
|
||||
| Regex.test endRegex x -> End
|
||||
other -> Filler other
|
||||
|
||||
mkFillInTheGaps ∷ FetchImpl -> Effect (ReactComponent { code ∷ String })
|
||||
mkFillInTheGaps fetch = do
|
||||
ic <- InlineCode.makeComponent
|
||||
modal <- Modal.makeComponent
|
||||
closeIcon <- CloseIcon.makeComponent
|
||||
cluster <- Cluster.makeComponent
|
||||
clickAway <- ClickAway.makeComponent
|
||||
button <- mkButton
|
||||
component "FillInTheGaps" \{ code } -> React.do
|
||||
let
|
||||
lines = split (Pattern "\n") code
|
||||
|
||||
initialSegments = lines <#> \line -> rawSegments line <#> toSegment
|
||||
segments /\ modifySegments <- useState initialSegments
|
||||
result /\ modifyResult <- useState Nothing
|
||||
modalTransitions <-
|
||||
useTransition [ result ] (Just show)
|
||||
$ css
|
||||
{ from: { opacity: 0.0, transform: "translate3d(-50%, -50%, 0) scale3d(0.3, 0.3, 1.0)" }
|
||||
, enter: { opacity: 1.0, transform: "translate3d(-50%, -50%, 0) scale3d(1.0, 1.0, 1.0)" }
|
||||
, leave: { opacity: 0.0, transform: "translate3d(-50%, -50%, 0) scale3d(0.3, 0.3, 1.0)" }
|
||||
, config: mkFn2 \_ state ->
|
||||
case spy "state" state of
|
||||
"leave" -> { mass: 1.0, tension: 140, friction: 15 }
|
||||
_ -> { mass: 1.0, tension: 170, friction: 20 }
|
||||
}
|
||||
clickAwayTransitions <-
|
||||
useTransition [ result ] (Just show)
|
||||
$ css
|
||||
{ from: { opacity: 0.0 }
|
||||
, enter: { opacity: 1.0 }
|
||||
, leave: { opacity: 0.0 }
|
||||
, config: mkFn2 \_ state ->
|
||||
case spy "state" state of
|
||||
"leave" -> { mass: 1.0, tension: 140, friction: 15 }
|
||||
_ -> { mass: 1.0, tension: 170, friction: 20 }
|
||||
}
|
||||
let
|
||||
expectedResult = findResult (join segments)
|
||||
|
||||
onClick =
|
||||
launchAff_ do
|
||||
do
|
||||
res <- compileAndRun (M.fetch fetch) { code: toCode segments }
|
||||
modifyResult (const (Just $ res)) # liftEffect
|
||||
pure
|
||||
$ fragment
|
||||
$ [ renderSegments ic (modifySegments) segments
|
||||
, jsx cluster {}
|
||||
[ R.div_
|
||||
[ jsx button
|
||||
{ onClick: handler_ onClick
|
||||
, buttonType:
|
||||
if complete segments && isNothing result then
|
||||
HighlightedButton
|
||||
else
|
||||
DisabledButton
|
||||
}
|
||||
[ R.text "Try it" ]
|
||||
]
|
||||
]
|
||||
, fragment
|
||||
$ clickAwayTransitions
|
||||
>>= \{ item, key, props } ->
|
||||
guard (isJust item)
|
||||
$ join item
|
||||
# foldMap \_ ->
|
||||
[element clickAway (justifill { allowEscape: true, style: props, onClick: modifyResult (const Nothing) })]
|
||||
, fragment
|
||||
$ modalTransitions
|
||||
>>= \{ item, key, props } ->
|
||||
guard (isJust item)
|
||||
$ join item
|
||||
# foldMap \r ->
|
||||
[ jsx modal
|
||||
{ title:
|
||||
case r of
|
||||
(Right { stdout })
|
||||
| S.stripSuffix (S.Pattern "\n") stdout == Just expectedResult -> "Hooray!"
|
||||
(Left l) -> "Does not compile"
|
||||
(Right _) -> "Not " <> (findResult $ join segments)
|
||||
, icon: element closeIcon { onClick: modifyResult (const Nothing), style: Nothing }
|
||||
, style: props
|
||||
}
|
||||
[ R.text $ compileResultToString result ]
|
||||
]
|
||||
]
|
||||
|
||||
compileResultToString ∷ Maybe (Either CompileResult RunResult) -> String
|
||||
compileResultToString = case _ of
|
||||
Nothing -> ""
|
||||
Just (Left cr) -> cr.result <#> _.message # intercalate "/n"
|
||||
Just (Right r) -> r.stdout
|
@ -1,17 +1,14 @@
|
||||
module PSLayout where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Color (toHexString)
|
||||
import Data.Array as Array
|
||||
import Data.Array.NonEmpty as NEA
|
||||
import Data.Maybe (Maybe(..), fromMaybe)
|
||||
import Data.Nullable (Nullable)
|
||||
import Data.Nullable as Nullable
|
||||
import Data.Semigroup.Foldable (intercalateMap)
|
||||
import Data.String as String
|
||||
import Effect (Effect)
|
||||
import FillInTheGaps (mkFillInTheGaps)
|
||||
import Effect.Unsafe (unsafePerformEffect)
|
||||
import JSS (jss, jssClasses)
|
||||
import Justifill (justifill)
|
||||
import Milkis.Impl (FetchImpl)
|
||||
@ -19,10 +16,12 @@ import React.Basic (JSX, ReactComponent)
|
||||
import React.Basic.DOM (unsafeCreateDOMComponent)
|
||||
import React.Basic.DOM as R
|
||||
import React.Basic.Helpers (jsx)
|
||||
import React.Basic.Hooks (ReactChildren, component, componentWithChildren, element, reactChildrenToArray)
|
||||
import React.Basic.Hooks (ReactChildren, component, componentWithChildren, element, reactChildrenToArray, useState)
|
||||
import React.Basic.Hooks as React
|
||||
import Yoga.Box.Component as Box
|
||||
import Yoga.CompileEditor.Component (mkCompileEditor)
|
||||
import Yoga.Compiler.Api (apiCompiler)
|
||||
import Yoga.FillInTheGaps.Component as FillInTheGaps
|
||||
import Yoga.Header.Component (mkHeader)
|
||||
import Yoga.InlineCode.Component as InlineCode
|
||||
import Yoga.Theme (fromTheme)
|
||||
@ -79,6 +78,15 @@ mkLayout fetchImpl = do
|
||||
]
|
||||
}
|
||||
|
||||
mkSecret :: Effect ( ReactComponent { kids ∷ Array JSX , visible ∷ Boolean })
|
||||
mkSecret = do
|
||||
component "Secret" \{ kids, visible } -> React.do
|
||||
pure
|
||||
$ R.div
|
||||
{ style: R.css { visibility: if visible then "visible" else "hidden" }
|
||||
, children: kids
|
||||
}
|
||||
|
||||
mkMdxProviderComponent ∷
|
||||
FetchImpl ->
|
||||
Effect
|
||||
@ -90,31 +98,33 @@ mkMdxProviderComponent ∷
|
||||
mkMdxProviderComponent fetchImpl = do
|
||||
cssBaseline <- mkCssBaseline
|
||||
editor <- mkCompileEditor fetchImpl
|
||||
fillInTheGaps <- mkFillInTheGaps fetchImpl
|
||||
fillInTheGaps <- FillInTheGaps.makeComponent (apiCompiler fetchImpl)
|
||||
box <- Box.makeComponent
|
||||
sidebar <- mkSidebar
|
||||
header <- mkHeader
|
||||
yogaInlineCode <- InlineCode.makeComponent
|
||||
h <- mkH
|
||||
p <- mkP
|
||||
secret <- mkSecret
|
||||
useStyles <-
|
||||
makeStylesJSS
|
||||
$ jssClasses \(theme ∷ CSSTheme) ->
|
||||
{ code:
|
||||
{ fontFamily: theme.codeFontFamily # NEA.head
|
||||
, backgroundColor: theme.interfaceColour
|
||||
, fontSize: "10pt"
|
||||
, border: "1px solid #383c39"
|
||||
, padding: "3px"
|
||||
, borderRadius: "3px"
|
||||
}
|
||||
{ fontFamily: theme.codeFontFamily # NEA.head
|
||||
, backgroundColor: theme.interfaceColour
|
||||
, fontSize: "10pt"
|
||||
, border: "1px solid #383c39"
|
||||
, padding: "3px"
|
||||
, borderRadius: "3px"
|
||||
}
|
||||
, flexer:
|
||||
{ display: "flex"
|
||||
, flexDirection: "row"
|
||||
}
|
||||
{ display: "flex"
|
||||
, flexDirection: "row"
|
||||
}
|
||||
}
|
||||
componentWithChildren "MDXProviderComponent" \{ children, siteInfo } -> React.do
|
||||
classes <- useStyles {}
|
||||
sections <- useState []
|
||||
let
|
||||
baseline child = element cssBaseline { kids: child }
|
||||
|
||||
@ -136,12 +146,14 @@ mkMdxProviderComponent fetchImpl = do
|
||||
element h { level: H3, text: props.children, className: Nothing }
|
||||
, h3:
|
||||
\props ->
|
||||
element h { level: H4, text: props.children , className: Nothing}
|
||||
element h { level: H4, text: props.children, className: Nothing }
|
||||
, p:
|
||||
\props ->
|
||||
R.div
|
||||
{ children: [ element p { text: props.children } ]
|
||||
}
|
||||
, thematicBreak:
|
||||
\props -> R.div_ [ R.text "HOUI" ]
|
||||
, inlineCode:
|
||||
\props -> do
|
||||
R.span { className: classes.code, children: props.children }
|
||||
@ -173,8 +185,7 @@ mkMdxProviderComponent fetchImpl = do
|
||||
|
||||
language = fromMaybe "" (classNameQ >>= String.stripPrefix (String.Pattern "language-"))
|
||||
case isCode, language of
|
||||
true, "puregaps" ->
|
||||
element fillInTheGaps { code: fromMaybe "" codeQ}
|
||||
true, "puregaps" -> element fillInTheGaps { code: fromMaybe "" codeQ }
|
||||
true, _ ->
|
||||
element editor
|
||||
{ initialCode: fromMaybe "" codeQ
|
||||
|
@ -6,15 +6,17 @@ import SEO from '../components/seo'
|
||||
# Optional
|
||||
|
||||
```puregaps
|
||||
--result Hello World
|
||||
--result Apero
|
||||
module Main where
|
||||
import Batteries
|
||||
import Grimoire
|
||||
|
||||
main :: Effect Unit
|
||||
main = log $
|
||||
incantation :: Effect Unit
|
||||
--start here
|
||||
incantation = cast $
|
||||
"{-Hello-}" <> " " <> "{-World-}"
|
||||
--end here
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
## Hans Hölzel
|
@ -18,7 +18,7 @@ import React.Basic (ReactComponent)
|
||||
import React.Basic.DOM as R
|
||||
import React.Basic.Events (handler_)
|
||||
import React.Basic.Helpers (jsx)
|
||||
import React.Basic.Hooks (component, element, fragment, useState)
|
||||
import React.Basic.Hooks (component, element, useState)
|
||||
import React.Basic.Hooks as React
|
||||
import Shared.Json (readAff)
|
||||
import Shared.Models.Body as Body
|
||||
|
@ -5,16 +5,18 @@ import Data.Either (Either(..))
|
||||
import Data.Maybe (Maybe(..))
|
||||
import Effect.Aff (Aff, attempt, error, message, throwError)
|
||||
import Milkis as M
|
||||
import Milkis.Impl (FetchImpl)
|
||||
import Shared.Json (readAff)
|
||||
import Shared.Models.Body as Body
|
||||
import Simple.JSON (writeJSON)
|
||||
import Yoga.Compiler.Types (Compiler)
|
||||
|
||||
apiCompiler ∷ M.Fetch -> { | Compiler () }
|
||||
apiCompiler fetch =
|
||||
apiCompiler ∷ FetchImpl -> { | Compiler () }
|
||||
apiCompiler fetchImpl =
|
||||
{ compileAndRun
|
||||
}
|
||||
where
|
||||
fetch = M.fetch fetchImpl
|
||||
compileAndRun ∷ Body.CompileRequest -> Aff (Either Body.CompileResult Body.RunResult)
|
||||
compileAndRun body = do
|
||||
response <-
|
||||
|
@ -214,7 +214,7 @@ makeComponent { compileAndRun } = do
|
||||
else
|
||||
DisabledButton
|
||||
}
|
||||
[ R.text "Try it" ]
|
||||
[ R.text "Incantate" ]
|
||||
]
|
||||
]
|
||||
, fragment
|
||||
|
@ -31,11 +31,11 @@ codeWithHoles =
|
||||
"""
|
||||
--result Hello World
|
||||
module Main where
|
||||
import Batteries
|
||||
import Grimoire
|
||||
|
||||
main :: Effect Unit
|
||||
--start here
|
||||
main = log
|
||||
main = cast
|
||||
"{-Hello World-}"
|
||||
--end here
|
||||
"""
|
||||
|
@ -1 +1 @@
|
||||
require ("./output/Main").main()
|
||||
require ("./output/Main").incantation()
|
||||
|
@ -1,5 +1,5 @@
|
||||
module Batteries
|
||||
( module Batteries
|
||||
module Grimoire
|
||||
( module Grimoire
|
||||
, module Control.Alt
|
||||
, module Control.Alternative
|
||||
, module Control.Apply
|
||||
@ -8,7 +8,6 @@ module Batteries
|
||||
, module Effect.Aff
|
||||
, module Effect
|
||||
, module Effect.Class
|
||||
, module Effect.Console
|
||||
, module Control.Monad.Cont.Class
|
||||
, module Control.Monad.Cont.Trans
|
||||
, module Control.Monad.Error.Class
|
||||
@ -1073,3 +1072,9 @@ import Type.Proxy
|
||||
import Unsafe.Coerce
|
||||
( unsafeCoerce
|
||||
)
|
||||
|
||||
cast :: String -> Effect Unit
|
||||
cast = log
|
||||
|
||||
summon :: forall a. Show a => a -> Effect Unit
|
||||
summon = logShow
|
@ -1,6 +1,6 @@
|
||||
module Main where
|
||||
|
||||
import Batteries
|
||||
import Grimoire
|
||||
|
||||
main :: Effect Unit
|
||||
main = log "Hello, World!"
|
||||
incantation :: Effect Unit
|
||||
incantation = cast "Abracadabra"
|
||||
|
@ -54,8 +54,6 @@ startIdeServer ∷ Folder -> Int -> Aff ChildProcess
|
||||
startIdeServer folder port = do
|
||||
log $ "Spawning ide server" <> infoString
|
||||
cp <- spawnProcess folder "npx" [ "purs", "ide", "server", "-p", show port, "--editor-mode", "--no-watch" ]
|
||||
-- liftEffect $ onDataString (CP.stdout cp) UTF8 \str -> do
|
||||
-- log $ "--------" <> infoString <> "\n----------\n" <> str <> "\n----------\n"
|
||||
log $ "Spawned ide server" <> infoString
|
||||
-- building once
|
||||
{ error, stderr, stdout } <- execCommand folder "npx spago build"
|
||||
|
Loading…
Reference in New Issue
Block a user