module Momo.Ident
  ( Ident(..)

  , MonadStamp(..)
  , create

  , Table
  ) where

import Data.Map (Map)
import Data.Text (Text)

-- class Ident a where
--   create :: Text -> a
--   name :: a -> Text
--   equal :: a -> a -> Bool

-- class (Ident ident) => Table ident a where
--   emptyTable :: Table ident a
--   add :: ident -> a -> Table ident a -> Table ident a
--   find :: ident -> Table ident a -> Maybe a

data Ident = Ident
  { Ident -> Text
name  :: Text
  , Ident -> Integer
stamp :: Integer
  }
  deriving (Int -> Ident -> ShowS
[Ident] -> ShowS
Ident -> String
(Int -> Ident -> ShowS)
-> (Ident -> String) -> ([Ident] -> ShowS) -> Show Ident
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ident] -> ShowS
$cshowList :: [Ident] -> ShowS
show :: Ident -> String
$cshow :: Ident -> String
showsPrec :: Int -> Ident -> ShowS
$cshowsPrec :: Int -> Ident -> ShowS
Show)

instance Eq Ident where
  Ident
a == :: Ident -> Ident -> Bool
== Ident
b = Ident
a.stamp Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
b.stamp

instance Ord Ident where
  compare :: Ident -> Ident -> Ordering
compare Ident
a Ident
b = Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Ident
a.stamp Ident
b.stamp

class (Monad m) => MonadStamp m where
  nextStamp :: m Integer

create :: MonadStamp m => Text -> m Ident
create :: forall (m :: * -> *). MonadStamp m => Text -> m Ident
create Text
name = do
  Integer
stamp <- m Integer
forall (m :: * -> *). MonadStamp m => m Integer
nextStamp
  Ident -> m Ident
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ident{Integer
Text
stamp :: Integer
name :: Text
stamp :: Integer
name :: Text
..}

type Table a = Map Ident a