{-# LANGUAGE FlexibleContexts              #-}
{-# LANGUAGE OverloadedStrings             #-}
{-# LANGUAGE DataKinds                     #-}
{-# LANGUAGE PolyKinds                     #-}
{-# LANGUAGE GADTs                         #-}
{-# LANGUAGE TypeOperators                 #-}
{-# LANGUAGE ScopedTypeVariables           #-}
{-# LANGUAGE TypeApplications              #-}
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
{-|
Module      : Knit.Effect.UnusedId
Description : Wrapper around Polysemy.State for generating unused ids with a given prefix
Copyright   : (c) Adam Conner-Sax 2019
License     : BSD-3-Clause
Maintainer  : adam_conner_sax@yahoo.com
Stability   : experimental

This module contains a state effect used to maintain a map of unused id numbers which can be used for HTML
ids or figure numbering.

-}
module Knit.Effect.UnusedId
  (
    -- * Effect
    UnusedId

    -- * actions    
  , getNextUnusedId

    -- * interpretations
  , runUnusedId
  )
where

import qualified Polysemy                      as P
import qualified Polysemy.State                as PS

import qualified Data.Map                      as M
import qualified Data.Text                     as T
import           Data.Maybe                     ( fromMaybe )

-- | Type alias for the dictionary ('M.Map') of current last used id at each prefix.
type IdMap = M.Map T.Text Int

-- | Type alias for 'Polysemy.State' using "IdMap".
type UnusedId = PS.State IdMap

-- | Get an unused id with prefix as specified.  Useful for figures, etc.
getNextUnusedId :: P.Member UnusedId r => T.Text -> P.Sem r T.Text
getNextUnusedId :: Text -> Sem r Text
getNextUnusedId prefixT :: Text
prefixT = do
  IdMap
idMap <- forall (r :: [Effect]).
MemberWithError (State IdMap) r =>
Sem r IdMap
forall s (r :: [Effect]). MemberWithError (State s) r => Sem r s
PS.get @IdMap
  let nextId :: Int
nextId = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Text -> IdMap -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
prefixT IdMap
idMap
  IdMap -> Sem r ()
forall s (r :: [Effect]).
MemberWithError (State s) r =>
s -> Sem r ()
PS.put (IdMap -> Sem r ()) -> IdMap -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text -> Int -> IdMap -> IdMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
prefixT (Int
nextId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) IdMap
idMap
  Text -> Sem r Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Sem r Text) -> Text -> Sem r Text
forall a b. (a -> b) -> a -> b
$ Text
prefixT Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
nextId)

-- | Run the UnusedId effect and throw away the state.
runUnusedId :: P.Sem (UnusedId ': r) a -> P.Sem r a
runUnusedId :: Sem (State IdMap : r) a -> Sem r a
runUnusedId = ((IdMap, a) -> a) -> Sem r (IdMap, a) -> Sem r a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IdMap, a) -> a
forall a b. (a, b) -> b
snd (Sem r (IdMap, a) -> Sem r a)
-> (Sem (State IdMap : r) a -> Sem r (IdMap, a))
-> Sem (State IdMap : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdMap -> Sem (State IdMap : r) a -> Sem r (IdMap, a)
forall s (r :: [Effect]) a.
s -> Sem (State s : r) a -> Sem r (s, a)
PS.runState IdMap
forall k a. Map k a
M.empty