------------------------------------------------------------------------
-- |
-- Module      :  ALife.Creatur.Namer
-- Copyright   :  (c) 2012-2021 Amy de Buitléir
-- License     :  BSD-style
-- Maintainer  :  amy@nualeargais.ie
-- Stability   :  experimental
-- Portability :  portable
--
-- Assigns a unique ID upon request. IDs generated by an @Namer@ 
-- are guaranteed to be unique within a given universe, across all 
-- simulation runs.
--
------------------------------------------------------------------------
module ALife.Creatur.Namer
  (
    Namer(..),
    SimpleNamer,
    mkSimpleNamer
  ) where

import ALife.Creatur.Counter (PersistentCounter, current, increment,
  mkPersistentCounter)
import ALife.Creatur.Util (stateMap)
import Control.Monad.State (StateT, get, gets)

class Namer n where
  -- | Assign a unique ID using the supplied prefix.
  genName :: StateT n IO String

data SimpleNamer = SimpleNamer 
  {
    SimpleNamer -> String
prefix :: String,
    SimpleNamer -> PersistentCounter
counter :: PersistentCounter
  } deriving (Int -> SimpleNamer -> ShowS
[SimpleNamer] -> ShowS
SimpleNamer -> String
(Int -> SimpleNamer -> ShowS)
-> (SimpleNamer -> String)
-> ([SimpleNamer] -> ShowS)
-> Show SimpleNamer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleNamer] -> ShowS
$cshowList :: [SimpleNamer] -> ShowS
show :: SimpleNamer -> String
$cshow :: SimpleNamer -> String
showsPrec :: Int -> SimpleNamer -> ShowS
$cshowsPrec :: Int -> SimpleNamer -> ShowS
Show, SimpleNamer -> SimpleNamer -> Bool
(SimpleNamer -> SimpleNamer -> Bool)
-> (SimpleNamer -> SimpleNamer -> Bool) -> Eq SimpleNamer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleNamer -> SimpleNamer -> Bool
$c/= :: SimpleNamer -> SimpleNamer -> Bool
== :: SimpleNamer -> SimpleNamer -> Bool
$c== :: SimpleNamer -> SimpleNamer -> Bool
Eq)

mkSimpleNamer :: String -> FilePath -> SimpleNamer
mkSimpleNamer :: String -> String -> SimpleNamer
mkSimpleNamer String
s String
f = String -> PersistentCounter -> SimpleNamer
SimpleNamer String
s (PersistentCounter -> SimpleNamer)
-> PersistentCounter -> SimpleNamer
forall a b. (a -> b) -> a -> b
$ String -> PersistentCounter
mkPersistentCounter String
f

withCounter :: StateT PersistentCounter IO x -> StateT SimpleNamer IO x
withCounter :: StateT PersistentCounter IO x -> StateT SimpleNamer IO x
withCounter StateT PersistentCounter IO x
runProgram = do
  SimpleNamer
u <- StateT SimpleNamer IO SimpleNamer
forall s (m :: * -> *). MonadState s m => m s
get
  (PersistentCounter -> SimpleNamer)
-> (SimpleNamer -> PersistentCounter)
-> StateT PersistentCounter IO x
-> StateT SimpleNamer IO x
forall (m :: * -> *) s t a.
Monad m =>
(s -> t) -> (t -> s) -> StateT s m a -> StateT t m a
stateMap (\PersistentCounter
c -> SimpleNamer
u {counter :: PersistentCounter
counter=PersistentCounter
c}) SimpleNamer -> PersistentCounter
counter StateT PersistentCounter IO x
runProgram

instance Namer SimpleNamer where
  genName :: StateT SimpleNamer IO String
genName = do
    String
p <- (SimpleNamer -> String) -> StateT SimpleNamer IO String
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SimpleNamer -> String
prefix
    Int
k <- StateT PersistentCounter IO Int -> StateT SimpleNamer IO Int
forall x. StateT PersistentCounter IO x -> StateT SimpleNamer IO x
withCounter (StateT PersistentCounter IO ()
forall c. Counter c => StateT c IO ()
increment StateT PersistentCounter IO ()
-> StateT PersistentCounter IO Int
-> StateT PersistentCounter IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT PersistentCounter IO Int
forall c. Counter c => StateT c IO Int
current)
    String -> StateT SimpleNamer IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> StateT SimpleNamer IO String)
-> String -> StateT SimpleNamer IO String
forall a b. (a -> b) -> a -> b
$ String
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
k