{-# LANGUAGE OverloadedStrings #-}

-- | A shared-element representation of web page communication.
module Web.Rep.Shared
  ( RepF (..),
    Rep,
    oneRep,
    SharedRepF (..),
    SharedRep,
    runOnce,
    zeroState,
    register,
    message,
    genName,
    genNamePre,
  )
where

import Control.Monad
import Control.Monad.State.Lazy
import Data.Biapplicative
import Data.ByteString (ByteString)
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import MarkupParse
import Optics.Core
import Optics.Zoom

-- |
-- Information contained in a web page can usually be considered to be isomorphic to a map of named values - a 'HashMap'. This is especially true when considering a differential of information contained in a web page. Looking at a page from the outside, it often looks like a streaming differential of a hashmap.
--
-- RepF consists of an underlying value being represented, and, given a hashmap state, a way to produce a representation of the underlying value (or error), in another domain, together with the potential to alter the hashmap state.
data RepF r a = Rep
  { forall r a. RepF r a -> r
rep :: r,
    forall r a.
RepF r a
-> HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString a)
make :: HashMap ByteString ByteString -> (HashMap ByteString ByteString, Either ByteString a)
  }
  deriving ((forall a b. (a -> b) -> RepF r a -> RepF r b)
-> (forall a b. a -> RepF r b -> RepF r a) -> Functor (RepF r)
forall a b. a -> RepF r b -> RepF r a
forall a b. (a -> b) -> RepF r a -> RepF r b
forall r a b. a -> RepF r b -> RepF r a
forall r a b. (a -> b) -> RepF r a -> RepF r b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall r a b. (a -> b) -> RepF r a -> RepF r b
fmap :: forall a b. (a -> b) -> RepF r a -> RepF r b
$c<$ :: forall r a b. a -> RepF r b -> RepF r a
<$ :: forall a b. a -> RepF r b -> RepF r a
Functor)

-- | the common usage, where the representation domain is Html
type Rep a = RepF Markup a

instance (Semigroup r) => Semigroup (RepF r a) where
  (Rep r
r0 HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString a)
a0) <> :: RepF r a -> RepF r a -> RepF r a
<> (Rep r
r1 HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString a)
a1) =
    r
-> (HashMap ByteString ByteString
    -> (HashMap ByteString ByteString, Either ByteString a))
-> RepF r a
forall r a.
r
-> (HashMap ByteString ByteString
    -> (HashMap ByteString ByteString, Either ByteString a))
-> RepF r a
Rep
      (r
r0 r -> r -> r
forall a. Semigroup a => a -> a -> a
<> r
r1)
      (\HashMap ByteString ByteString
hm -> let (HashMap ByteString ByteString
hm', Either ByteString a
x') = HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString a)
a0 HashMap ByteString ByteString
hm in let (HashMap ByteString ByteString
hm'', Either ByteString a
x'') = HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString a)
a1 HashMap ByteString ByteString
hm' in (HashMap ByteString ByteString
hm'', Either ByteString a
x' Either ByteString a -> Either ByteString a -> Either ByteString a
forall a. Semigroup a => a -> a -> a
<> Either ByteString a
x''))

instance (Monoid a, Monoid r) => Monoid (RepF r a) where
  mempty :: RepF r a
  mempty :: RepF r a
mempty = r
-> (HashMap ByteString ByteString
    -> (HashMap ByteString ByteString, Either ByteString a))
-> RepF r a
forall r a.
r
-> (HashMap ByteString ByteString
    -> (HashMap ByteString ByteString, Either ByteString a))
-> RepF r a
Rep r
forall a. Monoid a => a
mempty (,a -> Either ByteString a
forall a b. b -> Either a b
Right a
forall a. Monoid a => a
mempty)

  mappend :: RepF r a -> RepF r a -> RepF r a
mappend = RepF r a -> RepF r a -> RepF r a
forall a. Semigroup a => a -> a -> a
(<>)

instance Bifunctor RepF where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> RepF a c -> RepF b d
bimap a -> b
f c -> d
g (Rep a
r HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString c)
a) = b
-> (HashMap ByteString ByteString
    -> (HashMap ByteString ByteString, Either ByteString d))
