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
data FailableList e a
= Next a (FailableList e a)
| Done
| Fail e
deriving (Eq, Show)
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))
null :: FailableList e a -> Bool
null (Next _ _) = False
null _ = True
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)
map :: (a -> b) -> FailableList e a -> FailableList e b
map f = foldr (Next . f) Done Fail
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
concatMap :: (a -> FailableList e b) -> FailableList e a -> FailableList e b
concatMap f = foldr (append . f) Done Fail
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)
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
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)
length :: FailableList e a -> Int
length = foldr (const (1 +)) 0 (const 0)
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