{-# LANGUAGE CPP #-}

#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2012 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
----------------------------------------------------------------------------
module Bound.Var
  ( Var(..)
  , unvar
  , _B
  , _F
  ) where

import Control.DeepSeq
import Control.Monad (liftM, ap)
import Data.Hashable (Hashable(..))
import Data.Hashable.Lifted (Hashable1(..), Hashable2(..))
import Data.Bifunctor
import Data.Bifoldable
import qualified Data.Binary as Binary
import Data.Binary (Binary)
import Data.Bitraversable
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Functor.Classes
import Data.Profunctor
import qualified Data.Serialize as Serialize
import Data.Serialize (Serialize)
#ifdef __GLASGOW_HASKELL__
import Data.Data
import GHC.Generics
#endif

----------------------------------------------------------------------------
-- Bound and Free Variables
----------------------------------------------------------------------------

-- | \"I am not a number, I am a /free monad/!\"
--
-- A @'Var' b a@ is a variable that may either be \"bound\" ('B') or \"free\" ('F').
--
-- (It is also technically a free monad in the same near-trivial sense as
-- 'Either'.)
data Var b a
  = B b -- ^ this is a bound variable
  | F a -- ^ this is a free variable
  deriving
  ( Var b a -> Var b a -> Bool
(Var b a -> Var b a -> Bool)
-> (Var b a -> Var b a -> Bool) -> Eq (Var b a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall b a. (Eq b, Eq a) => Var b a -> Var b a -> Bool
/= :: Var b a -> Var b a -> Bool
$c/= :: forall b a. (Eq b, Eq a) => Var b a -> Var b a -> Bool
== :: Var b a -> Var b a -> Bool
$c== :: forall b a. (Eq b, Eq a) => Var b a -> Var b a -> Bool
Eq
  , Eq (Var b a)
Eq (Var b a)
-> (Var b a -> Var b a -> Ordering)
-> (Var b a -> Var b a -> Bool)
-> (Var b a -> Var b a -> Bool)
-> (Var b a -> Var b a -> Bool)
-> (Var b a -> Var b a -> Bool)
-> (Var b a -> Var b a -> Var b a)
-> (Var b a -> Var b a -> Var b a)
-> Ord (Var b a)
Var b a -> Var b a -> Bool
Var b a -> Var b a -> Ordering
Var b a -> Var b a -> Var b a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall b a. (Ord b, Ord a) => Eq (Var b a)
forall b a. (Ord b, Ord a) => Var b a -> Var b a -> Bool
forall b a. (Ord b, Ord a) => Var b a -> Var b a -> Ordering
forall b a. (Ord b, Ord a) => Var b a -> Var b a -> Var b a
min :: Var b a -> Var b a -> Var b a
$cmin :: forall b a. (Ord b, Ord a) => Var b a -> Var b a -> Var b a
max :: Var b a -> Var b a -> Var b a
$cmax :: forall b a. (Ord b, Ord a) => Var b a -> Var b a -> Var b a
>= :: Var b a -> Var b a -> Bool
$c>= :: forall b a. (Ord b, Ord a) => Var b a -> Var b a -> Bool
> :: Var b a -> Var b a -> Bool
$c> :: forall b a. (Ord b, Ord a) => Var b a -> Var b a -> Bool
<= :: Var b a -> Var b a -> Bool
$c<= :: forall b a. (Ord b, Ord a) => Var b a -> Var b a -> Bool
< :: Var b a -> Var b a -> Bool
$c< :: forall b a. (Ord b, Ord a) => Var b a -> Var b a -> Bool
compare :: Var b a -> Var b a -> Ordering
$ccompare :: forall b a. (Ord b, Ord a) => Var b a -> Var b a -> Ordering
$cp1Ord :: forall b a. (Ord b, Ord a) => Eq (Var b a)
Ord
  , Int -> Var b a -> ShowS
[Var b a] -> ShowS
Var b a -> String
(Int -> Var b a -> ShowS)
-> (Var b a -> String) -> ([Var b a] -> ShowS) -> Show (Var b a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall b a. (Show b, Show a) => Int -> Var b a -> ShowS
forall b a. (Show b, Show a) => [Var b a] -> ShowS
forall b a. (Show b, Show a) => Var b a -> String
showList :: [Var b a] -> ShowS
$cshowList :: forall b a. (Show b, Show a) => [Var b a] -> ShowS
show :: Var b a -> String
$cshow :: forall b a. (Show b, Show a) => Var b a -> String
showsPrec :: Int -> Var b a -> ShowS
$cshowsPrec :: forall b a. (Show b, Show a) => Int -> Var b a -> ShowS
Show
  , ReadPrec [Var b a]
ReadPrec (Var b a)
Int -> ReadS (Var b a)
ReadS [Var b a]
(Int -> ReadS (Var b a))
-> ReadS [Var b a]
-> ReadPrec (Var b a)
-> ReadPrec [Var b a]
-> Read (Var b a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall b a. (Read b, Read a) => ReadPrec [Var b a]
forall b a. (Read b, Read a) => ReadPrec (Var b a)
forall b a. (Read b, Read a) => Int -> ReadS (Var b a)
forall b a. (Read b, Read a) => ReadS [Var b a]
readListPrec :: ReadPrec [Var b a]
$creadListPrec :: forall b a. (Read b, Read a) => ReadPrec [Var b a]
readPrec :: ReadPrec (Var b a)
$creadPrec :: forall b a. (Read b, Read a) => ReadPrec (Var b a)
readList :: ReadS [Var b a]
$creadList :: forall b a. (Read b, Read a) => ReadS [Var b a]
readsPrec :: Int -> ReadS (Var b a)
$creadsPrec :: forall b a. (Read b, Read a) => Int -> ReadS (Var b a)
Read
#ifdef __GLASGOW_HASKELL__
  , Typeable (Var b a)
DataType
Constr
Typeable (Var b a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Var b a -> c (Var b a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Var b a))
-> (Var b a -> Constr)
-> (Var b a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Var b a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Var b a)))
-> ((forall b. Data b => b -> b) -> Var b a -> Var b a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Var b a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Var b a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Var b a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Var b a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Var b a -> m (Var b a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Var b a -> m (Var b a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Var b a -> m (Var b a))
-> Data (Var b a)
Var b a -> DataType
Var b a -> Constr
(forall b. Data b => b -> b) -> Var b a -> Var b a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Var b a -> c (Var b a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Var b a)
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Var b a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Var b a -> u
forall u. (forall d. Data d => d -> u) -> Var b a -> [u]
forall b a. (Data b, Data a) => Typeable (Var b a)
forall b a. (Data b, Data a) => Var b a -> DataType
forall b a. (Data b, Data a) => Var b a -> Constr
forall b a.
(Data b, Data a) =>
(forall b. Data b => b -> b) -> Var b a -> Var b a
forall b a u.
(Data b, Data a) =>
Int -> (forall d. Data d => d -> u) -> Var b a -> u
forall b a u.
(Data b, Data a) =>
(forall d. Data d => d -> u) -> Var b a -> [u]
forall b a r r'.
(Data b, Data a) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Var b a -> r
forall b a r r'.
(Data b, Data a) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Var b a -> r
forall b a (m :: * -> *).
(Data b, Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Var b a -> m (Var b a)
forall b a (m :: * -> *).
(Data b, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Var b a -> m (Var b a)
forall b a (c :: * -> *).
(Data b, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Var b a)
forall b a (c :: * -> *).
(Data b, Data a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Var b a -> c (Var b a)
forall b a (t :: * -> *) (c :: * -> *).
(Data b, Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Var b a))
forall b a (t :: * -> * -> *) (c :: * -> *).
(Data b, Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Var b a))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Var b a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Var b a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Var b a -> m (Var b a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Var b a -> m (Var b a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Var b a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Var b a -> c (Var b a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Var b a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Var b a))
$cF :: Constr
$cB :: Constr
$tVar :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Var b a -> m (Var b a)
$cgmapMo :: forall b a (m :: * -> *).
(Data b, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Var b a -> m (Var b a)
gmapMp :: (forall d. Data d => d -> m d) -> Var b a -> m (Var b a)
$cgmapMp :: forall b a (m :: * -> *).
(Data b, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Var b a -> m (Var b a)
gmapM :: (forall d. Data d => d -> m d) -> Var b a -> m (Var b a)
$cgmapM :: forall b a (m :: * -> *).
(Data b, Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Var b a -> m (Var b a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Var b a -> u
$cgmapQi :: forall b a u.
(Data b, Data a) =>
Int -> (forall d. Data d => d -> u) -> Var b a -> u
gmapQ :: (forall d. Data d => d -> u) -> Var b a -> [u]
$cgmapQ :: forall b a u.
(Data b, Data a) =>
(forall d. Data d => d -> u) -> Var b a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Var b a -> r
$cgmapQr :: forall b a r r'.
(Data b, Data a) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Var b a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Var b a -> r
$cgmapQl :: forall b a r r'.
(Data b, Data a) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Var b a -> r
gmapT :: (forall b. Data b => b -> b) -> Var b a -> Var b a
$cgmapT :: forall b a.
(Data b, Data a) =>
(forall b. Data b => b -> b) -> Var b a -> Var b a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Var b a))
$cdataCast2 :: forall b a (t :: * -> * -> *) (c :: * -> *).
(Data b, Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Var b a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Var b a))
$cdataCast1 :: forall b a (t :: * -> *) (c :: * -> *).
(Data b, Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Var b a))
dataTypeOf :: Var b a -> DataType
$cdataTypeOf :: forall b a. (Data b, Data a) => Var b a -> DataType
toConstr :: Var b a -> Constr
$ctoConstr :: forall b a. (Data b, Data a) => Var b a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Var b a)
$cgunfold :: forall b a (c :: * -> *).
(Data b, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Var b a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Var b a -> c (Var b a)
$cgfoldl :: forall b a (c :: * -> *).
(Data b, Data a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Var b a -> c (Var b a)
$cp1Data :: forall b a. (Data b, Data a) => Typeable (Var b a)
Data
  , (forall x. Var b a -> Rep (Var b a) x)
-> (forall x. Rep (Var b a) x -> Var b a) -> Generic (Var b a)
forall x. Rep (Var b a) x -> Var b a
forall x. Var b a -> Rep (Var b a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall b a x. Rep (Var b a) x -> Var b a
forall b a x. Var b a -> Rep (Var b a) x
$cto :: forall b a x. Rep (Var b a) x -> Var b a
$cfrom :: forall b a x. Var b a -> Rep (Var b a) x
Generic
  , (forall a. Var b a -> Rep1 (Var b) a)
-> (forall a. Rep1 (Var b) a -> Var b a) -> Generic1 (Var b)
forall a. Rep1 (Var b) a -> Var b a
forall a. Var b a -> Rep1 (Var b) a
forall b a. Rep1 (Var b) a -> Var b a
forall b a. Var b a -> Rep1 (Var b) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall b a. Rep1 (Var b) a -> Var b a
$cfrom1 :: forall b a. Var b a -> Rep1 (Var b) a
Generic1
#endif
  )

distinguisher :: Int
distinguisher :: Int
distinguisher = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ (Word
forall a. Bounded a => a
maxBound :: Word) Word -> Word -> Word
forall a. Integral a => a -> a -> a
`quot` Word
3

instance Hashable2 Var where
  liftHashWithSalt2 :: (Int -> a -> Int) -> (Int -> b -> Int) -> Int -> Var a b -> Int
liftHashWithSalt2 Int -> a -> Int
h Int -> b -> Int
_ Int
s (B a
b) = Int -> a -> Int
h Int
s a
b
  liftHashWithSalt2 Int -> a -> Int
_ Int -> b -> Int
h Int
s (F b
a) = Int -> b -> Int
h Int
s b
a Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
distinguisher
  {-# INLINE liftHashWithSalt2 #-}
instance Hashable b => Hashable1 (Var b) where
  liftHashWithSalt :: (Int -> a -> Int) -> Int -> Var b a -> Int
liftHashWithSalt = (Int -> b -> Int) -> (Int -> a -> Int) -> Int -> Var b a -> Int
forall (t :: * -> * -> *) a b.
Hashable2 t =>
(Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int
liftHashWithSalt2 Int -> b -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt
  {-# INLINE liftHashWithSalt #-}
instance (Hashable b, Hashable a) => Hashable (Var b a) where
  hashWithSalt :: Int -> Var b a -> Int
hashWithSalt Int
s (B b
b) = Int -> b -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s b
b
  hashWithSalt Int
s (F a
a) = Int -> a -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s a
a Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
distinguisher
  {-# INLINE hashWithSalt #-}

instance Serial2 Var where
  serializeWith2 :: (a -> m ()) -> (b -> m ()) -> Var a b -> m ()
serializeWith2 a -> m ()
pb b -> m ()
_  (B a
b) = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
pb a
b
  serializeWith2 a -> m ()
_  b -> m ()
pf (F b
f) = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
1 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m ()
pf b
f
  {-# INLINE serializeWith2 #-}

  deserializeWith2 :: m a -> m b -> m (Var a b)
deserializeWith2 m a
gb m b
gf = m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m (Var a b)) -> m (Var a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
b -> case Word8
b of
    Word8
0 -> (a -> Var a b) -> m a -> m (Var a b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Var a b
forall b a. b -> Var b a
B m a
gb
    Word8
1 -> (b -> Var a b) -> m b -> m (Var a b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> Var a b
forall b a. a -> Var b a
F m b
gf
    Word8
_ -> String -> m (Var a b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (Var a b)) -> String -> m (Var a b)
forall a b. (a -> b) -> a -> b
$ String
"getVar: Unexpected constructor code: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
b
  {-# INLINE deserializeWith2 #-}

instance Serial b => Serial1 (Var b) where
  serializeWith :: (a -> m ()) -> Var b a -> m ()
serializeWith = (b -> m ()) -> (a -> m ()) -> Var b a -> m ()
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadPut m) =>
(a -> m ()) -> (b -> m ()) -> f a b -> m ()
serializeWith2 b -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
  {-# INLINE serializeWith #-}
  deserializeWith :: m a -> m (Var b a)
deserializeWith = m b -> m a -> m (Var b a)
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadGet m) =>
m a -> m b -> m (f a b)
deserializeWith2 m b
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
  {-# INLINE deserializeWith #-}

instance (Serial b, Serial a) => Serial (Var b a) where
  serialize :: Var b a -> m ()
serialize = (b -> m ()) -> (a -> m ()) -> Var b a -> m ()
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadPut m) =>
(a -> m ()) -> (b -> m ()) -> f a b -> m ()
serializeWith2 b -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
  {-# INLINE serialize #-}
  deserialize :: m (Var b a)
deserialize = m b -> m a -> m (Var b a)
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadGet m) =>
m a -> m b -> m (f a b)
deserializeWith2 m b
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
  {-# INLINE deserialize #-}

instance (Binary b, Binary a) => Binary (Var b a) where
  put :: Var b a -> Put
put = (b -> Put) -> (a -> Put) -> Var b a -> Put
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadPut m) =>
(a -> m ()) -> (b -> m ()) -> f a b -> m ()
serializeWith2 b -> Put
forall t. Binary t => t -> Put
Binary.put a -> Put
forall t. Binary t => t -> Put
Binary.put
  get :: Get (Var b a)
get = Get b -> Get a -> Get (Var b a)
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadGet m) =>
m a -> m b -> m (f a b)
deserializeWith2 Get b
forall t. Binary t => Get t
Binary.get Get a
forall t. Binary t => Get t
Binary.get

instance (Serialize b, Serialize a) => Serialize (Var b a) where
  put :: Putter (Var b a)
put = (b -> PutM ()) -> (a -> PutM ()) -> Putter (Var b a)
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadPut m) =>
(a -> m ()) -> (b -> m ()) -> f a b -> m ()
serializeWith2 b -> PutM ()
forall t. Serialize t => Putter t
Serialize.put a -> PutM ()
forall t. Serialize t => Putter t
Serialize.put
  get :: Get (Var b a)
get = Get b -> Get a -> Get (Var b a)
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadGet m) =>
m a -> m b -> m (f a b)
deserializeWith2 Get b
forall t. Serialize t => Get t
Serialize.get Get a
forall t. Serialize t => Get t
Serialize.get

unvar :: (b -> r) -> (a -> r) -> Var b a -> r
unvar :: (b -> r) -> (a -> r) -> Var b a -> r
unvar b -> r
f a -> r
_ (B b
b) = b -> r
f b
b
unvar b -> r
_ a -> r
g (F a
a) = a -> r
g a
a
{-# INLINE unvar #-}

-- |
-- This provides a @Prism@ that can be used with @lens@ library to access a bound 'Var'.
--
-- @
-- '_B' :: 'Prism' (Var b a) (Var b' a) b b'@
-- @
_B :: (Choice p, Applicative f) => p b (f b') -> p (Var b a) (f (Var b' a))
_B :: p b (f b') -> p (Var b a) (f (Var b' a))
_B = (Var b a -> Either (Var b' a) b)
-> (Either (Var b' a) (f b') -> f (Var b' a))
-> p (Either (Var b' a) b) (Either (Var b' a) (f b'))
-> p (Var b a) (f (Var b' a))
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap ((b -> Either (Var b' a) b)
-> (a -> Either (Var b' a) b) -> Var b a -> Either (Var b' a) b
forall b r a. (b -> r) -> (a -> r) -> Var b a -> r
unvar b -> Either (Var b' a) b
forall a b. b -> Either a b
Right (Var b' a -> Either (Var b' a) b
forall a b. a -> Either a b
Left (Var b' a -> Either (Var b' a) b)
-> (a -> Var b' a) -> a -> Either (Var b' a) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Var b' a
forall b a. a -> Var b a
F)) ((Var b' a -> f (Var b' a))
-> (f b' -> f (Var b' a))
-> Either (Var b' a) (f b')
-> f (Var b' a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Var b' a -> f (Var b' a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((b' -> Var b' a) -> f b' -> f (Var b' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b' -> Var b' a
forall b a. b -> Var b a
B)) (p (Either (Var b' a) b) (Either (Var b' a) (f b'))
 -> p (Var b a) (f (Var b' a)))
-> (p b (f b')
    -> p (Either (Var b' a) b) (Either (Var b' a) (f b')))
-> p b (f b')
-> p (Var b a) (f (Var b' a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p b (f b') -> p (Either (Var b' a) b) (Either (Var b' a) (f b'))
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'
{-# INLINE _B #-}

-- |
-- This provides a @Prism@ that can be used with @lens@ library to access a free 'Var'.
--
-- @
-- '_F' :: 'Prism' (Var b a) (Var b a') a a'@
-- @
_F :: (Choice p, Applicative f) => p a (f a') -> p (Var b a) (f (Var b a'))
_F :: p a (f a') -> p (Var b a) (f (Var b a'))
_F = (Var b a -> Either (Var b a') a)
-> (Either (Var b a') (f a') -> f (Var b a'))
-> p (Either (Var b a') a) (Either (Var b a') (f a'))
-> p (Var b a) (f (Var b a'))
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap ((b -> Either (Var b a') a)
-> (a -> Either (Var b a') a) -> Var b a -> Either (Var b a') a
forall b r a. (b -> r) -> (a -> r) -> Var b a -> r
unvar (Var b a' -> Either (Var b a') a
forall a b. a -> Either a b
Left (Var b a' -> Either (Var b a') a)
-> (b -> Var b a') -> b -> Either (Var b a') a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Var b a'
forall b a. b -> Var b a
B) a -> Either (Var b a') a
forall a b. b -> Either a b
Right) ((Var b a' -> f (Var b a'))
-> (f a' -> f (Var b a'))
-> Either (Var b a') (f a')
-> f (Var b a')
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Var b a' -> f (Var b a')
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a' -> Var b a') -> f a' -> f (Var b a')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a' -> Var b a'
forall b a. a -> Var b a
F)) (p (Either (Var b a') a) (Either (Var b a') (f a'))
 -> p (Var b a) (f (Var b a')))
-> (p a (f a')
    -> p (Either (Var b a') a) (Either (Var b a') (f a')))
-> p a (f a')
-> p (Var b a) (f (Var b a'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f a') -> p (Either (Var b a') a) (Either (Var b a') (f a'))
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'
{-# INLINE _F #-}

----------------------------------------------------------------------------
-- Instances
----------------------------------------------------------------------------

instance Functor (Var b) where
  fmap :: (a -> b) -> Var b a -> Var b b
fmap a -> b
_ (B b
b) = b -> Var b b
forall b a. b -> Var b a
B b
b
  fmap a -> b
f (F a
a) = b -> Var b b
forall b a. a -> Var b a
F (a -> b
f a
a)
  {-# INLINE fmap #-}

instance Foldable (Var b) where
  foldMap :: (a -> m) -> Var b a -> m
foldMap a -> m
f (F a
a) = a -> m
f a
a
  foldMap a -> m
_ Var b a
_ = m
forall a. Monoid a => a
mempty
  {-# INLINE foldMap #-}

instance Traversable (Var b) where
  traverse :: (a -> f b) -> Var b a -> f (Var b b)
traverse a -> f b
f (F a
a) = b -> Var b b
forall b a. a -> Var b a
F (b -> Var b b) -> f b -> f (Var b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
  traverse a -> f b
_ (B b
b) = Var b b -> f (Var b b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Var b b
forall b a. b -> Var b a
B b
b)
  {-# INLINE traverse #-}

instance Applicative (Var b) where
  pure :: a -> Var b a
pure = a -> Var b a
forall b a. a -> Var b a
F
  {-# INLINE pure #-}
  <*> :: Var b (a -> b) -> Var b a -> Var b b
(<*>) = Var b (a -> b) -> Var b a -> Var b b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
  {-# INLINE (<*>) #-}

instance Monad (Var b) where
  return :: a -> Var b a
return = a -> Var b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE return #-}
  F a
a >>= :: Var b a -> (a -> Var b b) -> Var b b
>>= a -> Var b b
f = a -> Var b b
f a
a
  B b
b >>= a -> Var b b
_ = b -> Var b b
forall b a. b -> Var b a
B b
b
  {-# INLINE (>>=) #-}

instance Bifunctor Var where
  bimap :: (a -> b) -> (c -> d) -> Var a c -> Var b d
bimap a -> b
f c -> d
_ (B a
b) = b -> Var b d
forall b a. b -> Var b a
B (a -> b
f a
b)
  bimap a -> b
_ c -> d
g (F c
a) = d -> Var b d
forall b a. a -> Var b a
F (c -> d
g c
a)
  {-# INLINE bimap #-}

instance Bifoldable Var where
  bifoldMap :: (a -> m) -> (b -> m) -> Var a b -> m
bifoldMap a -> m
f b -> m
_ (B a
b) = a -> m
f a
b
  bifoldMap a -> m
_ b -> m
g (F b
a) = b -> m
g b
a
  {-# INLINE bifoldMap #-}

instance Bitraversable Var where
  bitraverse :: (a -> f c) -> (b -> f d) -> Var a b -> f (Var c d)
bitraverse a -> f c
f b -> f d
_ (B a
b) = c -> Var c d
forall b a. b -> Var b a
B (c -> Var c d) -> f c -> f (Var c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
b
  bitraverse a -> f c
_ b -> f d
g (F b
a) = d -> Var c d
forall b a. a -> Var b a
F (d -> Var c d) -> f d -> f (Var c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
a
  {-# INLINE bitraverse #-}

instance Eq2 Var where
  liftEq2 :: (a -> b -> Bool) -> (c -> d -> Bool) -> Var a c -> Var b d -> Bool
liftEq2 a -> b -> Bool
f c -> d -> Bool
_ (B a
a) (B b
c) = a -> b -> Bool
f a
a b
c
  liftEq2 a -> b -> Bool
_ c -> d -> Bool
g (F c
b) (F d
d) = c -> d -> Bool
g c
b d
d
  liftEq2 a -> b -> Bool
_ c -> d -> Bool
_ Var a c
_ Var b d
_ = Bool
False

instance Ord2 Var where
  liftCompare2 :: (a -> b -> Ordering)
-> (c -> d -> Ordering) -> Var a c -> Var b d -> Ordering
liftCompare2 a -> b -> Ordering
f c -> d -> Ordering
_ (B a
a) (B b
c) = a -> b -> Ordering
f a
a b
c
  liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ B{} F{} = Ordering
LT
  liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ F{} B{} = Ordering
GT
  liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
g (F c
b) (F d
d) = c -> d -> Ordering
g c
b d
d

instance Show2 Var where
  liftShowsPrec2 :: (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> Var a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
f [a] -> ShowS
_ Int -> b -> ShowS
_ [b] -> ShowS
_ Int
d (B a
a) = (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
f String
"B" Int
d a
a
  liftShowsPrec2 Int -> a -> ShowS
_ [a] -> ShowS
_ Int -> b -> ShowS
h [b] -> ShowS
_ Int
d (F b
a) = (Int -> b -> ShowS) -> String -> Int -> b -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> b -> ShowS
h String
"F" Int
d b
a

instance Read2 Var where
  liftReadsPrec2 :: (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (Var a b)
liftReadsPrec2 Int -> ReadS a
f ReadS [a]
_ Int -> ReadS b
h ReadS [b]
_ = (String -> ReadS (Var a b)) -> Int -> ReadS (Var a b)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData ((String -> ReadS (Var a b)) -> Int -> ReadS (Var a b))
-> (String -> ReadS (Var a b)) -> Int -> ReadS (Var a b)
forall a b. (a -> b) -> a -> b
$ (Int -> ReadS a)
-> String -> (a -> Var a b) -> String -> ReadS (Var a b)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith Int -> ReadS a
f String
"B" a -> Var a b
forall b a. b -> Var b a
B (String -> ReadS (Var a b))
-> (String -> ReadS (Var a b)) -> String -> ReadS (Var a b)
forall a. Monoid a => a -> a -> a
`mappend` (Int -> ReadS b)
-> String -> (b -> Var a b) -> String -> ReadS (Var a b)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith Int -> ReadS b
h String
"F" b -> Var a b
forall b a. a -> Var b a
F

instance Eq b => Eq1 (Var b) where
  liftEq :: (a -> b -> Bool) -> Var b a -> Var b b -> Bool
liftEq = (b -> b -> Bool) -> (a -> b -> Bool) -> Var b a -> Var b b -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==)

instance Ord b => Ord1 (Var b) where
  liftCompare :: (a -> b -> Ordering) -> Var b a -> Var b b -> Ordering
liftCompare = (b -> b -> Ordering)
-> (a -> b -> Ordering) -> Var b a -> Var b b -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

instance Show b => Show1 (Var b) where
  liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Var b a -> ShowS
liftShowsPrec = (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> Var b a
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> b -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [b] -> ShowS
forall a. Show a => [a] -> ShowS
showList

instance Read b => Read1 (Var b) where
  liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Var b a)
liftReadsPrec = (Int -> ReadS b)
-> ReadS [b]
-> (Int -> ReadS a)
-> ReadS [a]
-> Int
-> ReadS (Var b a)
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 Int -> ReadS b
forall a. Read a => Int -> ReadS a
readsPrec ReadS [b]
forall a. Read a => ReadS [a]
readList

instance (NFData a, NFData b) => NFData (Var b a) where
  rnf :: Var b a -> ()
rnf (B b
b) = b -> ()
forall a. NFData a => a -> ()
rnf b
b
  rnf (F a
f) = a -> ()
forall a. NFData a => a -> ()
rnf a
f