-> RepF b d
forall r a.
r
-> (HashMap ByteString ByteString
    -> (HashMap ByteString ByteString, Either ByteString a))
-> RepF r a
Rep (a -> b
f a
r) ((Either ByteString c -> Either ByteString d)
-> (HashMap ByteString ByteString, Either ByteString c)
-> (HashMap ByteString ByteString, Either ByteString d)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((c -> d) -> Either ByteString c -> Either ByteString d
forall a b. (a -> b) -> Either ByteString a -> Either ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g) ((HashMap ByteString ByteString, Either ByteString c)
 -> (HashMap ByteString ByteString, Either ByteString d))
-> (HashMap ByteString ByteString
    -> (HashMap ByteString ByteString, Either ByteString c))
-> HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString c)
a)

instance Biapplicative RepF where
  bipure :: forall a b. a -> b -> RepF a b
bipure a
r b
a = a
-> (HashMap ByteString ByteString
    -> (HashMap ByteString ByteString, Either ByteString b))
-> RepF a b
forall r a.
r
-> (HashMap ByteString ByteString
    -> (HashMap ByteString ByteString, Either ByteString a))
-> RepF r a
Rep a
r (,b -> Either ByteString b
forall a b. b -> Either a b
Right b
a)

  (Rep a -> b
fr HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString (c -> d))
fa) <<*>> :: forall a b c d. RepF (a -> b) (c -> d) -> RepF a c -> RepF b d
<<*>> (Rep a
r HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString c)
a) =
    b
-> (HashMap ByteString ByteString
    -> (HashMap ByteString ByteString, Either ByteString d))
-> RepF b d
forall r a.
r
-> (HashMap ByteString ByteString
    -> (HashMap ByteString ByteString, Either ByteString a))
-> RepF r a
Rep
      (a -> b
fr a
r)
      ( \HashMap ByteString ByteString
hm ->
          let (HashMap ByteString ByteString
hm', Either ByteString c
a') = HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString c)
a HashMap ByteString ByteString
hm in let (HashMap ByteString ByteString
hm'', Either ByteString (c -> d)
fa') = HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString (c -> d))
fa HashMap ByteString ByteString
hm' in (HashMap ByteString ByteString
hm'', Either ByteString (c -> d)
fa' Either ByteString (c -> d)
-> Either ByteString c -> Either ByteString d
forall a b.
Either ByteString (a -> b)
-> Either ByteString a -> Either ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either ByteString c
a')
      )

instance (Monoid r) => Applicative (RepF r) where
  pure :: forall a. a -> RepF r a
pure = r -> a -> RepF r a
forall a b. a -> b -> RepF a b
forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
bipure r
forall a. Monoid a => a
mempty

  Rep r
fh HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString (a -> b))
fm <*> :: forall a b. RepF r (a -> b) -> RepF r a -> RepF r b
<*> Rep r
ah HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString a)
am =
    r
-> (HashMap ByteString ByteString
    -> (HashMap ByteString ByteString, Either ByteString b))
-> RepF r b
forall r a.
r
-> (HashMap ByteString ByteString
    -> (HashMap ByteString ByteString, Either ByteString a))
