-----------------------------------------------------------------------------
-- |
-- Module      :  Data.FailableList
-- Copyright   :  (c) 2008-2009 Duncan Coutts
--                    2009 John Millikin
-- License     :  BSD3
--
-- Maintainer  :  jmillikin@gmail.com
-- Portability :  portable
--
-- A list-like type for lazy streams, which might terminate with an error.
--
-- This module uses common names and so is designed to be imported qualified:
--
-- > import qualified Data.FailableList as FL
--
-----------------------------------------------------------------------------

module Data.FailableList
	( FailableList (..)
	, null
	, append
	, map
	, mapEither
	, concatMap
	, foldr
	, foldl
	, unfoldr
	, length
	) where
import Prelude hiding (null, map, concatMap, foldl, foldr, length)
import qualified Prelude as Prelude
import Data.Monoid (Monoid, mempty, mappend)
import Control.Monad (MonadPlus, mzero, mplus, ap)
import Control.Monad.Fix (MonadFix, fix, mfix)
import qualified Control.Applicative as A
import Control.Applicative ((<$>), (<*>))
import qualified Data.Foldable as F
import qualified Data.Traversable as T

-- | A list-like type for lazy sequences which might terminate with an error.
--
-- Standard lists can be converted to failable lists using
-- @Prelude.foldr Next Done@.
--
data FailableList e a
	= Next a (FailableList e a)
	| Done
	| Fail e
	deriving (Eq, Show)

-- TODO: deriving Data?

instance Functor (FailableList e) where
	fmap = map

instance Monoid (FailableList e a) where
	mempty = Done
	mappend = append

instance Monad (FailableList e) where
	Done        >>= _ = Done
	Fail e      >>= _ = Fail e
	(Next x xs) >>= k = append (k x) (xs >>= k)
	return = flip Next Done

instance MonadPlus (FailableList e) where
	mzero = mempty
	mplus = append

instance A.Alternative (FailableList e) where
	empty = mempty
	(<|>) = append

instance A.Applicative (FailableList e) where
	pure = return
	(<*>) = ap

instance F.Foldable (FailableList e) where
	foldMap = T.foldMapDefault

instance T.Traversable (FailableList e) where
	sequenceA Done        = A.pure Done
	sequenceA (Fail e)    = A.pure $ Fail e
	sequenceA (Next f fs) = Next <$> f <*> T.sequenceA fs

instance MonadFix (FailableList e) where
	mfix f = case fix (f . head') of
		Done       -> Done
		Fail e     -> Fail e
		(Next x _) -> append (return x) (mfix (tail' . f))

-- | Like the standard 'Prelude.null' function.
--
null :: FailableList e a -> Bool
null (Next _ _) = False
null _          = True

-- | Like the standard '++' function.
--
append :: FailableList e a -> FailableList e a -> FailableList e a
append Done        y = y
append x@(Fail _)  _ = x
append (Next x xs) y = Next x (append xs y)

-- | Like the standard 'Prelude.map' function.
--
map :: (a -> b) -> FailableList e a -> FailableList e b
map f = foldr (Next . f) Done Fail

{-# INLINE [1] map #-}

{-# RULES
  "map/map" forall f g t.
   map f (map g t) = map (f . g) t
  #-}

-- | Like the standard 'Prelude.map' function, but the mapping function may
-- return an error.
--
mapEither :: (a -> Either e b) -> FailableList e a -> FailableList e b
mapEither f = foldr (\a acc -> either Fail (flip Next acc) (f a)) Done Fail

{-# INLINE [1] mapEither #-}

{-# RULES
  "mapEither/mapEither" forall f g t.
   mapEither f (mapEither g t) = mapEither (either Left g . f) t
  #-}

-- | Like the standard 'Prelude.concatMap' function.
--
concatMap :: (a -> FailableList e b) -> FailableList e a -> FailableList e b
concatMap f = foldr (append . f) Done Fail

-- | Like the standard 'Prelude.foldr' function, but accepting an extra
-- parameter to handle 'Fail' items.
--
foldr :: (a -> b -> b) -> b -> (e -> b) -> FailableList e a -> b
foldr f nil fail' = foldr' where
	foldr' Done        = nil
	foldr' (Fail e)    = fail' e
	foldr' (Next a as) = f a (foldr' as)

-- | Like the standard 'Prelude.foldl' function, but errors will return a
-- 'Left' value.
--
foldl :: (b -> a -> b) -> b -> FailableList e a -> Either e b
foldl f = foldl' where
	foldl' nil Done        = Right nil
	foldl' _   (Fail e)    = Left e
	foldl' nil (Next x xs) = foldl' (f nil x) xs

-- | Like the standard 'Data.List.unfoldr' function, but the step function
-- may return an error.
--
unfoldr :: (b -> Either e (Maybe (a, b))) -> b -> FailableList e a
unfoldr f = unfoldr' where
	unfoldr' x = case f x of
		Right Nothing       -> Done
		Left  e             -> Fail e
		Right (Just (a, b)) -> Next a (unfoldr' b)

-- | Like the standard 'Prelude.length' function; 'Done' and 'Fail' are
-- considered 0-length.
--
length :: FailableList e a -> Int
length = foldr (const (1 +)) 0 (const 0)

-- Partial functions, used only to implement mfix; not exported
head' :: FailableList e a -> a
head' Done       = error "mfix FailableList: Done"
head' (Fail _)   = error "mfix FailableList: Fail"
head' (Next x _) = x

tail' :: FailableList e a -> FailableList e a
tail' Done        = error "mfix FailableList: Done"
tail' (Fail _)    = error "mfix FailableList: Fail"
tail' (Next _ xs) = xs