Haskell implementation of lists with fast cons/snoc/append

FastList.hs

{-
 - This is free and unencumbered software released into the public domain.
 - 
 - Anyone is free to copy, modify, publish, use, compile, sell, or
 - distribute this software, either in source code form or as a compiled
 - binary, for any purpose, commercial or non-commercial, and by any
 - means.
 - 
 - In jurisdictions that recognize copyright laws, the author or authors
 - of this software dedicate any and all copyright interest in the
 - software to the public domain. We make this dedication for the benefit
 - of the public at large and to the detriment of our heirs and
 - successors. We intend this dedication to be an overt act of
 - relinquishment in perpetuity of all present and future rights to this
 - software under copyright law.
 - 
 - THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 - EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
 - MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
 - IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 - OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
 - ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 - OTHER DEALINGS IN THE SOFTWARE.
 - 
 - For more information, please refer to <http://unlicense.org/>
 -}

{-# LANGUAGE LambdaCase, ViewPatterns, PatternSynonyms #-}

module FastList
  ( FastList ()
  , pattern Cons
  , pattern Snoc
  , pattern Nil
  , fromList
  , uncons
  , unsnoc
  , Data.Foldable.toList
  , optCons
  , optSnoc
  ) where

import Data.Bifunctor
import Data.Foldable
import Control.Applicative
import Control.Monad

-- 'I' in constructors stands for 'Internal' to avoid conflict with
-- pattern aliases
data FastList a
  = INil
  | ICons a (FastList a)
  | ISnoc (FastList a) a
  | Append (FastList a) (FastList a)
  | List [a]

-- Construction and patterns {{{

infixr 5 `Cons`
infixl 5 `Snoc`

pattern Cons :: a -> FastList a -> FastList a
pattern Cons x xs <- (uncons -> Just (x,xs))
  where Cons = ICons

pattern Snoc :: FastList a -> a -> FastList a
pattern Snoc xs x <- (unsnoc -> Just (xs,x))
  where Snoc = ISnoc

pattern Nil :: FastList a
pattern Nil <- (null -> True)
  where Nil = INil

fromList :: [a] -> FastList a
fromList = List

-- }}}

-- Deconstruction {{{

uncons :: FastList a -> Maybe (a, FastList a)
uncons = \case
  INil -> Nothing

  x `ICons` xs -> Just (x, xs)

  xs `ISnoc` x -> second (`ISnoc` x) <$> uncons xs
             <|> Just (x, INil)

  xs `Append` ys -> second (`Append` ys) <$> uncons xs
                <|> uncons ys

  List [] -> Nothing

  List (x:xs) -> Just (x, List xs)

unsnoc :: FastList a -> Maybe (FastList a, a)
unsnoc = \case
  INil -> Nothing

  x `ICons` xs -> first (x `ICons`) <$> unsnoc xs
             <|> Just (INil, x)

  xs `ISnoc` x -> Just (xs, x)

  xs `Append` ys -> first (xs `Append`) <$> unsnoc ys
                <|> unsnoc xs

  List [] -> Nothing

  List (x:xs) -> first (x `ICons`) <$> unsnoc (List xs)
             <|> Just (INil, x)

-- }}}

-- Instances {{{

instance Semigroup (FastList a) where
  (<>) = Append

instance Monoid (FastList a) where
  mempty = INil

-- Eq, Ord and Show instances are neccesarily O(n) anyway, so easiest to
-- just convert to lists - laziness should short-circuit where possible

instance (Eq a) => Eq (FastList a) where
  xs == ys = toList xs == toList ys

instance (Ord a) => Ord (FastList a) where
  compare xs ys = compare (toList xs) (toList ys)

instance (Show a) => Show (FastList a) where
  show xs = "fromList " <> show (toList xs)

instance Foldable FastList where
  foldr f z = \case
    INil -> z
    x `ICons` xs -> x `f` foldr f z xs
    xs `ISnoc` x -> foldr f (x `f` z) xs
    xs `Append` ys -> foldr f (foldr f z ys) xs
    List xs -> foldr f z xs

instance Functor FastList where
  fmap f = go
    where go = \case
            INil -> INil
            x `ICons` xs -> f x `ICons` go xs
            xs `ISnoc` x -> go xs `ISnoc` f x
            xs `Append` ys -> go xs `Append` go ys
            List xs -> List (fmap f xs)

instance Applicative FastList where
  pure x = x `ICons` INil
  (<*>) = ap

instance Alternative FastList where
  empty = INil
  (<|>) = (<>)

instance Monad FastList where
  lst >>= f = case lst of
    INil -> INil
    x `ICons` xs -> f x `Append` go xs
    xs `ISnoc` x -> go xs `Append` f x
    xs `Append` ys -> go xs `Append` go ys
    List xs -> foldr Append INil (f <$> xs)
    where go xs = xs >>= f

-- Obeys left distribution
instance MonadPlus FastList

instance MonadFail FastList where
  fail _ = INil

instance Traversable FastList where
  sequenceA = \case
    INil -> pure INil
    x `ICons` xs -> ICons <$> x <*> sequenceA xs
    xs `ISnoc` x -> ISnoc <$> sequenceA xs <*> x
    xs `Append` ys -> Append <$> sequenceA xs <*> sequenceA ys
    List xs -> List <$> sequenceA xs

-- }}}

-- Utilities {{{

-- Optimises the internal representation of a FastList for repeated
-- uncons operations.
optCons :: FastList a -> FastList a
optCons = foldr ICons INil

-- Optimises the internal representation of a FastList for repeated
-- unsnoc operations.
optSnoc :: FastList a -> FastList a
optSnoc = foldl ISnoc INil

-- }}}