-> RepF r a
Rep
      (r
fh r -> r -> r
forall a. Semigroup a => a -> a -> a
<> r
ah)
      ( \HashMap ByteString ByteString
hm ->
          let (HashMap ByteString ByteString
hm', Either ByteString a
a') = HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString a)
am HashMap ByteString ByteString
hm in let (HashMap ByteString ByteString
hm'', Either ByteString (a -> b)
fa') = HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString (a -> b))
fm HashMap ByteString ByteString
hm' in (HashMap ByteString ByteString
hm'', Either ByteString (a -> b)
fa' Either ByteString (a -> b)
-> Either ByteString a -> Either ByteString b
forall a b.
Either ByteString (a -> b)
-> Either ByteString a -> Either ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either ByteString a
a')
      )

-- | stateful result of one step, given a 'Rep', and a monadic action.
-- Useful for testing and for initialising a page.
oneRep :: (Monad m) => Rep a -> (Rep a -> HashMap ByteString ByteString -> m ()) -> StateT (HashMap ByteString ByteString) m (HashMap ByteString ByteString, Either ByteString a)
oneRep :: forall (m :: * -> *) a.
Monad m =>
Rep a
-> (Rep a -> HashMap ByteString ByteString -> m ())
-> StateT
     (HashMap ByteString ByteString)
     m
     (HashMap ByteString ByteString, Either ByteString a)
oneRep r :: Rep a
r@(Rep Markup
_ HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString a)
fa) Rep a -> HashMap ByteString ByteString -> m ()
action = do
  HashMap ByteString ByteString
m <- StateT
  (HashMap ByteString ByteString) m (HashMap ByteString ByteString)
forall s (m :: * -> *). MonadState s m => m s
get
  let (HashMap ByteString ByteString
m', Either ByteString a
a) = HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString a)
fa HashMap ByteString ByteString
m
  HashMap ByteString ByteString
-> StateT (HashMap ByteString ByteString) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put HashMap ByteString ByteString
m'
  m () -> StateT (HashMap ByteString ByteString) m ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (HashMap ByteString ByteString) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT (HashMap ByteString ByteString) m ())
-> m () -> StateT (HashMap ByteString ByteString) m ()
forall a b. (a -> b) -> a -> b
$ Rep a -> HashMap ByteString ByteString -> m ()
action Rep a
r HashMap ByteString ByteString
m'
  (HashMap ByteString ByteString, Either ByteString a)
-> StateT
     (HashMap ByteString ByteString)
     m
     (HashMap ByteString ByteString, Either ByteString a)
forall a. a -> StateT (HashMap ByteString ByteString) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap ByteString ByteString
m', Either ByteString a
a)

-- |
-- Driven by the architecture of the DOM, web page components are compositional, and tree-like, where components are often composed of other components, and values are thus shared across components.
--
-- This is sometimes referred to as "observable sharing". See <http://hackage.haskell.org/package/data-reify data-reify> as another library that reifies this (pun intended), and provided the initial inspiration for this implementation.
--
-- unshare should only be run once, which is a terrible flaw that might be fixed by linear types.
newtype SharedRepF m r a = SharedRep
  { forall (m :: * -> *) r a.
SharedRepF m r a
-> StateT (Int, HashMap ByteString ByteString) m (RepF r a)
unshare :: StateT (Int, HashMap ByteString ByteString) m (RepF r a)
  }
  deriving ((forall a b. (a -> b) -> SharedRepF m r a -> SharedRepF m r b)
-> (forall a b. a -> SharedRepF m r b -> SharedRepF m r a)
-> Functor (SharedRepF m r)
forall a b. a -> SharedRepF m r b -> SharedRepF m r a
forall a b. (a -> b) -> SharedRepF m r a -> SharedRepF m r b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) r a b.
Functor m =>
a -> SharedRepF m r b -> SharedRepF m r a
forall (m :: * -> *) r a b.
Functor m =>
(a -> b) -> SharedRepF m r a -> SharedRepF m r b
$cfmap :: forall (m :: * -> *) r a b.
Functor m =>
(a -> b) -> SharedRepF m r a -> SharedRepF m r b
fmap :: forall a b. (a -> b) -> SharedRepF m r a -> SharedRepF m r b
$c<$ :: forall (m :: * -> *) r a b.
Functor m =>
a -> SharedRepF m r b -> SharedRepF m r a
<$ :: forall a b. a -> SharedRepF m r b -> SharedRepF m r a
Functor)

-- | default representation type of 'Html' ()
type SharedRep m a = SharedRepF m Markup a

instance (Functor m) => Bifunctor (SharedRepF m) where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> SharedRepF m a c -> SharedRepF m b d
bimap a -> b
f c -> d
g (SharedRep StateT (Int, HashMap ByteString ByteString) m (RepF a c)
s) = StateT (Int, HashMap ByteString ByteString) m (RepF b d)
-> SharedRepF m b d
forall (m :: * -> *) r a.
StateT (Int, HashMap ByteString ByteString) m (RepF r a)
-> SharedRepF m r a
SharedRep (StateT (Int, HashMap ByteString ByteString) m (RepF b d)
 -> SharedRepF m b d)
