-----------------------------------------------------------------------------
-- |
-- 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 (..)
	, map
	, foldr
	, unfoldr
	) where
import Prelude hiding (map, foldr)
import qualified Prelude as Prelude
import Data.Monoid (Monoid, mempty, mappend, mconcat)
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 = T.fmapDefault

instance Monoid (FailableList e a) where
	mempty = Done
	mappend x y = foldr Next y Fail x

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

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

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

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 _) -> mappend (return x) (mfix (tail' . f))

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

-- | 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 (Just (a, b)) -> Next a (unfoldr' b)
		Right       Nothing -> Done
		Left              e -> Fail e

-- 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