module OpcXmlDaClient.XmlBuilder.Identified where

import qualified Acc
import qualified Data.HashMap.Strict as HashMap
import qualified OpcXmlDaClient.Base.HashMap as HashMap
import OpcXmlDaClient.Base.Prelude

-- |
-- Abstraction over incremental indexed value generation.
--
-- Useful for such things as generating aliases.
data Identified k v r
  = Identified (Acc.Acc k) ((k -> v) -> r)

deriving instance Functor (Identified k v)

instance Applicative (Identified k v) where
  pure :: a -> Identified k v a
pure a
x = Acc k -> ((k -> v) -> a) -> Identified k v a
forall k v r. Acc k -> ((k -> v) -> r) -> Identified k v r
Identified Acc k
forall a. Monoid a => a
mempty (a -> (k -> v) -> a
forall a b. a -> b -> a
const a
x)
  Identified Acc k
keysL (k -> v) -> a -> b
buildL <*> :: Identified k v (a -> b) -> Identified k v a -> Identified k v b
<*> Identified Acc k
keysR (k -> v) -> a
buildR =
    Acc k -> ((k -> v) -> b) -> Identified k v b
forall k v r. Acc k -> ((k -> v) -> r) -> Identified k v r
Identified (Acc k
keysL Acc k -> Acc k -> Acc k
forall a. Semigroup a => a -> a -> a
<> Acc k
keysR) (\k -> v
map -> (k -> v) -> a -> b
buildL k -> v
map ((k -> v) -> a
buildR k -> v
map))

run :: (Hashable k, Eq k) => Identified k v a -> (Int -> v) -> (a, [(k, v)])
run :: Identified k v a -> (Int -> v) -> (a, [(k, v)])
run (Identified Acc k
uriAcc (k -> v) -> a
build) Int -> v
proj =
  Acc k -> (Int -> v) -> HashMap k v
forall (f :: * -> *) k v.
(Foldable f, Hashable k, Eq k) =>
f k -> (Int -> v) -> HashMap k v
HashMap.autoincrementedFoldable Acc k
uriAcc Int -> v
proj
    HashMap k v -> (HashMap k v -> (a, [(k, v)])) -> (a, [(k, v)])
forall a b. a -> (a -> b) -> b
& \HashMap k v
map -> ((k -> v) -> a
build (\k
k -> v -> k -> HashMap k v -> v
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.lookupDefault ([Char] -> v
forall a. HasCallStack => [Char] -> a
error [Char]
"Bug") k
k HashMap k v
map), HashMap k v -> [(k, v)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap k v
map)

-- |
-- Register a key if it hasn't been registered already,
-- and build a result in the scope of the incremental value associated with the key.
identifying :: k -> (v -> a) -> Identified k v a
identifying :: k -> (v -> a) -> Identified k v a
identifying k
uri v -> a
byAlias =
  Acc k -> ((k -> v) -> a) -> Identified k v a
forall k v r. Acc k -> ((k -> v) -> r) -> Identified k v r
Identified (k -> Acc k
forall (f :: * -> *) a. Applicative f => a -> f a
pure k
uri) (\k -> v
map -> v -> a
byAlias (k -> v
map k
uri))