-> StateT (Int, HashMap ByteString ByteString) m (RepF b d)
-> SharedRepF m b d
forall a b. (a -> b) -> a -> b
$ (RepF a c -> RepF b d)
-> StateT (Int, HashMap ByteString ByteString) m (RepF a c)
-> StateT (Int, HashMap ByteString ByteString) m (RepF b d)
forall a b.
(a -> b)
-> StateT (Int, HashMap ByteString ByteString) m a
-> StateT (Int, HashMap ByteString ByteString) m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (c -> d) -> RepF a c -> RepF b d
forall a b c d. (a -> b) -> (c -> d) -> RepF a c -> RepF b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g) StateT (Int, HashMap ByteString ByteString) m (RepF a c)
s

instance (Monad m) => Biapplicative (SharedRepF m) where
  bipure :: forall a b. a -> b -> SharedRepF m a b
bipure a
r b
a = StateT (Int, HashMap ByteString ByteString) m (RepF a b)
-> SharedRepF m a b
forall (m :: * -> *) r a.
StateT (Int, HashMap ByteString ByteString) m (RepF r a)
-> SharedRepF m r a
SharedRep (StateT (Int, HashMap ByteString ByteString) m (RepF a b)
 -> SharedRepF m a b)
-> StateT (Int, HashMap ByteString ByteString) m (RepF a b)
-> SharedRepF m a b
forall a b. (a -> b) -> a -> b
$ RepF a b
-> StateT (Int, HashMap ByteString ByteString) m (RepF a b)
forall a. a -> StateT (Int, HashMap ByteString ByteString) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RepF a b
 -> StateT (Int, HashMap ByteString ByteString) m (RepF a b))
-> RepF a b
-> StateT (Int, HashMap ByteString ByteString) m (RepF a b)
forall a b. (a -> b) -> a -> b
$ a -> b -> RepF a b
forall a b. a -> b -> RepF a b
forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
bipure a
r b
a

  (SharedRep StateT
  (Int, HashMap ByteString ByteString) m (RepF (a -> b) (c -> d))
f) <<*>> :: forall a b c d.
SharedRepF m (a -> b) (c -> d)
-> SharedRepF m a c -> SharedRepF m b d
<<*>> (SharedRep StateT (Int, HashMap ByteString ByteString) m (RepF a c)
a) = StateT (Int, HashMap ByteString ByteString) m (RepF b d)
-> SharedRepF m b d
forall (m :: * -> *) r a.
StateT (Int, HashMap ByteString ByteString) m (RepF r a)
-> SharedRepF m r a
SharedRep (StateT (Int, HashMap ByteString ByteString) m (RepF b d)
 -> SharedRepF m b d)
-> StateT (Int, HashMap ByteString ByteString) m (RepF b d)
-> SharedRepF m b d
forall a b. (a -> b) -> a -> b
$ (RepF (a -> b) (c -> d) -> RepF a c -> RepF b d)
-> StateT
     (Int, HashMap ByteString ByteString) m (RepF (a -> b) (c -> d))
-> StateT (Int, HashMap ByteString ByteString) m (RepF a c)
-> StateT (Int, HashMap ByteString ByteString) m (RepF b d)
forall a b c.
(a -> b -> c)
-> StateT (Int, HashMap ByteString ByteString) m a
-> StateT (Int, HashMap ByteString ByteString) m b
-> StateT (Int, HashMap ByteString ByteString) m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 RepF (a -> b) (c -> d) -> RepF a c -> RepF b d
forall a b c d. RepF (a -> b) (c -> d) -> RepF a c -> RepF b d
forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
(<<*>>) StateT
  (Int, HashMap ByteString ByteString) m (RepF (a -> b) (c -> d))
f StateT (Int, HashMap ByteString ByteString) m (RepF a c)
a

