module Data.FullList.Internal where
import Data.Binary
import Control.DeepSeq
import Prelude hiding (head, tail, (++))
import qualified Prelude
import Data.Data
import Data.List ( sort, nub )
newtype FullList a = FullList [a]
deriving (Eq, Ord, Show, Data, Typeable)
fromFL :: FullList a -> [a]
fromFL (FullList x) = x
indeedFL :: [a] -> w -> (FullList a -> w) -> w
indeedFL x on_empty on_full
| null x = on_empty
| otherwise = on_full $ FullList x
head :: FullList a -> a
head (FullList (x:_)) = x
head (FullList _) = error "NList.head is broken"
tail :: FullList a -> [a]
tail (FullList (_:x)) = x
tail (FullList _) = error "NList.tail is broken"
(++) :: FullList a -> FullList a -> FullList a
(++) x y = FullList ((Prelude.++) (fromFL x) (fromFL y))
sortNub :: (Eq a, Ord a) => FullList a -> FullList a
sortNub xs =
case (sort . nub . fromFL $ xs) of
[] -> error "sortNub is broken"
(y:ys) -> y !: ys
instance Functor FullList where
fmap f (FullList x) = FullList (map f x)
infixr 5 !:
class Listable l where
(!:) :: a -> l a -> FullList a
instance Listable [] where
(!:) h t = FullList (h:t)
instance Listable FullList where
(!:) h (FullList t) = FullList (h:t)
instance (NFData a) => NFData (FullList a) where
rnf (FullList x1) = rnf x1 `seq` ()
instance (Binary a) => Binary (FullList a) where
put (FullList x1) = put x1
get
= do x1 <- get
return (FullList x1)