||| 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'