{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE UndecidableInstances #-}

module Blanks.Located
  ( Colocated (..)
  , Located (..)
  , askColocated
  , colocated
  , runColocated
  ) where

import Control.DeepSeq (NFData)
import Control.Monad (ap)
import Control.Monad.Reader (MonadReader, Reader, ReaderT (..), ask, reader, runReader)
import Control.Monad.Writer (MonadWriter (..))
import Data.Distributive (Distributive (..))
import Data.Functor.Adjunction (Adjunction (..))
import Data.Functor.Rep (Representable)
import GHC.Generics (Generic)

-- | This is basically the 'Env' comonad, but with the env strict.
-- It's also basically the 'Writer' monad in certain contexts.
-- We define a new, non-transforming datatype so we can pattern-match.
data Located l a = Located
  { Located l a -> l
locatedLoc :: !l
  , Located l a -> a
locatedVal :: a
  } deriving stock (Located l a -> Located l a -> Bool
(Located l a -> Located l a -> Bool)
-> (Located l a -> Located l a -> Bool) -> Eq (Located l a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall l a. (Eq l, Eq a) => Located l a -> Located l a -> Bool
/= :: Located l a -> Located l a -> Bool
$c/= :: forall l a. (Eq l, Eq a) => Located l a -> Located l a -> Bool
== :: Located l a -> Located l a -> Bool
$c== :: forall l a. (Eq l, Eq a) => Located l a -> Located l a -> Bool
Eq, Int -> Located l a -> ShowS
[Located l a] -> ShowS
Located l a -> String
(Int -> Located l a -> ShowS)
-> (Located l a -> String)
-> ([Located l a] -> ShowS)
-> Show (Located l a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall l a. (Show l, Show a) => Int -> Located l a -> ShowS
forall l a. (Show l, Show a) => [Located l a] -> ShowS
forall l a. (Show l, Show a) => Located l a -> String
showList :: [Located l a] -> ShowS
$cshowList :: forall l a. (Show l, Show a) => [Located l a] -> ShowS
show :: Located l a -> String
$cshow :: forall l a. (Show l, Show a) => Located l a -> String
showsPrec :: Int -> Located l a -> ShowS
$cshowsPrec :: forall l a. (Show l, Show a) => Int -> Located l a -> ShowS
Show, a -> Located l b -> Located l a
(a -> b) -> Located l a -> Located l b
(forall a b. (a -> b) -> Located l a -> Located l b)
-> (forall a b. a -> Located l b -> Located l a)
-> Functor (Located l)
forall a b. a -> Located l b -> Located l a
forall a b. (a -> b) -> Located l a -> Located l b
forall l a b. a -> Located l b -> Located l a
forall l a b. (a -> b) -> Located l a -> Located l b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Located l b -> Located l a
$c<$ :: forall l a b. a -> Located l b -> Located l a
fmap :: (a -> b) -> Located l a -> Located l b
$cfmap :: forall l a b. (a -> b) -> Located l a -> Located l b
Functor, Located l a -> Bool
(a -> m) -> Located l a -> m
(a -> b -> b) -> b -> Located l a -> b
(forall m. Monoid m => Located l m -> m)
-> (forall m a. Monoid m => (a -> m) -> Located l a -> m)
-> (forall m a. Monoid m => (a -> m) -> Located l a -> m)
-> (forall a b. (a -> b -> b) -> b -> Located l a -> b)
-> (forall a b. (a -> b -> b) -> b -> Located l a -> b)
-> (forall b a. (b -> a -> b) -> b -> Located l a -> b)
-> (forall b a. (b -> a -> b) -> b -> Located l a -> b)
-> (forall a. (a -> a -> a) -> Located l a -> a)
-> (forall a. (a -> a -> a) -> Located l a -> a)
-> (forall a. Located l a -> [a])
-> (forall a. Located l a -> Bool)
-> (forall a. Located l a -> Int)
-> (forall a. Eq a => a -> Located l a -> Bool)
-> (forall a. Ord a => Located l a -> a)
-> (forall a. Ord a => Located l a -> a)
-> (forall a. Num a => Located l a -> a)
-> (forall a. Num a => Located l a -> a)
-> Foldable (Located l)
forall a. Eq a => a -> Located l a -> Bool
forall a. Num a => Located l a -> a
forall a. Ord a => Located l a -> a
forall m. Monoid m => Located l m -> m
forall a. Located l a -> Bool
forall a. Located l a -> Int
forall a. Located l a -> [a]
forall a. (a -> a -> a) -> Located l a -> a
forall l a. Eq a => a -> Located l a -> Bool
forall l a. Num a => Located l a -> a
forall l a. Ord a => Located l a -> a
forall m a. Monoid m => (a -> m) -> Located l a -> m
forall l m. Monoid m => Located l m -> m
forall l a. Located l a -> Bool
forall l a. Located l a -> Int
forall l a. Located l a -> [a]
forall b a. (b -> a -> b) -> b -> Located l a -> b
forall a b. (a -> b -> b) -> b -> Located l a -> b
forall l a. (a -> a -> a) -> Located l a -> a
forall l m a. Monoid m => (a -> m) -> Located l a -> m
forall l b a. (b -> a -> b) -> b -> Located l a -> b
forall l a b. (a -> b -> b) -> b -> Located l a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Located l a -> a
$cproduct :: forall l a. Num a => Located l a -> a
sum :: Located l a -> a
$csum :: forall l a. Num a => Located l a -> a
minimum :: Located l a -> a
$cminimum :: forall l a. Ord a => Located l a -> a
maximum :: Located l a -> a
$cmaximum :: forall l a. Ord a => Located l a -> a
elem :: a -> Located l a -> Bool
$celem :: forall l a. Eq a => a -> Located l a -> Bool
length :: Located l a -> Int
$clength :: forall l a. Located l a -> Int
null :: Located l a -> Bool
$cnull :: forall l a. Located l a -> Bool
toList :: Located l a -> [a]
$ctoList :: forall l a. Located l a -> [a]
foldl1 :: (a -> a -> a) -> Located l a -> a
$cfoldl1 :: forall l a. (a -> a -> a) -> Located l a -> a
foldr1 :: (a -> a -> a) -> Located l a -> a
$cfoldr1 :: forall l a. (a -> a -> a) -> Located l a -> a
foldl' :: (b -> a -> b) -> b -> Located l a -> b
$cfoldl' :: forall l b a. (b -> a -> b) -> b -> Located l a -> b
foldl :: (b -> a -> b) -> b -> Located l a -> b
$cfoldl :: forall l b a. (b -> a -> b) -> b -> Located l a -> b
foldr' :: (a -> b -> b) -> b -> Located l a -> b
$cfoldr' :: forall l a b. (a -> b -> b) -> b -> Located l a -> b
foldr :: (a -> b -> b) -> b -> Located l a -> b
$cfoldr :: forall l a b. (a -> b -> b) -> b -> Located l a -> b
foldMap' :: (a -> m) -> Located l a -> m
$cfoldMap' :: forall l m a. Monoid m => (a -> m) -> Located l a -> m
foldMap :: (a -> m) -> Located l a -> m
$cfoldMap :: forall l m a. Monoid m => (a -> m) -> Located l a -> m
fold :: Located l m -> m
$cfold :: forall l m. Monoid m => Located l m -> m
Foldable, Functor (Located l)
Foldable (Located l)
(Functor (Located l), Foldable (Located l)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Located l a -> f (Located l b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Located l (f a) -> f (Located l a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Located l a -> m (Located l b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Located l (m a) -> m (Located l a))
-> Traversable (Located l)
(a -> f b) -> Located l a -> f (Located l b)
forall l. Functor (Located l)
forall l. Foldable (Located l)
forall l (m :: * -> *) a.
Monad m =>
Located l (m a) -> m (Located l a)
forall l (f :: * -> *) a.
Applicative f =>
Located l (f a) -> f (Located l a)
forall l (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Located l a -> m (Located l b)
forall l (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Located l a -> f (Located l b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Located l (m a) -> m (Located l a)
forall (f :: * -> *) a.
Applicative f =>
Located l (f a) -> f (Located l a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Located l a -> m (Located l b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Located l a -> f (Located l b)
sequence :: Located l (m a) -> m (Located l a)
$csequence :: forall l (m :: * -> *) a.
Monad m =>
Located l (m a) -> m (Located l a)
mapM :: (a -> m b) -> Located l a -> m (Located l b)
$cmapM :: forall l (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Located l a -> m (Located l b)
sequenceA :: Located l (f a) -> f (Located l a)
$csequenceA :: forall l (f :: * -> *) a.
Applicative f =>
Located l (f a) -> f (Located l a)
traverse :: (a -> f b) -> Located l a -> f (Located l b)
$ctraverse :: forall l (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Located l a -> f (Located l b)
$cp2Traversable :: forall l. Foldable (Located l)
$cp1Traversable :: forall l. Functor (Located l)
Traversable, (forall x. Located l a -> Rep (Located l a) x)
-> (forall x. Rep (Located l a) x -> Located l a)
-> Generic (Located l a)
forall x. Rep (Located l a) x -> Located l a
forall x. Located l a -> Rep (Located l a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l a x. Rep (Located l a) x -> Located l a
forall l a x. Located l a -> Rep (Located l a) x
$cto :: forall l a x. Rep (Located l a) x -> Located l a
$cfrom :: forall l a x. Located l a -> Rep (Located l a) x
Generic)
    deriving anyclass (Located l a -> ()
(Located l a -> ()) -> NFData (Located l a)
forall a. (a -> ()) -> NFData a
forall l a. (NFData l, NFData a) => Located l a -> ()
rnf :: Located l a -> ()
$crnf :: forall l a. (NFData l, NFData a) => Located l a -> ()
NFData)

-- | Because we defined a unique left adjoint, we have to define the unique right.
newtype Colocated l a = Colocated
  { Colocated l a -> Reader l a
unColocated :: Reader l a
  } deriving newtype (a -> Colocated l b -> Colocated l a
(a -> b) -> Colocated l a -> Colocated l b
(forall a b. (a -> b) -> Colocated l a -> Colocated l b)
-> (forall a b. a -> Colocated l b -> Colocated l a)
-> Functor (Colocated l)
forall a b. a -> Colocated l b -> Colocated l a
forall a b. (a -> b) -> Colocated l a -> Colocated l b
forall l a b. a -> Colocated l b -> Colocated l a
forall l a b. (a -> b) -> Colocated l a -> Colocated l b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Colocated l b -> Colocated l a
$c<$ :: forall l a b. a -> Colocated l b -> Colocated l a
fmap :: (a -> b) -> Colocated l a -> Colocated l b
$cfmap :: forall l a b. (a -> b) -> Colocated l a -> Colocated l b
Functor, Functor (Colocated l)
a -> Colocated l a
Functor (Colocated l) =>
(forall a. a -> Colocated l a)
-> (forall a b.
    Colocated l (a -> b) -> Colocated l a -> Colocated l b)
-> (forall a b c.
    (a -> b -> c) -> Colocated l a -> Colocated l b -> Colocated l c)
-> (forall a b. Colocated l a -> Colocated l b -> Colocated l b)
-> (forall a b. Colocated l a -> Colocated l b -> Colocated l a)
-> Applicative (Colocated l)
Colocated l a -> Colocated l b -> Colocated l b
Colocated l a -> Colocated l b -> Colocated l a
Colocated l (a -> b) -> Colocated l a -> Colocated l b
(a -> b -> c) -> Colocated l a -> Colocated l b -> Colocated l c
forall l. Functor (Colocated l)
forall a. a -> Colocated l a
forall l a. a -> Colocated l a
forall a b. Colocated l a -> Colocated l b -> Colocated l a
forall a b. Colocated l a -> Colocated l b -> Colocated l b
forall a b. Colocated l (a -> b) -> Colocated l a -> Colocated l b
forall l a b. Colocated l a -> Colocated l b -> Colocated l a
forall l a b. Colocated l a -> Colocated l b -> Colocated l b
forall l a b.
Colocated l (a -> b) -> Colocated l a -> Colocated l b
forall a b c.
(a -> b -> c) -> Colocated l a -> Colocated l b -> Colocated l c
forall l a b c.
(a -> b -> c) -> Colocated l a -> Colocated l b -> Colocated l c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Colocated l a -> Colocated l b -> Colocated l a
$c<* :: forall l a b. Colocated l a -> Colocated l b -> Colocated l a
*> :: Colocated l a -> Colocated l b -> Colocated l b
$c*> :: forall l a b. Colocated l a -> Colocated l b -> Colocated l b
liftA2 :: (a -> b -> c) -> Colocated l a -> Colocated l b -> Colocated l c
$cliftA2 :: forall l a b c.
(a -> b -> c) -> Colocated l a -> Colocated l b -> Colocated l c
<*> :: Colocated l (a -> b) -> Colocated l a -> Colocated l b
$c<*> :: forall l a b.
Colocated l (a -> b) -> Colocated l a -> Colocated l b
pure :: a -> Colocated l a
$cpure :: forall l a. a -> Colocated l a
$cp1Applicative :: forall l. Functor (Colocated l)
Applicative, Applicative (Colocated l)
a -> Colocated l a
Applicative (Colocated l) =>
(forall a b.
 Colocated l a -> (a -> Colocated l b) -> Colocated l b)
-> (forall a b. Colocated l a -> Colocated l b -> Colocated l b)
-> (forall a. a -> Colocated l a)
-> Monad (Colocated l)
Colocated l a -> (a -> Colocated l b) -> Colocated l b
Colocated l a -> Colocated l b -> Colocated l b
forall l. Applicative (Colocated l)
forall a. a -> Colocated l a
forall l a. a -> Colocated l a
forall a b. Colocated l a -> Colocated l b -> Colocated l b
forall a b. Colocated l a -> (a -> Colocated l b) -> Colocated l b
forall l a b. Colocated l a -> Colocated l b -> Colocated l b
forall l a b.
Colocated l a -> (a -> Colocated l b) -> Colocated l b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Colocated l a
$creturn :: forall l a. a -> Colocated l a
>> :: Colocated l a -> Colocated l b -> Colocated l b
$c>> :: forall l a b. Colocated l a -> Colocated l b -> Colocated l b
>>= :: Colocated l a -> (a -> Colocated l b) -> Colocated l b
$c>>= :: forall l a b.
Colocated l a -> (a -> Colocated l b) -> Colocated l b
$cp1Monad :: forall l. Applicative (Colocated l)
Monad, MonadReader l, Distributive (Colocated l)
Distributive (Colocated l) =>
(forall a. (Rep (Colocated l) -> a) -> Colocated l a)
-> (forall a. Colocated l a -> Rep (Colocated l) -> a)
-> Representable (Colocated l)
Colocated l a -> Rep (Colocated l) -> a
(Rep (Colocated l) -> a) -> Colocated l a
forall l. Distributive (Colocated l)
forall a. Colocated l a -> Rep (Colocated l) -> a
forall a. (Rep (Colocated l) -> a) -> Colocated l a
forall l a. Colocated l a -> Rep (Colocated l) -> a
forall l a. (Rep (Colocated l) -> a) -> Colocated l a
forall (f :: * -> *).
Distributive f =>
(forall a. (Rep f -> a) -> f a)
-> (forall a. f a -> Rep f -> a) -> Representable f
index :: Colocated l a -> Rep (Colocated l) -> a
$cindex :: forall l a. Colocated l a -> Rep (Colocated l) -> a
tabulate :: (Rep (Colocated l) -> a) -> Colocated l a
$ctabulate :: forall l a. (Rep (Colocated l) -> a) -> Colocated l a
$cp1Representable :: forall l. Distributive (Colocated l)
Representable)

colocated :: (l -> a) -> Colocated l a
colocated :: (l -> a) -> Colocated l a
colocated f :: l -> a
f = Reader l a -> Colocated l a
forall l a. Reader l a -> Colocated l a
Colocated ((l -> a) -> Reader l a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader l -> a
f)

askColocated :: Colocated l l
askColocated :: Colocated l l
askColocated = Reader l l -> Colocated l l
forall l a. Reader l a -> Colocated l a
Colocated Reader l l
forall r (m :: * -> *). MonadReader r m => m r
ask

runColocated :: Colocated l a -> l -> a
runColocated :: Colocated l a -> l -> a
runColocated = Reader l a -> l -> a
forall r a. Reader r a -> r -> a
runReader (Reader l a -> l -> a)
-> (Colocated l a -> Reader l a) -> Colocated l a -> l -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colocated l a -> Reader l a
forall l a. Colocated l a -> Reader l a
unColocated

instance Distributive (Colocated l) where
  distribute :: f (Colocated l a) -> Colocated l (f a)
distribute = Reader l (f a) -> Colocated l (f a)
forall l a. Reader l a -> Colocated l a
Colocated (Reader l (f a) -> Colocated l (f a))
-> (f (Colocated l a) -> Reader l (f a))
-> f (Colocated l a)
-> Colocated l (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (ReaderT l Identity a) -> Reader l (f a)
forall (g :: * -> *) (f :: * -> *) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
distribute (f (ReaderT l Identity a) -> Reader l (f a))
-> (f (Colocated l a) -> f (ReaderT l Identity a))
-> f (Colocated l a)
-> Reader l (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Colocated l a -> ReaderT l Identity a)
-> f (Colocated l a) -> f (ReaderT l Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Colocated l a -> ReaderT l Identity a
forall l a. Colocated l a -> Reader l a
unColocated

instance Adjunction (Located l) (Colocated l) where
  leftAdjunct :: (Located l a -> b) -> a -> Colocated l b
leftAdjunct v :: Located l a -> b
v a :: a
a = (l -> b) -> Colocated l b
forall l a. (l -> a) -> Colocated l a
colocated (Located l a -> b
v (Located l a -> b) -> (l -> Located l a) -> l -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (l -> a -> Located l a) -> a -> l -> Located l a
forall a b c. (a -> b -> c) -> b -> a -> c
flip l -> a -> Located l a
forall l a. l -> a -> Located l a
Located a
a)
  rightAdjunct :: (a -> Colocated l b) -> Located l a -> b
rightAdjunct h :: a -> Colocated l b
h (Located l :: l
l a :: a
a) = Colocated l b -> l -> b
forall l a. Colocated l a -> l -> a
runColocated (a -> Colocated l b
h a
a) l
l

instance Monoid l => Applicative (Located l) where
  pure :: a -> Located l a
pure = l -> a -> Located l a
forall l a. l -> a -> Located l a
Located l
forall a. Monoid a => a
mempty
  <*> :: Located l (a -> b) -> Located l a -> Located l b
(<*>) = Located l (a -> b) -> Located l a -> Located l b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monoid l => Monad (Located l) where
  return :: a -> Located l a
return = a -> Located l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Located l :: l
l a :: a
a >>= :: Located l a -> (a -> Located l b) -> Located l b
>>= f :: a -> Located l b
f = let Located p :: l
p b :: b
b = a -> Located l b
f a
a in l -> b -> Located l b
forall l a. l -> a -> Located l a
Located (l
l l -> l -> l
forall a. Semigroup a => a -> a -> a
<> l
p) b
b

instance Monoid l => MonadWriter l (Located l) where
  writer :: (a, l) -> Located l a
writer (a :: a
a, l :: l
l) = l -> a -> Located l a
forall l a. l -> a -> Located l a
Located l
l a
a
  tell :: l -> Located l ()
tell l :: l
l = l -> () -> Located l ()
forall l a. l -> a -> Located l a
Located l
l ()
  listen :: Located l a -> Located l (a, l)
listen (Located l :: l
l a :: a
a) = l -> (a, l) -> Located l (a, l)
forall l a. l -> a -> Located l a
Located l
l (a
a, l
l)
  pass :: Located l (a, l -> l) -> Located l a
pass (Located l :: l
l (a :: a
a, f :: l -> l
f)) = l -> a -> Located l a
forall l a. l -> a -> Located l a
Located (l -> l
f l
l) a
a