StrictList.hs

{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE TypeFamilies      #-}

module Data.StrictList where

import qualified Control.Foldl as L
import qualified GHC.Exts

import           Control.Foldl (Fold (Fold))
import           Data.Aeson    (FromJSON, ToJSON, parseJSON, toJSON)
import           Data.Foldable (toList)
import           Prelude       hiding (last, (++))


data StrictList a = Nil | Cons !a !(StrictList a)
              deriving (Eq, Show, Functor, Foldable, Traversable)

instance GHC.Exts.IsList (StrictList a) where
    type Item (StrictList a) = a
    toList = toList
    fromList = fromList

instance FromJSON a => FromJSON (StrictList a) where
    parseJSON = fmap fromList . parseJSON

instance ToJSON a => ToJSON (StrictList a) where
    toJSON = toJSON . toList

instance Monoid (StrictList a) where
    mempty = Nil
    mappend = (++)

instance Applicative StrictList where
    pure x = Cons x Nil
    Cons f fs <*> Cons x xs = Cons (f x) (fs <*> xs)
    _ <*> _ = Nil


(++) :: StrictList a -> StrictList a -> StrictList a
(++) Nil         ys = ys
(++) (Cons x xs) ys = Cons x (xs ++ ys)

snocFold :: Fold a (StrictList a)
snocFold = Fold step Nil id
    where
        step xs x = xs `mappend` Cons x Nil

consFold :: Fold a (StrictList a)
consFold = Fold (flip Cons) Nil id

fromList :: [a] -> StrictList a
fromList = L.fold snocFold

head :: StrictList a -> Maybe a
head Nil = Nothing
head (Cons x _) = Just x

tail :: StrictList a -> StrictList a
tail Nil = Nil
tail (Cons _ xs) = xs

last :: StrictList a -> Maybe a
last = L.fold L.last

reverse :: StrictList a -> StrictList a
reverse = L.fold consFold