Sequence.hs

-- | This modules contains the 'SeqNum' newtype wrapper to indicate that a type
-- is a sequence number.
module Data.MediaBus.Basics.Sequence
  ( SeqNum(..)
  , fromSeqNum
  , type SeqNum8
  , type SeqNum16
  , type SeqNum32
  , type SeqNum64
  , HasSeqNum(..)
  ) where

import Control.DeepSeq
import Control.Lens
import Data.Default
import Data.MediaBus.Basics.Monotone
import Data.MediaBus.Basics.Series
import Data.Word
import GHC.Generics (Generic)
import System.Random
import Test.QuickCheck (Arbitrary(..))
import Text.Printf

-- | The newtype wrapper that indicates that something is a sequence number.
newtype SeqNum s = MkSeqNum
  { _fromSeqNum :: s
  } deriving ( Num
             , Eq
             , Bounded
             , Enum
             , LocalOrd
             , Arbitrary
             , Default
             , Generic
             , Random
             )

instance NFData s =>
         NFData (SeqNum s)

instance HasSeqNum (SeqNum s) where
  type GetSeqNum (SeqNum s) = s
  type SetSeqNum (SeqNum s) s' = SeqNum s'
  seqNum = fromSeqNum

instance Show s =>
         Show (SeqNum s) where
  showsPrec d (MkSeqNum s) =
    showParen (d > 10) (printf "sn: %10s" . showsPrec 11 s)

instance (Eq a, LocalOrd a) =>
         Ord (SeqNum a) where
  compare !x !y
    | x == y = EQ
    | x `succeeds` y = GT
    | otherwise = LT

deriving instance
         (Real a, Num a, Eq a, LocalOrd a) => Real (SeqNum a)

deriving instance
         (Integral a, Enum a, Real a, Eq a, LocalOrd a) =>
         Integral (SeqNum a)

-- | An 'Iso' between a 'SeqNum' and its' value.
fromSeqNum :: Iso (SeqNum a) (SeqNum b) a b
fromSeqNum = iso _fromSeqNum MkSeqNum

-- * Type aliases
-- | A 'Word8' based sequence number.
type SeqNum8 = SeqNum Word8

-- | A 'Word16' based sequence number.
type SeqNum16 = SeqNum Word16

-- | A 'Word32' based sequence number.
type SeqNum32 = SeqNum Word32

-- | A 'Word64' based sequence number.
type SeqNum64 = SeqNum Word64

-- * Lens type classes
-- | A class for types providing a lens to a sequence number.
class SetSeqNum t (GetSeqNum t) ~ t =>
      HasSeqNum t where
  type GetSeqNum t
  type SetSeqNum t s
  -- | A lens for the sequence number contained in @t@
  seqNum :: Lens t (SetSeqNum t s) (GetSeqNum t) s

instance (HasSeqNum a, HasSeqNum b, GetSeqNum a ~ GetSeqNum b) =>
         HasSeqNum (Series a b) where
  type GetSeqNum (Series a b) = GetSeqNum a
  type SetSeqNum (Series a b) t = Series (SetSeqNum a t) (SetSeqNum b t)
  seqNum f (Start !a) = Start <$> seqNum f a
  seqNum f (Next !b) = Next <$> seqNum f b