{- 
    Copyright 2010 Mario Blazevic

    This file is part of the Streaming Component Combinators (SCC) project.

    The SCC project is free software: you can redistribute it and/or modify it under the terms of the GNU General Public
    License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later
    version.

    SCC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
    of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.

    You should have received a copy of the GNU General Public License along with SCC.  If not, see
    <http://www.gnu.org/licenses/>.
-}

-- | This module defines the Ticker cofunctor, useful for 'ticking off' a prefix of the input.
-- 

module Data.Functor.Contravariant.Ticker
   (
    -- * The Ticker type
    Ticker(Ticker), 
    -- * Using a Ticker
    splitTicked, Contravariant(..),
    -- * Ticker constructors
    tickNone, tickOne, tickCount, tickPrefixOf, tickWhilePrefixOf, tickWhile, tickUntil, tickAll, 
    -- * Ticker combinators
    andThen, and, or
   )
where

import Prelude hiding (and, or)
import Control.Monad (liftM2)
import Data.Functor.Contravariant (Contravariant(contramap))

-- | This is a contra-functor data type for selecting a prefix of an input stream. If the next input item is acceptable,
-- the ticker function returns the ticker for the rest of the stream. If not, it returns 'Nothing'.
newtype Ticker x = Ticker (x -> Maybe (Ticker x))

instance Contravariant Ticker where
   contramap f (Ticker g) = Ticker (fmap (contramap f) . g . f)

-- | Extracts a list prefix accepted by the 'Ticker' argument. Returns the modified ticker, the prefix, and the
-- remainder of the list.
splitTicked :: Ticker x -> [x] -> (Ticker x, [x], [x])
splitTicked t [] = (t, [], [])
splitTicked t@(Ticker f) l@(x:rest) =
   maybe (t, [], l) (\t' -> let (t'', xs1, xs2) = splitTicked t' rest in (t'', x:xs1, xs2)) (f x)

-- | A ticker that accepts no input.
tickNone :: Ticker x
tickNone = Ticker (const Nothing)

-- | A ticker that accepts a single input item.
tickOne :: Ticker x
tickOne = Ticker (const $ Just tickNone)

-- | A ticker that accepts a given number of input items.
tickCount :: Int -> Ticker x
tickCount n | n > 0 = Ticker (const $ Just $ tickCount (pred n))
            | otherwise = tickNone

-- | A ticker that accepts the longest prefix of input that matches a prefix of the argument list.
tickPrefixOf :: Eq x => [x] -> Ticker x
tickPrefixOf list = tickWhilePrefixOf (map (==) list)

-- | A ticker that accepts a prefix of input as long as each item satisfies the predicate at the same position in the
-- argument list. The length of the predicate list thus determines the maximum number of acepted values.
tickWhilePrefixOf :: [x -> Bool] -> Ticker x
tickWhilePrefixOf (p : rest) = Ticker $ \x-> if p x then Just (tickWhilePrefixOf rest) else Nothing
tickWhilePrefixOf [] = tickNone

-- | A ticker that accepts all input as long as it matches the given predicate.
tickWhile :: (x -> Bool) -> Ticker x
tickWhile p = t
   where t = Ticker (\x-> if p x then Just t else Nothing)

-- | A ticker that accepts all input items until one matches the given predicate.
tickUntil :: (x -> Bool) -> Ticker x
tickUntil p = t
   where t = Ticker (\x-> if p x then Nothing else Just t)

-- | A ticker that accepts all input.
tickAll :: Ticker x
tickAll = Ticker (const $ Just tickAll)

-- | Sequential concatenation ticker combinator: when the first argument ticker stops ticking, the second takes over.
andThen :: Ticker x -> Ticker x -> Ticker x
Ticker t1 `andThen` t@(Ticker t2) = Ticker (\x-> maybe (t2 x) (Just . (`andThen` t)) (t1 x))

-- | Parallel conjunction ticker combinator: the result keeps ticking as long as both arguments do.
and :: Ticker x -> Ticker x -> Ticker x
Ticker t1 `and` Ticker t2 = Ticker (\x-> liftM2 and (t1 x) (t2 x))

-- | Parallel choice ticker combinator: the result keeps ticking as long as any of the arguments does.
or :: Ticker x -> Ticker x -> Ticker x
Ticker t1 `or` Ticker t2 = Ticker (\x-> case (t1 x, t2 x)
                                        of (Nothing, Nothing) -> Nothing
                                           (Nothing, t'@Just{}) -> t'
                                           (t'@Just{}, Nothing) -> t'
                                           (Just t1', Just t2') -> Just (t1' `or` t2'))