135 lines
3.8 KiB
Idris
135 lines
3.8 KiB
Idris
||| An effect for reading an input as a list of lines
|
|
module SSG.Djot.Lines
|
|
|
|
import Data.String
|
|
|
|
import Control.Eff
|
|
|
|
-- Only for iutils unit tests
|
|
import System
|
|
|
|
--************************
|
|
--* Effect Definition *
|
|
--************************
|
|
|
|
export
|
|
data Lines : Type -> Type where
|
|
||| Peek the next line
|
|
Peek : Lines (Maybe String)
|
|
||| Take the next line
|
|
Take : Lines (Maybe String)
|
|
|
|
--************************
|
|
--* Effect Actions *
|
|
--************************
|
|
|
|
export
|
|
peek : Has Lines fs => Eff fs (Maybe String)
|
|
peek = send Peek
|
|
|
|
export
|
|
take : Has Lines fs => Eff fs (Maybe String)
|
|
take = send Take
|
|
|
|
--************************
|
|
--* Extra Effect Actions *
|
|
--************************
|
|
|
|
||| Take lines until a line matching the given predicate is encountered, dropping the
|
|
||| all of the matching lines until the first non matching one
|
|
|||
|
|
||| Intended to be used to slurp up to the next blank line, discarding the blanks
|
|
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
|
|
Just next <- peek
|
|
| _ => pure []
|
|
if predicate next
|
|
then slurp predicate
|
|
else pure []
|
|
else do
|
|
Just x <- take
|
|
| _ => pure []
|
|
map (x ::) (slurp predicate)
|
|
|
|
||| Pop the next line and ignore its value
|
|
export
|
|
drop : Has Lines fs => Eff fs ()
|
|
drop = do
|
|
_ <- take
|
|
pure ()
|
|
|
|
--************************
|
|
--* Effect Handlers *
|
|
--************************
|
|
|
|
||| Split the next line from a string
|
|
nextLine : String -> Maybe (String, String)
|
|
nextLine str =
|
|
if null str
|
|
then Nothing
|
|
else
|
|
let
|
|
(before, after) = break (\c => any (== c) ['\r', '\n']) str
|
|
in Just (before, removeNewline after)
|
|
where
|
|
-- If `after` is empty, we have hit the end of the string, and there is no newline
|
|
-- character to remove. If it has contents, then we need to remove the newline
|
|
removeNewline : String -> String
|
|
removeNewline str with (strM str)
|
|
removeNewline "" | StrNil = ""
|
|
removeNewline (strCons '\n' xs) | (StrCons '\n' xs) = xs
|
|
-- Handle either a \r or a \r\n
|
|
removeNewline (strCons '\r' xs) | (StrCons '\r' xs) with (strM xs)
|
|
removeNewline (strCons '\r' "") | (StrCons '\r' "") | StrNil = ""
|
|
removeNewline (strCons '\r' _) | (StrCons '\r' _) | (StrCons '\n' xs1) = xs1
|
|
removeNewline (strCons '\r' _) | (StrCons '\r' _) | (StrCons x xs1) = strCons x xs1
|
|
-- We shouldn't ever hit this case, as we would have to have contents after the
|
|
-- break, but no newline character, but we fill it in for the sake of totality
|
|
removeNewline (strCons x xs) | (StrCons x xs) = str
|
|
|
|
unLines : String -> Lines s -> (s, String)
|
|
unLines str Peek =
|
|
case nextLine str of
|
|
Nothing => (Nothing, str)
|
|
Just (before, after) => (Just before, str)
|
|
unLines str Take =
|
|
case nextLine str of
|
|
Nothing => (Nothing, str)
|
|
Just (before, after) => (Just before, after)
|
|
|
|
||| Feed a `Lines` from a provided input string
|
|
export
|
|
runLines : Has Lines fs =>
|
|
(input : String) -> Eff fs t -> Eff (fs - Lines) (t, String)
|
|
runLines input =
|
|
handleRelayS input (\x, y => pure (y, x)) $ \input2, lns, f =>
|
|
let (vv, input3) = unLines input2 lns
|
|
in f input3 vv
|
|
|
|
--************************
|
|
--* Unit Tests *
|
|
--************************
|
|
|
|
-- @@test runLines Smoke Test
|
|
runLinesSmoke : IO Bool
|
|
runLinesSmoke = do
|
|
let input = "Hello\nWorld\n\n"
|
|
putStrLn "Input: \{show input}"
|
|
let reference = lines input
|
|
putStrLn "Reference: \{show reference}"
|
|
let (output, rest) = extract $ runLines input lines'
|
|
putStrLn "Output: \{show output}"
|
|
putStrLn "Rest: \{show rest}"
|
|
pure $ output == reference && null rest
|
|
where
|
|
lines' : Eff [Lines] (List String)
|
|
lines' = do
|
|
Just next <- take
|
|
| _ => pure []
|
|
map (next ::) lines'
|