module Deque.Lazy.Defs
where
import Control.Monad (fail)
import Deque.Prelude hiding (tail, init, last, head, null, dropWhile, takeWhile, reverse, filter, take)
import qualified Data.List as List
import qualified Deque.Prelude as Prelude
data Deque a = Deque ![a] ![a]
fromConsAndSnocLists :: [a] -> [a] -> Deque a
fromConsAndSnocLists consList snocList = Deque consList snocList
filter :: (a -> Bool) -> Deque a -> Deque a
filter predicate (Deque consList snocList) = Deque (List.filter predicate consList) (List.filter predicate snocList)
take :: Int -> Deque a -> Deque a
take amount (Deque consList snocList) = let
newConsList = let
buildFromConsList amount = if amount > 0
then \ case
head : tail -> head : buildFromConsList (pred amount) tail
_ -> buildFromSnocList amount (List.reverse snocList)
else const []
buildFromSnocList amount = if amount > 0
then \ case
head : tail -> head : buildFromSnocList (pred amount) tail
_ -> []
else const []
in buildFromConsList amount consList
in Deque newConsList []
drop :: Int -> Deque a -> Deque a
drop amount (Deque consList snocList) = let
buildFromConsList amount = if amount > 0
then \ case
_ : tail -> buildFromConsList (pred amount) tail
_ -> buildFromSnocList amount (List.reverse snocList)
else \ tail -> Deque tail snocList
buildFromSnocList amount = if amount > 0
then \ case
_ : tail -> buildFromSnocList (pred amount) tail
_ -> Deque [] []
else \ tail -> Deque tail []
in buildFromConsList amount consList
takeWhile :: (a -> Bool) -> Deque a -> Deque a
takeWhile predicate (Deque consList snocList) = let
newConsList = List.foldr
(\ a nextState -> if predicate a
then a : nextState
else [])
(List.takeWhile predicate (List.reverse snocList))
consList
in Deque newConsList []
dropWhile :: (a -> Bool) -> Deque a -> Deque a
dropWhile predicate (Deque consList snocList) = let
newConsList = List.dropWhile predicate consList
in case newConsList of
[] -> Deque (List.dropWhile predicate (List.reverse snocList)) []
_ -> Deque newConsList snocList
shiftLeft :: Deque a -> Deque a
shiftLeft deque = maybe deque (uncurry snoc) (uncons deque)
shiftRight :: Deque a -> Deque a
shiftRight deque = maybe deque (uncurry cons) (unsnoc deque)
cons :: a -> Deque a -> Deque a
cons a (Deque consList snocList) = Deque (a : consList) snocList
snoc :: a -> Deque a -> Deque a
snoc a (Deque consList snocList) = Deque consList (a : snocList)
uncons :: Deque a -> Maybe (a, Deque a)
uncons (Deque consList snocList) = case consList of
head : tail -> Just (head, Deque tail snocList)
_ -> case List.reverse snocList of
head : tail -> Just (head, Deque tail [])
_ -> Nothing
unsnoc :: Deque a -> Maybe (a, Deque a)
unsnoc (Deque consList snocList) = case snocList of
head : tail -> Just (head, Deque consList tail)
_ -> case List.reverse consList of
head : tail -> Just (head, Deque [] tail)
_ -> Nothing
prepend :: Deque a -> Deque a -> Deque a
prepend (Deque snocList1 consList1) (Deque snocList2 consList2) = Deque consList3 snocList3 where
consList3 = consList1
snocList3 = snocList2 ++ foldl' (flip (:)) snocList1 consList2
reverse :: Deque a -> Deque a
reverse (Deque consList snocList) = Deque snocList consList
null :: Deque a -> Bool
null (Deque consList snocList) = List.null snocList && List.null consList
head :: Deque a -> Maybe a
head = fmap fst . uncons
tail :: Deque a -> Deque a
tail = fromMaybe <$> id <*> fmap snd . uncons
init :: Deque a -> Deque a
init = fromMaybe <$> id <*> fmap snd . unsnoc
last :: Deque a -> Maybe a
last = fmap fst . unsnoc
instance Eq a => Eq (Deque a) where
(==) a b = toList a == toList b
instance Show a => Show (Deque a) where
show = show . toList
instance Semigroup (Deque a) where
(<>) = prepend
instance Monoid (Deque a) where
mempty =
Deque [] []
mappend =
(<>)
instance Foldable Deque where
foldr step init (Deque consList snocList) = foldr step (foldl' (flip step) init snocList) consList
foldl' step init (Deque consList snocList) = foldr' (flip step) (foldl' step init consList) snocList
instance Traversable Deque where
traverse f (Deque cs ss) =
(\cs' ss' -> Deque cs' (List.reverse ss')) <$> traverse f cs <*> traverse f (List.reverse ss)
deriving instance Functor Deque
instance Applicative Deque where
pure a = Deque [] [a]
fs <*> as = fromList (toList fs <*> toList as)
instance Monad Deque where
return = pure
m >>= f = fromList (toList m >>= toList . f)
fail = const mempty
instance Alternative Deque where
empty = mempty
(<|>) = mappend
instance MonadPlus Deque where
mzero = empty
mplus = (<|>)
instance MonadFail Deque where
fail = const mempty
instance IsList (Deque a) where
type Item (Deque a) = a
fromList = flip Deque []
toList (Deque consList snocList) = consList <> List.reverse snocList