{-# 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
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
  , Var b a -> Var b a -> Bool
Var b a -> Var b a -> Ordering
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
Ord
  , Int -> Var b a -> ShowS
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)
ReadS [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__
  , Var b a -> DataType
Var b a -> Constr
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 {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 (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 e. (Data d, Data e) => c (t d e)) -> Maybe (c (Var b a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. 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 u. (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 :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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)
Data
  , 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 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (forall a. Bounded a => a
maxBound :: Word) forall a. Integral a => a -> a -> a
`quot` Word
3

instance Hashable2 Var where
  liftHashWithSalt2 :: forall a b.
(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 forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
distinguisher
  {-# INLINE liftHashWithSalt2 #-}
instance Hashable b => Hashable1 (Var b) where
  liftHashWithSalt :: forall a. (Int -> a -> Int) -> Int -> Var b a -> Int
liftHashWithSalt = forall (t :: * -> * -> *) a b.
Hashable2 t =>
(Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int
liftHashWithSalt2 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) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s b
b
  hashWithSalt Int
s (F a
a) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s a
a forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
distinguisher
  {-# INLINE hashWithSalt #-}

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

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

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

instance (Serial b, Serial a) => Serial (Var b a) where
  serialize :: forall (m :: * -> *). MonadPut m => Var b a -> m ()
serialize = forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadPut m) =>
(a -> m ()) -> (b -> m ()) -> f a b -> m ()
serializeWith2 forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
  {-# INLINE serialize #-}
  deserialize :: forall (m :: * -> *). MonadGet m => m (Var b a)
deserialize = forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadGet m) =>
m a -> m b -> m (f a b)
deserializeWith2 forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize 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 = forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadPut m) =>
(a -> m ()) -> (b -> m ()) -> f a b -> m ()
serializeWith2 forall t. Binary t => t -> Put
Binary.put forall t. Binary t => t -> Put
Binary.put
  get :: Get (Var b a)
get = forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadGet m) =>
m a -> m b -> m (f a b)
deserializeWith2 forall t. Binary t => Get t
Binary.get forall t. Binary t => Get t
Binary.get

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

unvar :: (b -> r) -> (a -> r) -> Var b a -> r
unvar :: forall b r a. (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 :: forall (p :: * -> * -> *) (f :: * -> *) b b' a.
(Choice p, Applicative f) =>
p b (f b') -> p (Var b a) (f (Var b' a))
_B = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (forall b r a. (b -> r) -> (a -> r) -> Var b a -> r
unvar forall a b. b -> Either a b
Right (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. a -> Var b a
F)) (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b a. b -> Var b a
B)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (p :: * -> * -> *) (f :: * -> *) a a' b.
(Choice p, Applicative f) =>
p a (f a') -> p (Var b a) (f (Var b a'))
_F = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (forall b r a. (b -> r) -> (a -> r) -> Var b a -> r
unvar (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> Var b a
B) forall a b. b -> Either a b
Right) (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b a. a -> Var b a
F)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b. (a -> b) -> Var b a -> Var b b
fmap a -> b
_ (B b
b) = forall b a. b -> Var b a
B b
b
  fmap a -> b
f (F a
a) = forall b a. a -> Var b a
F (a -> b
f a
a)
  {-# INLINE fmap #-}

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

instance Traversable (Var b) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Var b a -> f (Var b b)
traverse a -> f b
f (F a
a) = forall b a. a -> Var b a
F 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) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall b a. b -> Var b a
B b
b)
  {-# INLINE traverse #-}

instance Applicative (Var b) where
  pure :: forall a. a -> Var b a
pure = forall b a. a -> Var b a
F
  {-# INLINE pure #-}
  <*> :: forall a 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 :: forall a. a -> Var b a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE return #-}
  F a
a >>= :: forall a b. 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
_ = forall b a. b -> Var b a
B b
b
  {-# INLINE (>>=) #-}

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

instance Bifoldable Var where
  bifoldMap :: forall m a b. Monoid m => (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 :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Var a b -> f (Var c d)
bitraverse a -> f c
f b -> f d
_ (B a
b) = forall b a. b -> Var b a
B 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) = forall b a. a -> Var b a
F 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 :: forall a b c d.
(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 :: forall a b c d.
(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 :: forall a b.
(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) = 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) = 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 :: forall a b.
(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]
_ = forall a. (String -> ReadS a) -> Int -> ReadS a
readsData forall a b. (a -> b) -> a -> b
$ forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith Int -> ReadS a
f String
"B" forall b a. b -> Var b a
B forall a. Monoid a => a -> a -> a
`mappend` forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith Int -> ReadS b
h String
"F" forall b a. a -> Var b a
F

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

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

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

instance Read b => Read1 (Var b) where
  liftReadsPrec :: forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Var b a)
liftReadsPrec = forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 forall a. Read a => Int -> ReadS a
readsPrec 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) = forall a. NFData a => a -> ()
rnf b
b
  rnf (F a
f) = forall a. NFData a => a -> ()
rnf a
f