instance (Monad m, Monoid r) => Applicative (SharedRepF m r) where
  pure :: forall a. a -> SharedRepF m r a
pure = r -> a -> SharedRepF m r a
forall a b. a -> b -> SharedRepF m a b
forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
bipure r
forall a. Monoid a => a
mempty

  SharedRep StateT (Int, HashMap ByteString ByteString) m (RepF r (a -> b))
f <*> :: forall a b.
SharedRepF m r (a -> b) -> SharedRepF m r a -> SharedRepF m r b
<*> SharedRep StateT (Int, HashMap ByteString ByteString) m (RepF r a)
a = StateT (Int, HashMap ByteString ByteString) m (RepF r b)
-> SharedRepF m r b
forall (m :: * -> *) r a.
StateT (Int, HashMap ByteString ByteString) m (RepF r a)
-> SharedRepF m r a
SharedRep (StateT (Int, HashMap ByteString ByteString) m (RepF r b)
 -> SharedRepF m r b)
-> StateT (Int, HashMap ByteString ByteString) m (RepF r b)
-> SharedRepF m r b
forall a b. (a -> b) -> a -> b
$ (RepF r (a -> b) -> RepF r a -> RepF r b)
-> StateT (Int, HashMap ByteString ByteString) m (RepF r (a -> b))
-> StateT (Int, HashMap ByteString ByteString) m (RepF r a)
-> StateT (Int, HashMap ByteString ByteString) m (RepF r b)
forall a b c.
(a -> b -> c)
-> StateT (Int, HashMap ByteString ByteString) m a
-> StateT (Int, HashMap ByteString ByteString) m b
-> StateT (Int, HashMap ByteString ByteString) m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 RepF r (a -> b) -> RepF r a -> RepF r b
forall a b. RepF r (a -> b) -> RepF r a -> RepF r b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) StateT (Int, HashMap ByteString ByteString) m (RepF r (a -> b))
f StateT (Int, HashMap ByteString ByteString) m (RepF r a)
a

-- | name supply for elements of a 'SharedRep'
genName :: (MonadState Int m) => m ByteString
genName :: forall (m :: * -> *). MonadState Int m => m ByteString
genName = do
  (Int -> Int) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  String -> ByteString
strToUtf8 (String -> ByteString) -> (Int -> String) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> ByteString) -> m Int -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Int
forall s (m :: * -> *). MonadState s m => m s
get

-- | sometimes a number doesn't work properly in html (or js???), and an alpha prefix seems to help
genNamePre :: (MonadState Int m) => ByteString -> m ByteString
genNamePre :: forall (m :: * -> *).
MonadState Int m =>
ByteString -> m ByteString
genNamePre ByteString
p = (ByteString
p <>) (ByteString -> ByteString) -> m ByteString -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ByteString
forall (m :: * -> *). MonadState Int m => m ByteString
genName

-- | Create a sharedRep
register ::
  (Monad m) =>
  -- | Parser
  (ByteString -> Either ByteString a) ->
  -- | Printer
  (a -> ByteString) ->
  -- | create initial object from name and initial value
  (ByteString -> a -> r) ->
  -- | initial value
  a ->
  SharedRepF m r a
register :: forall (m :: * -> *) a r.
Monad m =>
(ByteString -> Either ByteString a)
-> (a -> ByteString)
-> (ByteString -> a -> r)
-> a
-> SharedRepF m r a
register ByteString -> Either ByteString a
p a -> ByteString
pr ByteString -> a -> r
f a
a =
  StateT (Int, HashMap ByteString ByteString) m (RepF r a)
-> SharedRepF m r a
forall (m :: * -> *) r a.
StateT (Int, HashMap ByteString ByteString) m (RepF r a)
-> SharedRepF m r a
SharedRep (StateT (Int, HashMap ByteString ByteString) m (RepF r a)
 -> SharedRepF m r a)
-> StateT (Int, HashMap ByteString ByteString) m (RepF r a)
-> SharedRepF m r a
forall a b. (a -> b) -> a -> b
$ do
    ByteString
