Exercise 5.1 from Purely Functional Data Structures

pfds-5-1.hs

-- Purely Functional Data Structures
-- Exercise 5.1

module Main
  ( Deque (Deque)
  , empty
  , isEmpty
  , cons
  , head
  , tail
  , snoc
  , last
  , init
  ) where

import Prelude hiding (head, init, last, tail)

data Deque a = Deque [a] [a] deriving Show

-- >>> empty
-- Deque [] []
empty :: Deque a
empty = Deque [] []

-- >>> isEmpty empty
-- True
-- >>> isEmpty (cons 1 empty)
-- False
isEmpty :: Deque a -> Bool
isEmpty (Deque [] []) = True
isEmpty _ = False

-- >>> cons 1 empty
-- Deque [1] []
-- >>> cons 2 (cons 1 empty)
-- Deque [2] [1]
cons :: a -> Deque a -> Deque a
cons x (Deque f r) = balance $ Deque (x:f) r

-- >>> snoc 1 empty
-- Deque [] [1]
-- >>> snoc 2 (snoc 1 empty)
-- Deque [1] [2]
snoc :: a -> Deque a -> Deque a
snoc x (Deque f r) = balance $ Deque f (x:r)

-- >>> head empty
-- Nothing
-- >>> head (cons 1 empty)
-- Just 1
-- >>> head (snoc 1 empty)
-- Just 1
head :: Deque a -> Maybe a
head   (Deque [] [])   = Nothing
head d@(Deque [] _)    = last d
head   (Deque (x:_) _) = Just x

-- >>> last empty
-- Nothing
-- >>> last (snoc 1 empty)
-- Just 1
-- >>> last (cons 1 empty)
-- Just 1
last :: Deque a -> Maybe a
last   (Deque [] [])   = Nothing
last d@(Deque _ [])    = head d
last   (Deque _ (x:_)) = Just x

-- >>> tail empty
-- Nothing
-- >>> tail (cons 1 empty)
-- Just (Deque [] [])
-- >>> tail (snoc 1 empty)
-- Just (Deque [] [])
tail :: Deque a -> Maybe (Deque a)
tail   (Deque [] [])   = Nothing
tail d@(Deque [] _)    = init d
tail   (Deque (_:f) r) = Just $ balance $ Deque f r

-- >>> init empty
-- Nothing
-- >>> init (snoc 1 empty)
-- Just (Deque [] [])
-- >>> init (cons 1 empty)
-- Just (Deque [] [])
init :: Deque a -> Maybe (Deque a)
init   (Deque [] [])   = Nothing
init d@(Deque _ [])    = tail d
init   (Deque f (_:r)) = Just $ balance $ Deque f r

-- >>> balance (empty)
-- Deque [] []
-- >>> balance (Deque [] [1, 2])
-- Deque [2] [1]
-- >>> balance (Deque [1, 2] [])
-- Deque [1] [2]
balance :: Deque a -> Deque a
balance d@(Deque f r)
  | null f && atLeast 2 r = uncurry (flip Deque) (halve r)
  | atLeast 2 f && null r = uncurry Deque (halve f)
  | otherwise = d

-- >>> atLeast 1 []
-- False
-- >>> atLeast 1 [1]
-- True
atLeast :: Int -> [a] -> Bool
atLeast n l = not (null (drop (n - 1) l))

-- >>> halve []
-- ([], [])
-- >>> halve [1, 2]
-- ([1], [2])
halve :: [a] -> ([a], [a])
halve l = splitAt (length l `div` 2) l