0 | module Control.Comonad.Store.Interface
 1 |
 2 | import Control.Comonad
 3 | import Control.Comonad.Env.Env
 4 | import Control.Comonad.Store.Store
 5 | import Control.Comonad.Traced.Traced
 6 | import Control.Comonad.Trans
 7 |
 8 | %default total
 9 |
10 | public export
11 | interface Comonad w => ComonadStore s w | w where
12 |   pos : w a -> s
13 |
14 |   peek : s -> w a -> a
15 |
16 |   peeks : (s -> s) -> w a -> a
17 |   peeks f w = peek (f (pos w)) w
18 |
19 |   seek : s -> w a -> w a
20 |   seek s = peek s . duplicate
21 |
22 |   seeks : (s -> s) -> w a -> w a
23 |   seeks f = peeks f . duplicate
24 |
25 |   experiment : Functor f => (s -> f s) -> w a -> f a
26 |   experiment f w = map (`peek` w) (f (pos w))
27 |
28 | --------------------------------------------------------------------------------
29 | --          Utilities
30 | --------------------------------------------------------------------------------
31 |
32 | public export %inline
33 | lowerPos : (ComonadTrans t, ComonadStore s w) => t w a -> s
34 | lowerPos = pos . lower
35 |
36 | public export %inline
37 | lowerPeek : (ComonadTrans t, ComonadStore s w) => s -> t w a -> a
38 | lowerPeek s = peek s . lower
39 |
40 | public export %inline
41 | lowerExperiment :  (ComonadTrans t, ComonadStore s w, Functor f)
42 |                 => (s -> f s) -> t w a -> f a
43 | lowerExperiment f = experiment f . lower
44 |
45 | --------------------------------------------------------------------------------
46 | --          Implementations
47 | --------------------------------------------------------------------------------
48 |
49 | public export %inline
50 | ComonadStore s w => ComonadStore s (EnvT e w) where
51 |   pos        = lowerPos
52 |   peek       = lowerPeek
53 |   experiment = lowerExperiment
54 |
55 | public export %inline
56 | Comonad w => ComonadStore s (StoreT s w) where
57 |   pos                          = val
58 |   peek s (MkStoreT run _)      = extract run s
59 |   seek s                       = { val := s }
60 |   seeks f                      = { val $= f }
61 |   experiment f (MkStoreT wf s) = extract wf <$> f s
62 |
63 | public export %inline
64 | (ComonadStore s w, Monoid m) => ComonadStore s (TracedT m w) where
65 |   pos        = lowerPos
66 |   peek       = lowerPeek
67 |   experiment = lowerExperiment
68 |