module Penny.Lincoln.Serial (
Serial, forward, backward, GenSerial,
incrementBack, getSerial, makeSerials, serialItems,
nSerials ) where
import Control.Applicative (Applicative, (<*>), pure, (*>))
import Control.Monad (ap)
data SerialSt = SerialSt
{ nextFwd :: Int
, nextBack :: Int
} deriving Show
data Serial = Serial
{ forward :: Int
, backward :: Int
} deriving (Eq, Show, Ord)
newtype GenSerial a = GenSerial (SerialSt -> (a, SerialSt))
instance Functor GenSerial where
fmap f (GenSerial k) = GenSerial $ \s ->
let (a', st') = k s
in (f a', st')
instance Applicative GenSerial where
pure = return
(<*>) = ap
instance Monad GenSerial where
return a = GenSerial $ \s -> (a, s)
(GenSerial k) >>= f = GenSerial $ \s ->
let (a, s') = k s
GenSerial g = f a
in g s'
incrementBack :: GenSerial ()
incrementBack = GenSerial $ \s ->
let s' = SerialSt (nextFwd s) (nextBack s + 1)
in ((), s')
getSerial :: GenSerial Serial
getSerial = GenSerial $ \s ->
let s' = SerialSt (nextFwd s + 1) (nextBack s 1)
in (Serial (nextFwd s) (nextBack s), s')
makeSerials :: GenSerial a -> a
makeSerials (GenSerial k) =
let (r, _) = k (SerialSt 0 0) in r
serialItems :: (Serial -> a -> b) -> [a] -> [b]
serialItems f as = zipWith f (nSerials (length as)) as
nSerials :: Int -> [Serial]
nSerials n =
makeSerials $
(sequence . replicate n $ incrementBack)
*> (sequence . replicate n $ getSerial)