module Penny.Lincoln.Serial (
  Serial, forward, backward, serials,
  serialItems, serialItemsM,
  serialChildrenInFamily, serialEithers,
  NextFwd, NextBack, initNexts) where

import Control.Monad (zipWithM)
import Control.Monad.Trans.Class (lift)
import qualified Data.Either as E
import qualified Penny.Lincoln.Family as F
import qualified Control.Monad.Trans.State as St

-- | A type for serial numbers, used widely for different purposes
-- throughout Penny.

data Serial = Serial {
  -- | Numbered from first to last, beginning at zero.
  forward :: !Int
  
  -- | Numbered from last to first, ending at zero.
  , backward :: !Int

  } deriving (Eq, Show)
             

-- | Label a list of items with serials.
serialItems :: (Serial -> a -> b)
               -> [a]
               -> [b]
serialItems f as =
  let ss = serials as
  in zipWith f ss as

-- | Label a list of items with serials, in a monad.
serialItemsM ::
  Monad m
  => (Serial -> a -> m b)
  -> [a]
  -> m [b]
serialItemsM f as =
  let ss = serials as
  in zipWithM f ss as

-- | Applied to a list of items, return a list of Serials usable to
-- identify the list of items.
serials :: [a] -> [Serial]
serials as = zipWith Serial fs rs where
  len = length as
  fs = take len . iterate succ $ 0
  rs = take len . iterate pred $ (len - 1)


serialChildrenInFamily ::
  (Serial -> cOld -> cNew)
  -> F.Family p cOld
  -> St.State (NextFwd, NextBack) (F.Family p cNew)
serialChildrenInFamily f = F.mapChildrenM (serialItemSt f)

newtype NextFwd = NextFwd Int deriving Show
newtype NextBack = NextBack Int deriving Show

serialItemSt ::
  (Serial -> cOld -> cNew)
  -> cOld
  -> St.State (NextFwd, NextBack) cNew
serialItemSt f old = do
  (NextFwd fwd, NextBack bak) <- St.get
  let s = Serial fwd bak
  St.put (NextFwd $ succ fwd, NextBack $ pred bak)
  return (f s old)

newtype Index = Index Int deriving (Eq, Ord, Show)
newtype Total = Total Int deriving (Eq, Ord, Show)

serialEithers ::
  Monad m
  => (Serial -> a -> m c)
  -> (Serial -> b -> m d)
  -> [Either a b]
  -> m [Either c d]
serialEithers fa fb ls =
  let allA = E.lefts ls
      allB = E.rights ls
      totA = Total . length $ allA
      totB = Total . length $ allB
      initState = (0 :: Int, 0 :: Int)
      k e = do
        (nextA, nextB) <- St.get
        case e of
          Left a -> do
            c <- lift $ fa (serial totA (Index nextA)) a
            St.put (succ nextA, nextB)
            return $ Left c
          Right b -> do
            d <- lift $ fb (serial totB (Index nextB)) b
            St.put (nextA, succ nextB)
            return $ Right d
  in St.evalStateT (mapM k ls) initState

serial :: Total -> Index -> Serial
serial (Total t) (Index i) = Serial i b where
  b = t - i - 1

initNexts :: Int -> (NextFwd, NextBack)
initNexts i = (NextFwd 0, NextBack $ i - 1)