module System.IO.Uniform.Streamline.Scanner where import Control.Applicative 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 a = Running a 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 type IOScanner a = a -> Word8 -> IOScannerState a 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 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