Finite seqs

Data.List.Finite.hs

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}

-- | Lists that are of finite length.

module Data.List.Finite
  ( FiniteList(Empty, (:%))
  , maxed
  , cons
  , empty
  ) where

-- | A list of finite length.
data FiniteList a =
  FiniteList
    { finiteListMaxLength :: !Int
    , finiteList :: ![a]
    }
  deriving (Functor, Foldable, Traversable)

-- | Make a finite list.
empty :: Int -> FiniteList a
empty size =
  FiniteList {finiteListMaxLength = size, finiteList = []}

-- | Is the list maxed out?
maxed :: FiniteList a -> Bool
maxed (FiniteList {finiteListMaxLength}) =
  finiteListMaxLength == 0

-- | Cons onto the list. Ignores if we reached the max already.
cons :: a -> FiniteList a -> FiniteList a
cons a list =
  if maxed list
    then list
    else list
           { finiteListMaxLength = finiteListMaxLength list - 1
           , finiteList = a : finiteList list
           }

-- | Uncons from the list.
uncons :: FiniteList a -> Maybe (a, FiniteList a)
uncons list =
  case finiteList list of
    (x:xs) ->
      let !newMaxLen = finiteListMaxLength list + 1
       in Just (x, list {finiteList = xs, finiteListMaxLength = newMaxLen})
    _ -> Nothing

-- | A bidirectional pattern synonym matching an empty sequence.
pattern Empty :: Int -> FiniteList a
pattern Empty a =
  FiniteList {finiteListMaxLength = a, finiteList = []}

-- | A bidirectional pattern synonym viewing the front of a finite list.
pattern (:%) :: a -> FiniteList a -> FiniteList a
pattern x :% xs <- (uncons -> Just (x, xs))

Data.Seq.Finite.hs

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}

-- | Seqs that are of finite length.

module Data.Seq.Finite
  ( FiniteSeq(Empty, (:<%), (:%>))
  , maxed
  , cons
  , snoc
  , uncons
  , unsnoc
  , empty
  ) where

import           Data.Foldable
import           Data.Sequence (Seq)
import qualified Data.Sequence as Seq (Seq(..))

-- | A seq of finite length.
data FiniteSeq a =
  FiniteSeq
    { finiteSeqMaxLength :: !Int
    , finiteSeq :: !(Seq a)
    }
  deriving (Functor, Foldable, Traversable, Eq)

instance Show a => Show (FiniteSeq a) where
  showsPrec n = showsPrec n . toList

-- | Make a finite seq.
empty :: Int -> FiniteSeq a
empty size =
  FiniteSeq {finiteSeqMaxLength = size, finiteSeq = mempty}

-- | Is the seq maxed out?
maxed :: FiniteSeq a -> Bool
maxed (FiniteSeq {finiteSeqMaxLength}) =
  finiteSeqMaxLength == 0

-- | Cons onto the seq. Ignores if we reached the max already.
cons :: a -> FiniteSeq a -> FiniteSeq a
cons a fseq =
  if maxed fseq
    then fseq
    else fseq
           { finiteSeqMaxLength = finiteSeqMaxLength fseq - 1
           , finiteSeq = a Seq.:<| finiteSeq fseq
           }

-- | Cons onto the seq. Ignores if we reached the max already.
snoc :: a -> FiniteSeq a -> FiniteSeq a
snoc a fseq =
  if maxed fseq
    then fseq
    else fseq
           { finiteSeqMaxLength = finiteSeqMaxLength fseq - 1
           , finiteSeq = finiteSeq fseq Seq.:|> a
           }

-- | Uncons from the seq.
uncons :: FiniteSeq a -> Maybe (a, FiniteSeq a)
uncons fseq =
  case finiteSeq fseq of
    (x Seq.:<| xs) ->
      let !newMaxLen = finiteSeqMaxLength fseq + 1
       in Just (x, fseq {finiteSeq = xs, finiteSeqMaxLength = newMaxLen})
    _ -> Nothing

-- | Unsnoc from the seq.
unsnoc :: FiniteSeq a -> Maybe (a, FiniteSeq a)
unsnoc fseq =
  case finiteSeq fseq of
    (xs Seq.:|> x) ->
      let !newMaxLen = finiteSeqMaxLength fseq + 1
       in Just (x, fseq {finiteSeq = xs, finiteSeqMaxLength = newMaxLen})
    _ -> Nothing

-- | A bidirectional pattern synonym matching an empty sequence.
pattern Empty :: Int -> FiniteSeq a
pattern Empty a =
  FiniteSeq {finiteSeqMaxLength = a, finiteSeq = Seq.Empty}

-- | A bidirectional pattern synonym viewing the front of a finite seq.
pattern (:<%) :: a -> FiniteSeq a -> FiniteSeq a
pattern x :<% xs <- (uncons -> Just (x, xs))

-- | A bidirectional pattern synonym viewing the front of a finite seq.
pattern (:%>) :: a -> FiniteSeq a -> FiniteSeq a
pattern x :%> xs <- (unsnoc -> Just (x, xs))