name <- Optic' A_Lens NoIx (Int, HashMap ByteString ByteString) Int
-> StateT Int m ByteString
-> StateT (Int, HashMap ByteString ByteString) m ByteString
forall k (is :: IxList) c.
Is k A_Lens =>
Optic' k is (Int, HashMap ByteString ByteString) Int
-> StateT Int m c
-> StateT (Int, HashMap ByteString ByteString) m c
forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom Optic' A_Lens NoIx (Int, HashMap ByteString ByteString) Int
forall s t a b. Field1 s t a b => Lens s t a b
_1 StateT Int m ByteString
forall (m :: * -> *). MonadState Int m => m ByteString
genName
    Optic'
  A_Lens
  NoIx
  (Int, HashMap ByteString ByteString)
  (HashMap ByteString ByteString)
-> StateT (HashMap ByteString ByteString) m ()
-> StateT (Int, HashMap ByteString ByteString) m ()
forall k (is :: IxList) c.
Is k A_Lens =>
Optic'
  k
  is
  (Int, HashMap ByteString ByteString)
  (HashMap ByteString ByteString)
-> StateT (HashMap ByteString ByteString) m c
-> StateT (Int, HashMap ByteString ByteString) m c
forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom Optic'
  A_Lens
  NoIx
  (Int, HashMap ByteString ByteString)
  (HashMap ByteString ByteString)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((HashMap ByteString ByteString -> HashMap ByteString ByteString)
-> StateT (HashMap ByteString ByteString) m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ByteString
-> ByteString
-> HashMap ByteString ByteString
-> HashMap ByteString ByteString
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert ByteString
name (a -> ByteString
pr a
a)))
    RepF r a
-> StateT (Int, HashMap ByteString ByteString) m (RepF r a)
forall a. a -> StateT (Int, HashMap ByteString ByteString) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RepF r a
 -> StateT (Int, HashMap ByteString ByteString) m (RepF r a))
-> RepF r a
-> StateT (Int, HashMap ByteString ByteString) m (RepF r a)
forall a b. (a -> b) -> a -> b
$
      r
-> (HashMap ByteString ByteString
    -> (HashMap ByteString ByteString, Either ByteString a))
-> RepF r a
forall r a.
r
-> (HashMap ByteString ByteString
    -> (HashMap ByteString ByteString, Either ByteString a))
-> RepF r a
Rep
        (ByteString -> a -> r
f ByteString
name a
a)
        ( \HashMap ByteString ByteString
s ->
            ( HashMap ByteString ByteString
s,
              Either ByteString (Either ByteString a) -> Either ByteString a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either ByteString (Either ByteString a) -> Either ByteString a)
-> Either ByteString (Either ByteString a) -> Either ByteString a
forall a b. (a -> b) -> a -> b
$
                Either ByteString (Either ByteString a)
-> (ByteString -> Either ByteString (Either ByteString a))
-> Maybe ByteString
-> Either ByteString (Either ByteString a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                  (ByteString -> Either ByteString (Either ByteString a)
forall a b. a -> Either a b
Left ByteString
"lookup failed")
                  (Either ByteString a -> Either ByteString (Either ByteString a)
forall a b. b -> Either a b
Right (Either ByteString a -> Either ByteString (Either ByteString a))
-> (ByteString -> Either ByteString a)
-> ByteString
-> Either ByteString (Either ByteString a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Either ByteString a)
-> (a -> Either ByteString a)
-> Either ByteString a
-> Either ByteString a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> Either ByteString a
forall a b. a -> Either a b
Left (ByteString -> Either ByteString a)
-> (ByteString -> ByteString) -> ByteString -> Either ByteString a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ByteString
x -> ByteString
name ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
": " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
x)) a -> Either ByteString a
forall a b. b -> Either a b
Right (Either ByteString a -> Either ByteString a)
-> (ByteString -> Either ByteString a)
-> ByteString
-> Either ByteString a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ByteString a
p)
                  (ByteString -> HashMap ByteString ByteString -> Maybe ByteString
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup ByteString
name HashMap ByteString ByteString
s)
            )
        )

