{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ExistentialQuantification #-}
module ScanningParser
 ( ScanningParser(..)
 ) where

import Data.Maybe
import Data.List
import Control.Applicative
import Control.Monad
import Data.Monoid

-- | Utility to operate on the first item of a pair.
first :: (a->b) -> (a,c) -> (b,c)
first f (x,y) = (f x, y)

-- | This type provides the means to parse a stream of 'tok' and extract all
-- the 'obj' parses that occur.
--
-- Use Functor and Monoid interfaces to combine parsers.  For example,
--
-- > parserAorB = fmap Left parserA <> fmap Right parserB
--
data ScanningParser tok obj = forall partial. ScanningParser
    { findFirst :: tok -> Maybe partial
    -- ^ If the token starts an object, returns a partial parse.
    , parseBody :: partial -> [tok] -> (Maybe obj,[tok])
    -- ^ Given a partial parse and the stream of tokens that follow, attempt to
    -- parse an object and return the unconsumed tokens.
    }

-- | Apply a 'ScanningParser' to a list of tokens, yielding a list of parsed
-- objects.
scanAndParse :: ScanningParser a c -> [a] -> [c]
scanAndParse psr [] = []
scanAndParse psr@(ScanningParser ffst pbdy) ts = do
    (b,xs) <- take 1 $ mapMaybe findfst' tss
    let (mc,ts') = pbdy b xs
    maybe [] (:scanAndParse psr ts') mc
 where
    tss = tails ts
    findfst' ts = do
        x <- listToMaybe ts
        b <- ffst x
        return (b,drop 1 ts)

instance Functor (ScanningParser a) where
    fmap f (ScanningParser ffst pbody)
        = ScanningParser ffst (\b -> first (fmap f) . pbody b)

instance Monoid (ScanningParser a b) where
    mempty = ScanningParser (const Nothing) (const $ const (Nothing,[]))
    mappend a b = a <+> b

-- | Combine two parsers into one that tries either.
(<+>) ::
    ScanningParser tok obj
    -> ScanningParser tok obj
    -> ScanningParser tok obj
parserA@(ScanningParser ffstA pbdyA) <+> parserB@(ScanningParser ffstB pbdyB)  = ScanningParser ffst pbody
 where
    ffst x = mplus (Left  <$> ffstA x)
                   (Right <$> ffstB x)
    pbody (Left apart)  = pbdyA apart
    pbody (Right bpart) = pbdyB bpart

{-

-- | Map a parser into a sum type. This is useful for combining multiple
-- 'ScanningParser's for a single pass scan.
--
-- HELP: Can this be done with one function argument instead of three?
mapParser ::
    (c -> y)
    -> (b -> x)
    -> (x -> b)
    -> ScanningParser a b c
    -> ScanningParser a x y
mapParser g f invf psr =
    psr { findFirst = fmap f . findFirst psr
        , parseBody = \b as -> first (fmap g) $ parseBody psr (invf b) as
        }

-- | map 'Right' over a 'ScanningParser'
--
-- > mapRight = mapParser Right Right (\(Right x)->x)
mapRight :: ScanningParser a b c -> ScanningParser a (Either x b) (Either y c)
mapRight = mapParser Right Right (\(Right x)->x)

-- | map 'Left' over a 'ScanningParser'
--
-- > mapLeft = mapParser Left Left (\(Left x)->x)
mapLeft :: ScanningParser a b c -> ScanningParser a (Either b x) (Either c y)
mapLeft  = mapParser Left Left (\(Left x)->x)

-}