module Data.CList (module Data.Peano, CList (..), uncons, head, tail, init, last, reverse) where
import Prelude (Read, Show, fst, snd)
import Control.Applicative
import Control.Category.Unicode
import Data.Eq
import Data.Foldable
import Data.Functor
import Data.Monoid
import Data.Ord
import Data.Peano
import Data.Traversable
import Data.Typeable
infixr 5 :.
data CList n a where
Nil :: CList Zero a
(:.) :: a -> CList n a -> CList (Succ n) a
deriving instance (Eq a) => Eq (CList n a)
deriving instance (Ord a) => Ord (CList n a)
deriving instance (Show a) => Show (CList n a)
deriving instance Functor (CList n)
deriving instance Foldable (CList n)
deriving instance Traversable (CList n)
deriving instance Typeable CList
instance Monoid a => Monoid (CList Zero a) where
mempty = Nil
Nil `mappend` Nil = Nil
instance (Monoid a, Monoid (CList n a)) => Monoid (CList (Succ n) a) where
mempty = mempty:.mempty
(x:.xs) `mappend` (y:.ys) = x<>y:.xs<>ys
instance Applicative (CList Zero) where
pure x = Nil
Nil <*> Nil = Nil
instance (Applicative (CList n)) => Applicative (CList (Succ n)) where
pure x = x :. pure x
f:.fs <*> x:.xs = f x :. (fs <*> xs)
uncons :: CList (Succ n) a -> (a, CList n a)
uncons (x:.xs) = (x, xs)
head :: CList (Succ n) a -> a
head = fst ∘ uncons
tail :: CList (Succ n) a -> CList n a
tail = snd ∘ uncons
init :: CList (Succ n) a -> CList n a
init (x:.Nil) = Nil
init (x:.xs@(_:._)) = x:.init xs
last :: CList (Succ n) a -> a
last (x:.Nil) = x
last (x:.xs@(_:._)) = last xs
reverse :: CList n a -> CList n a
reverse Nil = Nil
reverse xs@(_:._) = liftA2 (:.) last (reverse ∘ init) xs