list.hs

module HsList ( List(..)
              , fromList
              , (+++)
              , singleton
              , map
              , length
              , intersperse
              , intercalate
              , concat
              , and
              , or
              , any
              , all
              , iterate
              , head
              , init
              , tail
              , last
              , take
              , drop
              , splitAt
              , takeWhile
              , span
              ) where

import Prelude hiding ( map
                      , length
                      , intersperse
                      , intercalate
                      , concat
                      , iterate
                      , splitAt
                      , takeWhile
                      , span
                      , head
                      , init
                      , tail
                      , last
                      , take
                      , drop
                      , and
                      , or
                      , any
                      , all)

data List a = a :+ (List a)
             | Nil
infixr 4 :+

instance (Show a) => Show (List a) where
  show Nil = "[]"
  show xs  = let str = mkString $ intersperse ", " $ map show xs
              in "[" ++ str ++ "]"

xs, ys :: List Int
xs = 1 :+ 2 :+ 3 :+ Nil
ys = 15 :+ 42 :+ 52 :+ 22 :+ Nil

xss :: List (List Int)
xss = xs :+ ys :+ Nil

fromList :: [a] -> List a
fromList = foldr (:+) Nil

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

singleton :: a -> List a
singleton x = x :+ Nil

length :: List a -> Int
length Nil       = 0
length (_ :+ xs) = 1 + length xs

mkString :: List String -> String
mkString Nil         = ""
mkString (cs :+ css) = cs ++ mkString css

head :: List a -> Maybe a
head Nil      = Nothing
head (x :+ _) = Just x

init :: List a -> List a
init Nil             = error "init: empty list"
init (x :+ y :+ Nil) = singleton x
init (x :+ xs)       = x :+ (init xs)

tail :: List a -> List a
tail Nil       = Nil
tail (x :+ xs) = xs

last :: List a -> Maybe a
last Nil        = Nothing
last (x :+ Nil) = Just x
last (x :+ xs)  = last xs

map :: (a -> b) -> List a -> List b
map _ Nil       = Nil
map f (x :+ xs) = f x :+ map f xs

intersperse :: a -> List a -> List a
intersperse _ Nil          = Nil
intersperse _ l@(x :+ Nil) = l
intersperse y (x :+ xs)    = x :+ y :+ (intersperse y xs)

concat :: List (List a) -> List a
concat Nil         = Nil
concat (xs :+ xss) = xs +++ (concat xss)

intercalate :: List a -> List (List a) -> List a
intercalate ys xss =  concat (intersperse ys xss)

and :: List Bool -> Bool
and Nil       = True
and (b :+ bs) = b && (and bs)

or :: List Bool -> Bool
or Nil        = False
or (b :+ bs)  = b || (or bs)

any :: (a -> Bool) -> List a -> Bool
any _ Nil       = False
any p (x :+ xs) = p x || (any p xs)

all :: (a -> Bool) -> List a -> Bool
all _ Nil       = True
all p (x :+ xs) = p x && (all p xs)

iterate :: (a -> a) -> a -> List a
iterate step v = v :+ iterate step (step v)

take :: Int -> List a -> List a
take _ Nil       = Nil
take n (x :+ xs) | n > 0     = x :+ take (n - 1) xs
                 | otherwise = Nil

drop :: Int -> List a -> List a
drop _ Nil         = Nil
drop n l@(x :+ xs) | n > 0     = drop (n - 1) xs
                   | otherwise = l

splitAt :: Int -> List a -> (List a, List a)
splitAt _ Nil       = (Nil, Nil)
splitAt 0 xs        = (Nil, xs)
splitAt n (x :+ xs) = let (fst, snd) = splitAt (n - 1) xs
                       in if n > 0
                          then (x :+ fst, snd)
                          else (fst, x :+ snd)

takeWhile :: (a -> Bool) -> List a -> List a
takeWhile _ Nil       = Nil
takeWhile p (x :+ xs) = if p x
                        then x :+ takeWhile p xs
                        else Nil


span :: (a -> Bool) -> List a -> (List a, List a)
span _ Nil            = (Nil, Nil)
span p rest@(x :+ xs) = if p x
                        then let (fst, snd) = span p xs
                              in (x :+ fst, snd)
                        else (Nil, rest)