-- | Like 'register', but does not put a value into the HashMap on instantiation, consumes the value when found in the HashMap, and substitutes a default on lookup failure
message ::
  (Monad m) =>
  -- | Parser
  (ByteString -> Either ByteString a) ->
  -- | create initial object from name and initial value
  (ByteString -> a -> r) ->
  -- | initial value
  a ->
  -- | default value
  a ->
  SharedRepF m r a
message :: forall (m :: * -> *) a r.
Monad m =>
(ByteString -> Either ByteString a)
-> (ByteString -> a -> r) -> a -> a -> SharedRepF m r a
message ByteString -> Either ByteString a
p ByteString -> a -> r
f a
a a
d =
  StateT (Int, HashMap ByteString ByteString) m (RepF r a)
-> SharedRepF m r a
forall (m :: * -> *) r a.
StateT (Int, HashMap ByteString ByteString) m (RepF r a)
-> SharedRepF m r a
SharedRep (StateT (Int, HashMap ByteString ByteString) m (RepF r a)
 -> SharedRepF m r a)
-> StateT (Int, HashMap ByteString ByteString) m (RepF r a)
-> SharedRepF m r a
forall a b. (a -> b) -> a -> b
$ do
    ByteString
n <- Optic' A_Lens NoIx (Int, HashMap ByteString ByteString) Int
-> StateT Int m ByteString
-> StateT (Int, HashMap ByteString ByteString) m ByteString
forall k (is :: IxList) c.
Is k A_Lens =>
Optic' k is (Int, HashMap ByteString ByteString) Int
-> StateT Int m c
-> StateT (Int, HashMap ByteString ByteString) m c
forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom Optic' A_Lens NoIx (Int, HashMap ByteString ByteString) Int
forall s t a b. Field1 s t a b => Lens s t a b
_1 StateT Int m ByteString
forall (m :: * -> *). MonadState Int m => m ByteString
genName
    RepF r a
-> StateT (Int, HashMap ByteString ByteString) m (RepF r a)
forall a. a -> StateT (Int, HashMap ByteString ByteString) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RepF r a
 -> StateT (Int, HashMap ByteString ByteString) m (RepF r a))
-> RepF r a
-> StateT (Int, HashMap ByteString ByteString) m (RepF r a)
forall a b. (a -> b) -> a -> b
$
      r
-> (HashMap ByteString ByteString
    -> (HashMap ByteString ByteString, Either ByteString a))
-> RepF r a
forall r a.
r
-> (HashMap ByteString ByteString
    -> (HashMap ByteString ByteString, Either ByteString a))
-> RepF r a
Rep
        (ByteString -> a -> r
f ByteString
n a
a)
        ( \HashMap ByteString ByteString
s ->
            ( ByteString
-> HashMap ByteString ByteString -> HashMap ByteString ByteString
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete ByteString
n HashMap ByteString ByteString
s,
              Either ByteString (Either ByteString a) -> Either ByteString a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either ByteString (Either ByteString a) -> Either ByteString a)
-> Either ByteString (Either ByteString a) -> Either ByteString a
forall a b. (a -> b) -> a -> b
$
                Either ByteString (Either ByteString a)
-> (ByteString -> Either ByteString (Either ByteString a))
-> Maybe ByteString
-> Either ByteString (Either ByteString a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Either ByteString a -> Either ByteString (Either ByteString a)
forall a b. b -> Either a b
Right (Either ByteString a -> Either ByteString (Either ByteString a))
-> Either ByteString a -> Either ByteString (Either ByteString a)
forall a b. (a -> b) -> a -> b
$ a -> Either ByteString a
forall a b. b -> Either a b
Right a
d) (Either ByteString a -> Either ByteString (Either ByteString a)
forall a b. b -> Either a b
Right (Either ByteString a -> Either ByteString (Either ByteString a))
-> (ByteString -> Either ByteString a)
-> ByteString
-> Either ByteString (Either ByteString a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ByteString a
p) (ByteString -> HashMap ByteString ByteString -> Maybe ByteString
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup ByteString
n HashMap ByteString ByteString
s)
            )
        )

