Series.hs

{-|
Module      : Prosidy.Types.Series
Description : A type of items occuring in a sequence.
Copyright   : ©2020 James Alexander Feldman-Crough
License     : MPL-2.0
Maintainer  : alex@fldcr.com
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE Safe #-}
module Prosidy.Types.Series
    ( -- * Possibly empty collections
      Series(..)
    , asSeq
    , fromSeq
    , toSeq
      -- * Known non-empty collections
    , SeriesNE
    , fromSeqNE
    , toSeqNE
      -- * Pattern synonyms for easy manipulation of series
    , pattern NonEmpty
    , pattern Empty
    , pattern (:>>:)
    , pattern (:<<:)
    , pattern (:>:)
    , pattern (:<:)
    )
where

import Prosidy.Internal.Classes

import           Data.Sequence                  ( Seq )
import           Data.Foldable                  ( toList
                                                , foldl'
                                                )
import           Control.Monad                  ( guard )

import qualified Data.Sequence                 as Seq

-- | A newtype wrapper around a sequential collection.
--
-- Currently, 'Series' is implemented as a 'Seq', but this is not guarenteed to
-- be true.
newtype Series a = Series (Seq a)
  deriving (Generic, Show)
  deriving (Eq, ToJSON, FromJSON, NFData, Semigroup, Monoid) via Seq a
  deriving (Foldable, Functor, Applicative) via Seq

instance Binary a => Binary (Series a) where
    get = Series . Seq.fromList <$> get
    {-# INLINE get #-}

    put (Series xs) = put $ toList xs
    {-# INLINE put #-}

instance Hashable a => Hashable (Series a) where
    hashWithSalt salt (Series xs) = foldl' hashWithSalt salt xs

instance Pretty a => Pretty (Series a) where
    pretty = pretty . toList

instance Traversable Series where
    traverse f (Series xs) = Series <$> traverse f xs

-- | A non-empty 'Series'.
newtype SeriesNE a = SeriesNE (Seq a)
  deriving (Generic, Show)
  deriving (Eq, ToJSON, NFData, Semigroup) via Seq a
  deriving (Foldable, Functor, Applicative) via Seq

instance Binary a => Binary (SeriesNE a) where
    get =
        maybe (error "SeriesNE must be non-empty") id
            .   fromSeqNE
            .   Seq.fromList
            <$> get
    {-# INLINE get #-}

    put (SeriesNE xs) = put $ toList xs
    {-# INLINE put #-}

instance FromJSON a => FromJSON (SeriesNE a) where
    parseJSON value = do
        inner <- parseJSON value
        guard (not $ null inner)
        pure $ SeriesNE inner

instance Hashable a => Hashable (SeriesNE a) where
    hashWithSalt salt (SeriesNE xs) = foldl' hashWithSalt salt xs

instance Pretty a => Pretty (SeriesNE a) where
    pretty = pretty . toList

instance Traversable SeriesNE where
    traverse f (SeriesNE xs) = SeriesNE <$> traverse f xs

pattern FromSeries :: Series a -> Seq a
pattern FromSeries a <- (fromSeq -> a)

-- | Matches against an empty 'Series'.
pattern Empty :: Series a
pattern Empty = Series Seq.Empty

-- | Matches a non-empty 'SeriesNE' as if it were just a 'Series'.
pattern NonEmpty :: SeriesNE a -> Series a
pattern NonEmpty a <- (seriesNE -> Just a)
  where NonEmpty (SeriesNE a) = Series a

-- | Match against the first element of a 'Series'.
infixr 5 :<:
pattern (:<:) :: a -> Series a -> Series a
pattern a :<: b <- Series (a Seq.:<| FromSeries b)
  where a :<: Series b = Series (a Seq.:<| b)

-- | Match against the last element of a 'Series'.
infixl 5 :>:
pattern (:>:) :: Series a -> a -> Series a
pattern a :>: b <- Series (FromSeries a Seq.:|> b)
  where Series a :>: b = Series (a Seq.:|> b)

-- | Match against a non-empty 'SeriesNE' and a leading element.
infixr 3 :<<:
pattern (:<<:) :: a -> Series a -> SeriesNE a
pattern a :<<: b <- SeriesNE (a Seq.:<| FromSeries b)
  where a :<<: Series b = SeriesNE (a Seq.:<| b)

-- | Match against a non-empty 'SeriesNE' and a trailing element.
infixl 3 :>>:
pattern (:>>:) :: Series a -> a -> SeriesNE a
pattern a :>>: b <- SeriesNE (FromSeries a Seq.:|> b)
  where Series a :>>: b = SeriesNE (a Seq.:|> b)

seriesNE :: Series a -> Maybe (SeriesNE a)
seriesNE = fromSeqNE . toSeq

{-# COMPLETE (:<<:) #-}
{-# COMPLETE (:>>:) #-}
{-# COMPLETE (:>:), Empty #-}
{-# COMPLETE (:<:), Empty #-}

-- | Given a function which operates on a 'Seq', return a function which
-- operates on a 'Series'.
asSeq :: Functor f => (Seq a -> f (Seq b)) -> Series a -> f (Series b)
asSeq f (Series s) = Series <$> f s

-- | Convert a 'Seq' into a 'Series'.
fromSeq :: Seq a -> Series a
fromSeq = Series

-- | Convert a 'Series' into a 'Seq'.
toSeq :: Series a -> Seq a
toSeq (Series s) = s

-- | Convert a non-empty 'Seq' into a 'SeriesNE'.
fromSeqNE :: Seq a -> Maybe (SeriesNE a)
fromSeqNE s | null s    = Nothing
fromSeqNE s | otherwise = Just (SeriesNE s)

-- | Convert a 'SeriesNE' into a 'Seq'. The returned 'Seq' is guarenteed to
-- always contain at least one element.
toSeqNE :: SeriesNE a -> Seq a
toSeqNE (SeriesNE a) = a