uniform-io/src/System/IO/Uniform/Streamline/Scanner.hs

{- |
IO scanners for use with the Streamline monad transformer.
-}
module System.IO.Uniform.Streamline.Scanner (
  IOScanner,
  IOScannerState(..),
  textScanner,
  anyScanner
  )where

import Data.Default.Class
import Data.Word8 (Word8)

-- | State of an IO scanner.
--   Differently from a parser scanner, an IO scanner
--   must deal with blocking behavior.
data IOScannerState a =
  -- | A scanner returns Finished when the current input is not
  --   part of the result, and the scanning must stop before this
  --   input.
  Finished |
  -- | A scanner returns LastPass when the current input is the
  --   last one of the result, and the scanning must stop before
  --   after this input, without consuming more data.
  LastPass a |
  -- | A scanner returns Running when the current input is part
  --   of the result, and the scanning must continue.
  Running a

instance Functor IOScannerState where
  fmap _ Finished = Finished
  fmap f (LastPass x) = LastPass $ f x
  fmap f (Running x) = Running $ f x
instance Applicative IOScannerState where
  pure = Running
  Finished <*> _ = Finished
  _ <*> Finished = Finished
  (LastPass f) <*> (LastPass x) = LastPass $ f x
  (LastPass f) <*> (Running x) = LastPass $ f x
  (Running f) <*> (LastPass x) = LastPass $ f x
  (Running f) <*> (Running x) = Running $ f x
instance Monad IOScannerState where
  return = pure
  Finished >>= _ = Finished
  (LastPass x) >>= f = case f x of
    Finished -> Finished
    LastPass y -> LastPass y
    Running y -> LastPass y
  (Running x) >>= f = f x

-- | IOScanner type, as required by the scan functions of Streamline
type IOScanner a = a -> Word8 -> IOScannerState a

-- | Creates a scanner that'll finish when any of the given scanners finish.
anyScanner :: Default a => [IOScanner a] -> IOScanner [a]
anyScanner scanners = scan
  where
    --scan :: IOScanner [a]
    scan st c = sequence $ apScanner scanners st c
    --apScanner :: [IOScanner a] -> [a] -> Word8 -> [IOScannerState a]
    apScanner [] _ _ = []
    apScanner (s:ss) [] h = s def h : apScanner ss [] h
    apScanner (s:ss) (t:tt) h = s t h : apScanner ss tt h


{- |
Given a sequence of bytes, creates a scanner that will scan
its input untill that sequence is found.
-}
textScanner :: [Word8] -> IOScanner [[Word8]]
textScanner [] = \_ _ -> Finished
textScanner t@(c:_) = scanner
  where
    scanner st c'
      | c == c' = popStacks (t:st) c'
      | otherwise = popStacks st c'
    popStacks :: IOScanner [[Word8]]
    popStacks [] _ = Running []
    popStacks ([]:_) _ = Finished
    popStacks ((h':hh):ss) h
      | h == h' && null hh = case popStacks ss h of
        Finished -> Finished
        LastPass ss' -> LastPass ss'
        Running ss' -> LastPass ss'
      | h == h' = case popStacks ss h of
        Finished -> Finished
        LastPass ss' -> LastPass $ hh:ss'
        Running ss' -> Running $ hh:ss'
      | otherwise = popStacks ss h