runSharedRep :: SharedRepF m r a -> m (RepF r a, (Int, HashMap ByteString ByteString))
runSharedRep :: forall (m :: * -> *) r a.
SharedRepF m r a
-> m (RepF r a, (Int, HashMap ByteString ByteString))
runSharedRep SharedRepF m r a
s = (StateT (Int, HashMap ByteString ByteString) m (RepF r a)
 -> (Int, HashMap ByteString ByteString)
 -> m (RepF r a, (Int, HashMap ByteString ByteString)))
-> (Int, HashMap ByteString ByteString)
-> StateT (Int, HashMap ByteString ByteString) m (RepF r a)
-> m (RepF r a, (Int, HashMap ByteString ByteString))
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (Int, HashMap ByteString ByteString) m (RepF r a)
-> (Int, HashMap ByteString ByteString)
-> m (RepF r a, (Int, HashMap ByteString ByteString))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Int
0, HashMap ByteString ByteString
forall k v. HashMap k v
HashMap.empty) (StateT (Int, HashMap ByteString ByteString) m (RepF r a)
 -> m (RepF r a, (Int, HashMap ByteString ByteString)))
-> StateT (Int, HashMap ByteString ByteString) m (RepF r a)
-> m (RepF r a, (Int, HashMap ByteString ByteString))
forall a b. (a -> b) -> a -> b
$ SharedRepF m r a
-> StateT (Int, HashMap ByteString ByteString) m (RepF r a)
forall (m :: * -> *) r a.
SharedRepF m r a
-> StateT (Int, HashMap ByteString ByteString) m (RepF r a)
unshare SharedRepF m r a
s

-- | compute the initial state of a SharedRep (testing)
zeroState ::
  (Monad m) =>
  SharedRep m a ->
  m (Markup, (HashMap ByteString ByteString, Either ByteString a))
zeroState :: forall (m :: * -> *) a.
Monad m =>
SharedRep m a
-> m (Markup, (HashMap ByteString ByteString, Either ByteString a))
zeroState SharedRep m a
sr = do
  (Rep Markup
h HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString a)
fa, (Int
_, HashMap ByteString ByteString
m)) <- SharedRep m a
-> m (RepF Markup a, (Int, HashMap ByteString ByteString))
forall (m :: * -> *) r a.
SharedRepF m r a
-> m (RepF r a, (Int, HashMap ByteString ByteString))
runSharedRep SharedRep m a
sr
  (Markup, (HashMap ByteString ByteString, Either ByteString a))
-> m (Markup, (HashMap ByteString ByteString, Either ByteString a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Markup
h, HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString a)
fa HashMap ByteString ByteString
m)

-- | Compute the initial state of a SharedRep and then run an action once (see tests).
runOnce ::
  (Monad m) =>
  SharedRep m a ->
  (Markup -> HashMap ByteString ByteString -> m ()) ->
  m (HashMap ByteString ByteString, Either ByteString a)
runOnce :: forall (m :: * -> *) a.
Monad m =>
SharedRep m a
-> (Markup -> HashMap ByteString ByteString -> m ())
-> m (HashMap ByteString ByteString, Either ByteString a)
runOnce SharedRep m a
sr Markup -> HashMap ByteString ByteString -> m ()
action = do
  (Rep Markup
h HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString a)
fa, (Int
_, HashMap ByteString ByteString
m)) <- SharedRep m a
-> m (RepF Markup a, (Int, HashMap ByteString ByteString))
forall (m :: * -> *) r a.
SharedRepF m r a
-> m (RepF r a, (Int, HashMap ByteString ByteString))
runSharedRep SharedRep m a
sr
  Markup -> HashMap ByteString ByteString -> m ()
action Markup
h HashMap ByteString ByteString
m
  (HashMap ByteString ByteString, Either ByteString a)
-> m (HashMap ByteString ByteString, Either ByteString a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap ByteString ByteString
-> (HashMap ByteString ByteString, Either ByteString a)
fa HashMap ByteString ByteString
m)