{-# 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
(
UnusedId
, getNextUnusedId
, 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 IdMap = M.Map T.Text Int
type UnusedId = PS.State IdMap
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)
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