Add slurp utility function

This commit is contained in:
Nathan McCarty 2025-02-27 02:24:14 -05:00
parent 86fa9da474
commit 626245e629

View file

@ -8,9 +8,9 @@ import Control.Eff
-- Only for iutils unit tests -- Only for iutils unit tests
import System import System
--********************* --************************
--* Effect Definition * --* Effect Definition *
--********************* --************************
export export
data Lines : Type -> Type where data Lines : Type -> Type where
@ -19,9 +19,9 @@ data Lines : Type -> Type where
||| Take the next line ||| Take the next line
Take : Lines (Maybe String) Take : Lines (Maybe String)
--********************* --************************
--* Effect Actions * --* Effect Actions *
--********************* --************************
export export
peek : Has Lines fs => Eff fs (Maybe String) peek : Has Lines fs => Eff fs (Maybe String)
@ -31,9 +31,29 @@ export
take : Has Lines fs => Eff fs (Maybe String) take : Has Lines fs => Eff fs (Maybe String)
take = send Take take = send Take
--********************* --************************
--* Effect Handlers * --* Extra Effect Actions *
--********************* --************************
||| Take lines until a line matching the given predicate is encountered, dropping the
||| matching line
export
slurp : Has Lines fs => (predicate : String -> Bool) -> Eff fs (List String)
slurp predicate = do
Just line <- peek
| _ => pure []
if predicate line
then do
_ <- take
pure []
else do
Just x <- take
| _ => pure []
map (x ::) (slurp predicate)
--************************
--* Effect Handlers *
--************************
||| Split the next line from a string ||| Split the next line from a string
nextLine : String -> Maybe (String, String) nextLine : String -> Maybe (String, String)
@ -79,9 +99,9 @@ runLines input =
let (vv, input3) = unLines input2 lns let (vv, input3) = unLines input2 lns
in f input3 vv in f input3 vv
--********************* --************************
--* Unit Tests * --* Unit Tests *
--********************* --************************
-- @@test runLines Smoke Test -- @@test runLines Smoke Test
runLinesSmoke : IO Bool runLinesSmoke : IO Bool