Skip to content

Commit

Permalink
Support GHCi style multiline input in the repl
Browse files Browse the repository at this point in the history
  • Loading branch information
HuwCampbell committed Jul 13, 2024
1 parent 8658ae7 commit 80785d5
Show file tree
Hide file tree
Showing 7 changed files with 70 additions and 23 deletions.
40 changes: 37 additions & 3 deletions icicle-compiler/src/Icicle/Repl/Monad.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DoAndIfThenElse #-}
module Icicle.Repl.Monad (
Repl(..)
, runRepl
Expand All @@ -17,9 +18,10 @@ import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.State (MonadState(..))
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (MaybeT (..))
import Control.Monad.Trans.State.Strict (StateT, evalStateT)

import Data.List (dropWhileEnd)
import Data.List (dropWhileEnd, unlines)
import Data.String (String)

import Icicle.Repl.Completion
Expand Down Expand Up @@ -72,18 +74,50 @@ getPrompt = do
use <- getUseColor
pure $ sgrColor use Dull Yellow "λ "


getMultilinePrompt :: Repl String
getMultilinePrompt = do
use <- getUseColor
pure $ sgrColor use Dull Yellow "| "


withUserInput :: (String -> Repl ()) -> Repl ()
withUserInput onInput =
Haskeline.handleInterrupt (withUserInput onInput) $ do
prompt <- getPrompt
minput <- Repl $ Haskeline.getInputLine prompt
minput <- top (Repl (Haskeline.getInputLine prompt))
case minput of
Nothing ->
pure ()
Just input
| let trimmed = dropWhileEnd (== ' ') input
| let trimmed = trim input
, trimmed == ":quit" || trimmed == ":q"
-> pure ()
| otherwise
-> do onInput input
withUserInput onInput

where
trim =
dropWhileEnd (== ' ')

top q = runMaybeT $ do
l <- MaybeT q
if trim l == ":{" then
multiLineCmd q
else
return l

multiLineCmd q = do
collectCommand q []

getMoreInput = do
prompt <- getMultilinePrompt
Repl (Haskeline.getInputLine prompt)

collectCommand q c = do
l <- MaybeT getMoreInput
if trim l == ":}" then
return $ unlines (reverse c)
else
collectCommand q (l : c)
2 changes: 1 addition & 1 deletion icicle-compiler/src/Icicle/Repl/Parser.hs
Original file line number Diff line number Diff line change
Expand Up @@ -156,7 +156,7 @@ pLoad = do

pQuery :: Parser Command
pQuery =
CommandQuery <$> Mega.someTill Mega.anySingle Mega.eol
CommandQuery <$> Mega.some Mega.anySingle

pLet :: Parser Command
pLet = do
Expand Down
6 changes: 3 additions & 3 deletions icicle-compiler/test/cli/repl/t20-lexer/expected
Original file line number Diff line number Diff line change
Expand Up @@ -73,10 +73,10 @@ Error

## Parse error

1:23:
2:1:
|
1 | from salary ~> "no end
| ^
2 | <empty line>
| ^
unexpected end of input
expecting '"'

Expand Down
9 changes: 2 additions & 7 deletions icicle-compiler/test/cli/repl/t60-map-delete/expected
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@ Selected psv file as input: test/cli/repl/data.psv

λ Queries will be evaluated using the core evaluator.
λ Queries will be evaluated using the C evaluator.
λ λ Core evaluation
λ λ | | | | | | | | | | | | Core evaluation
---------------

homer|[ ("arm", 4) ]
Expand All @@ -27,9 +27,4 @@ C evaluation

homer|[ ("arm", 4) ]

λ -- fold x = map_create :
λ -- case map_lookup location x
λ -- | None -> map_insert location severity x
λ -- | Some _ -> map_delete location x
λ -- end
λ λ
λ
20 changes: 13 additions & 7 deletions icicle-compiler/test/cli/repl/t60-map-delete/script
Original file line number Diff line number Diff line change
@@ -1,10 +1,16 @@
:set +core-eval
:set +c-eval

from injury ~> fold x = map_create then case map_lookup (Some location) x of None then map_insert (Some location) (Some severity) x; Some _ then map_delete (Some location) x ~> x
-- fold x = map_create :
-- case map_lookup location x
-- | None -> map_insert location severity x
-- | Some _ -> map_delete location x
-- end

:{
from injury in
fold x =
map_create
then
case map_lookup (Some location) x of
None then
map_insert (Some location) (Some severity) x
Some _ then
map_delete (Some location) x
in
x
:}
2 changes: 1 addition & 1 deletion icicle-compiler/test/cli/repl/t70-zebra/expected
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,7 @@ homer|{ "arm" -> [ None, None ], "torso" -> [ Some "ignore", None ] }
marge|{ "head" -> [ Some "ignore", None ], "leg" -> [ None, None ] }
moe|{ "ear" -> [ None ], "hair" -> [ None ] }

λ λ C evaluation
λ λ | | | | | | | | | | | | C evaluation
------------

homer|{ Some "arm" -> Some 4.0 }
Expand Down
14 changes: 13 additions & 1 deletion icicle-compiler/test/cli/repl/t70-zebra/script
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,18 @@ from injury ~> newest action

from injury ~> group location ~> latest 2 ~> action

from injury ~> fold x = map_create then case map_lookup (Some location) x of None then map_insert (Some location) (Some severity) x ; Some _ then map_delete (Some location) x ~> x
:{
from injury in
fold x =
map_create
then
case map_lookup (Some location) x of
None then
map_insert (Some location) (Some severity) x
Some _ then
map_delete (Some location) x
in
x
:}

from injury ~> group location ~> Some (mean (double severity / 100.0))

0 comments on commit 80785d5

Please sign in to comment.