{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}

module Data.Vinyl.Functor
  ( -- * Introduction
    -- $introduction
    -- * Data Types
    Identity(..)
  , Thunk(..)
  , Lift(..)
  , ElField(..)
  , Compose(..), onCompose
  , (:.)
  , Const(..)
    -- * Discussion

    -- ** Example
    -- $example

    -- ** Ecosystem
    -- $ecosystem
  ) where

import Data.Proxy
#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup
#endif
import Foreign.Ptr (castPtr)
import Foreign.Storable
import GHC.Generics
import GHC.TypeLits
import GHC.Types (Type)
import Data.Vinyl.TypeLevel (Snd)

{- $introduction
    This module provides functors and functor compositions
    that can be used as the interpretation function for a
    'Rec'. For a more full discussion of this, scroll down
    to the bottom.
-}

-- | This is identical to the "Identity" from "Data.Functor.Identity"
-- in "base" except for its 'Show' instance.
newtype Identity a
  = Identity { forall a. Identity a -> a
getIdentity :: a }
    deriving ( forall a b. a -> Identity b -> Identity a
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Identity b -> Identity a
$c<$ :: forall a b. a -> Identity b -> Identity a
fmap :: forall a b. (a -> b) -> Identity a -> Identity b
$cfmap :: forall a b. (a -> b) -> Identity a -> Identity b
Functor
             , forall a. Eq a => a -> Identity a -> Bool
forall a. Num a => Identity a -> a
forall a. Ord a => Identity a -> a
forall m. Monoid m => Identity m -> m
forall a. Identity a -> Bool
forall a. Identity a -> Int
forall a. Identity a -> [a]
forall a. (a -> a -> a) -> Identity a -> a
forall m a. Monoid m => (a -> m) -> Identity a -> m
forall b a. (b -> a -> b) -> b -> Identity a -> b
forall a b. (a -> b -> b) -> b -> Identity 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 :: forall a. Num a => Identity a -> a
$cproduct :: forall a. Num a => Identity a -> a
sum :: forall a. Num a => Identity a -> a
$csum :: forall a. Num a => Identity a -> a
minimum :: forall a. Ord a => Identity a -> a
$cminimum :: forall a. Ord a => Identity a -> a
maximum :: forall a. Ord a => Identity a -> a
$cmaximum :: forall a. Ord a => Identity a -> a
elem :: forall a. Eq a => a -> Identity a -> Bool
$celem :: forall a. Eq a => a -> Identity a -> Bool
length :: forall a. Identity a -> Int
$clength :: forall a. Identity a -> Int
null :: forall a. Identity a -> Bool
$cnull :: forall a. Identity a -> Bool
toList :: forall a. Identity a -> [a]
$ctoList :: forall a. Identity a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Identity a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Identity a -> a
foldr1 :: forall a. (a -> a -> a) -> Identity a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Identity a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Identity a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Identity a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Identity a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Identity a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Identity a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Identity a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Identity a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Identity a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Identity a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Identity a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Identity a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Identity a -> m
fold :: forall m. Monoid m => Identity m -> m
$cfold :: forall m. Monoid m => Identity m -> m
Foldable
             , Functor Identity
Foldable Identity
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 => Identity (m a) -> m (Identity a)
forall (f :: * -> *) a.
Applicative f =>
Identity (f a) -> f (Identity a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Identity a -> m (Identity b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Identity a -> f (Identity b)
sequence :: forall (m :: * -> *) a. Monad m => Identity (m a) -> m (Identity a)
$csequence :: forall (m :: * -> *) a. Monad m => Identity (m a) -> m (Identity a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Identity a -> m (Identity b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Identity a -> m (Identity b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Identity (f a) -> f (Identity a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Identity (f a) -> f (Identity a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Identity a -> f (Identity b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Identity a -> f (Identity b)
Traversable
             , Ptr (Identity a) -> IO (Identity a)
Ptr (Identity a) -> Int -> IO (Identity a)
Ptr (Identity a) -> Int -> Identity a -> IO ()
Ptr (Identity a) -> Identity a -> IO ()
Identity a -> Int
forall b. Ptr b -> Int -> IO (Identity a)
forall b. Ptr b -> Int -> Identity a -> IO ()
forall a. Storable a => Ptr (Identity a) -> IO (Identity a)
forall a. Storable a => Ptr (Identity a) -> Int -> IO (Identity a)
forall a.
Storable a =>
Ptr (Identity a) -> Int -> Identity a -> IO ()
forall a. Storable a => Ptr (Identity a) -> Identity a -> IO ()
forall a. Storable a => Identity a -> Int
forall a b. Storable a => Ptr b -> Int -> IO (Identity a)
forall a b. Storable a => Ptr b -> Int -> Identity a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr (Identity a) -> Identity a -> IO ()
$cpoke :: forall a. Storable a => Ptr (Identity a) -> Identity a -> IO ()
peek :: Ptr (Identity a) -> IO (Identity a)
$cpeek :: forall a. Storable a => Ptr (Identity a) -> IO (Identity a)
pokeByteOff :: forall b. Ptr b -> Int -> Identity a -> IO ()
$cpokeByteOff :: forall a b. Storable a => Ptr b -> Int -> Identity a -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (Identity a)
$cpeekByteOff :: forall a b. Storable a => Ptr b -> Int -> IO (Identity a)
pokeElemOff :: Ptr (Identity a) -> Int -> Identity a -> IO ()
$cpokeElemOff :: forall a.
Storable a =>
Ptr (Identity a) -> Int -> Identity a -> IO ()
peekElemOff :: Ptr (Identity a) -> Int -> IO (Identity a)
$cpeekElemOff :: forall a. Storable a => Ptr (Identity a) -> Int -> IO (Identity a)
alignment :: Identity a -> Int
$calignment :: forall a. Storable a => Identity a -> Int
sizeOf :: Identity a -> Int
$csizeOf :: forall a. Storable a => Identity a -> Int
Storable
             , Identity a -> Identity a -> Bool
forall a. Eq a => Identity a -> Identity a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Identity a -> Identity a -> Bool
$c/= :: forall a. Eq a => Identity a -> Identity a -> Bool
== :: Identity a -> Identity a -> Bool
$c== :: forall a. Eq a => Identity a -> Identity a -> Bool
Eq
             , Identity a -> Identity a -> Bool
Identity a -> Identity a -> Ordering
Identity a -> Identity a -> Identity 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 {a}. Ord a => Eq (Identity a)
forall a. Ord a => Identity a -> Identity a -> Bool
forall a. Ord a => Identity a -> Identity a -> Ordering
forall a. Ord a => Identity a -> Identity a -> Identity a
min :: Identity a -> Identity a -> Identity a
$cmin :: forall a. Ord a => Identity a -> Identity a -> Identity a
max :: Identity a -> Identity a -> Identity a
$cmax :: forall a. Ord a => Identity a -> Identity a -> Identity a
>= :: Identity a -> Identity a -> Bool
$c>= :: forall a. Ord a => Identity a -> Identity a -> Bool
> :: Identity a -> Identity a -> Bool
$c> :: forall a. Ord a => Identity a -> Identity a -> Bool
<= :: Identity a -> Identity a -> Bool
$c<= :: forall a. Ord a => Identity a -> Identity a -> Bool
< :: Identity a -> Identity a -> Bool
$c< :: forall a. Ord a => Identity a -> Identity a -> Bool
compare :: Identity a -> Identity a -> Ordering
$ccompare :: forall a. Ord a => Identity a -> Identity a -> Ordering
Ord
             , forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Identity a) x -> Identity a
forall a x. Identity a -> Rep (Identity a) x
$cto :: forall a x. Rep (Identity a) x -> Identity a
$cfrom :: forall a x. Identity a -> Rep (Identity a) x
Generic
             )

-- | Used this instead of 'Identity' to make a record
--   lazy in its fields.
data Thunk a
  = Thunk { forall a. Thunk a -> a
getThunk :: a }
    deriving ( forall a b. a -> Thunk b -> Thunk a
forall a b. (a -> b) -> Thunk a -> Thunk b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Thunk b -> Thunk a
$c<$ :: forall a b. a -> Thunk b -> Thunk a
fmap :: forall a b. (a -> b) -> Thunk a -> Thunk b
$cfmap :: forall a b. (a -> b) -> Thunk a -> Thunk b
Functor
             , forall a. Eq a => a -> Thunk a -> Bool
forall a. Num a => Thunk a -> a
forall a. Ord a => Thunk a -> a
forall m. Monoid m => Thunk m -> m
forall a. Thunk a -> Bool
forall a. Thunk a -> Int
forall a. Thunk a -> [a]
forall a. (a -> a -> a) -> Thunk a -> a
forall m a. Monoid m => (a -> m) -> Thunk a -> m
forall b a. (b -> a -> b) -> b -> Thunk a -> b
forall a b. (a -> b -> b) -> b -> Thunk 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 :: forall a. Num a => Thunk a -> a
$cproduct :: forall a. Num a => Thunk a -> a
sum :: forall a. Num a => Thunk a -> a
$csum :: forall a. Num a => Thunk a -> a
minimum :: forall a. Ord a => Thunk a -> a
$cminimum :: forall a. Ord a => Thunk a -> a
maximum :: forall a. Ord a => Thunk a -> a
$cmaximum :: forall a. Ord a => Thunk a -> a
elem :: forall a. Eq a => a -> Thunk a -> Bool
$celem :: forall a. Eq a => a -> Thunk a -> Bool
length :: forall a. Thunk a -> Int
$clength :: forall a. Thunk a -> Int
null :: forall a. Thunk a -> Bool
$cnull :: forall a. Thunk a -> Bool
toList :: forall a. Thunk a -> [a]
$ctoList :: forall a. Thunk a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Thunk a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Thunk a -> a
foldr1 :: forall a. (a -> a -> a) -> Thunk a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Thunk a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Thunk a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Thunk a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Thunk a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Thunk a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Thunk a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Thunk a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Thunk a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Thunk a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Thunk a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Thunk a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Thunk a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Thunk a -> m
fold :: forall m. Monoid m => Thunk m -> m
$cfold :: forall m. Monoid m => Thunk m -> m
Foldable
             , Functor Thunk
Foldable Thunk
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 => Thunk (m a) -> m (Thunk a)
forall (f :: * -> *) a. Applicative f => Thunk (f a) -> f (Thunk a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Thunk a -> m (Thunk b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Thunk a -> f (Thunk b)
sequence :: forall (m :: * -> *) a. Monad m => Thunk (m a) -> m (Thunk a)
$csequence :: forall (m :: * -> *) a. Monad m => Thunk (m a) -> m (Thunk a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Thunk a -> m (Thunk b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Thunk a -> m (Thunk b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Thunk (f a) -> f (Thunk a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Thunk (f a) -> f (Thunk a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Thunk a -> f (Thunk b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Thunk a -> f (Thunk b)
Traversable
             )

newtype Lift (op :: l -> l' -> *) (f :: k -> l) (g :: k -> l') (x :: k)
  = Lift { forall l l' k (op :: l -> l' -> *) (f :: k -> l) (g :: k -> l')
       (x :: k).
Lift op f g x -> op (f x) (g x)
getLift :: op (f x) (g x) }

newtype Compose (f :: l -> *) (g :: k -> l) (x :: k)
  = Compose { forall l k (f :: l -> *) (g :: k -> l) (x :: k).
Compose f g x -> f (g x)
getCompose :: f (g x) }
    deriving (Ptr (Compose f g x) -> IO (Compose f g x)
Ptr (Compose f g x) -> Int -> IO (Compose f g x)
Ptr (Compose f g x) -> Int -> Compose f g x -> IO ()
Ptr (Compose f g x) -> Compose f g x -> IO ()
Compose f g x -> Int
forall b. Ptr b -> Int -> IO (Compose f g x)
forall b. Ptr b -> Int -> Compose f g x -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall l (f :: l -> *) k (g :: k -> l) (x :: k).
Storable (f (g x)) =>
Ptr (Compose f g x) -> IO (Compose f g x)
forall l (f :: l -> *) k (g :: k -> l) (x :: k).
Storable (f (g x)) =>
Ptr (Compose f g x) -> Int -> IO (Compose f g x)
forall l (f :: l -> *) k (g :: k -> l) (x :: k).
Storable (f (g x)) =>
Ptr (Compose f g x) -> Int -> Compose f g x -> IO ()
forall l (f :: l -> *) k (g :: k -> l) (x :: k).
Storable (f (g x)) =>
Ptr (Compose f g x) -> Compose f g x -> IO ()
forall l (f :: l -> *) k (g :: k -> l) (x :: k).
Storable (f (g x)) =>
Compose f g x -> Int
forall l (f :: l -> *) k (g :: k -> l) (x :: k) b.
Storable (f (g x)) =>
Ptr b -> Int -> IO (Compose f g x)
forall l (f :: l -> *) k (g :: k -> l) (x :: k) b.
Storable (f (g x)) =>
Ptr b -> Int -> Compose f g x -> IO ()
poke :: Ptr (Compose f g x) -> Compose f g x -> IO ()
$cpoke :: forall l (f :: l -> *) k (g :: k -> l) (x :: k).
Storable (f (g x)) =>
Ptr (Compose f g x) -> Compose f g x -> IO ()
peek :: Ptr (Compose f g x) -> IO (Compose f g x)
$cpeek :: forall l (f :: l -> *) k (g :: k -> l) (x :: k).
Storable (f (g x)) =>
Ptr (Compose f g x) -> IO (Compose f g x)
pokeByteOff :: forall b. Ptr b -> Int -> Compose f g x -> IO ()
$cpokeByteOff :: forall l (f :: l -> *) k (g :: k -> l) (x :: k) b.
Storable (f (g x)) =>
Ptr b -> Int -> Compose f g x -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (Compose f g x)
$cpeekByteOff :: forall l (f :: l -> *) k (g :: k -> l) (x :: k) b.
Storable (f (g x)) =>
Ptr b -> Int -> IO (Compose f g x)
pokeElemOff :: Ptr (Compose f g x) -> Int -> Compose f g x -> IO ()
$cpokeElemOff :: forall l (f :: l -> *) k (g :: k -> l) (x :: k).
Storable (f (g x)) =>
Ptr (Compose f g x) -> Int -> Compose f g x -> IO ()
peekElemOff :: Ptr (Compose f g x) -> Int -> IO (Compose f g x)
$cpeekElemOff :: forall l (f :: l -> *) k (g :: k -> l) (x :: k).
Storable (f (g x)) =>
Ptr (Compose f g x) -> Int -> IO (Compose f g x)
alignment :: Compose f g x -> Int
$calignment :: forall l (f :: l -> *) k (g :: k -> l) (x :: k).
Storable (f (g x)) =>
Compose f g x -> Int
sizeOf :: Compose f g x -> Int
$csizeOf :: forall l (f :: l -> *) k (g :: k -> l) (x :: k).
Storable (f (g x)) =>
Compose f g x -> Int
Storable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l (f :: l -> *) k (g :: k -> l) (x :: k) x.
Rep (Compose f g x) x -> Compose f g x
forall l (f :: l -> *) k (g :: k -> l) (x :: k) x.
Compose f g x -> Rep (Compose f g x) x
$cto :: forall l (f :: l -> *) k (g :: k -> l) (x :: k) x.
Rep (Compose f g x) x -> Compose f g x
$cfrom :: forall l (f :: l -> *) k (g :: k -> l) (x :: k) x.
Compose f g x -> Rep (Compose f g x) x
Generic)

instance Semigroup (f (g a)) => Semigroup (Compose f g a) where
  Compose f (g a)
x <> :: Compose f g a -> Compose f g a -> Compose f g a
<> Compose f (g a)
y = forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose (f (g a)
x forall a. Semigroup a => a -> a -> a
<> f (g a)
y)

instance Monoid (f (g a)) => Monoid (Compose f g a) where
  mempty :: Compose f g a
mempty = forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose forall a. Monoid a => a
mempty
  mappend :: Compose f g a -> Compose f g a -> Compose f g a
mappend (Compose f (g a)
x) (Compose f (g a)
y) = forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose (forall a. Monoid a => a -> a -> a
mappend f (g a)
x f (g a)
y)

-- | Apply a function to a value whose type is the application of the
-- 'Compose' type constructor. This works under the 'Compose' newtype
-- wrapper.
onCompose :: (f (g a) -> h (k a)) -> (f :. g) a -> (h :. k) a
onCompose :: forall {l} {k} {l} (f :: l -> *) (g :: k -> l) (a :: k)
       (h :: l -> *) (k :: k -> l).
(f (g a) -> h (k a)) -> (:.) f g a -> (:.) h k a
onCompose f (g a) -> h (k a)
f = forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (g a) -> h (k a)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l k (f :: l -> *) (g :: k -> l) (x :: k).
Compose f g x -> f (g x)
getCompose

type f :. g = Compose f g
infixr 9 :.

newtype Const (a :: *) (b :: k)
  = Const { forall k a (b :: k). Const a b -> a
getConst :: a }
    deriving ( forall a b. (a -> b) -> Const a a -> Const a b
forall a a b. a -> Const a b -> Const a a
forall a a b. (a -> b) -> Const a a -> Const a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Const a b -> Const a a
$c<$ :: forall a a b. a -> Const a b -> Const a a
fmap :: forall a b. (a -> b) -> Const a a -> Const a b
$cfmap :: forall a a b. (a -> b) -> Const a a -> Const a b
Functor
             , forall a a. Eq a => a -> Const a a -> Bool
forall a a. Num a => Const a a -> a
forall a a. Ord a => Const a a -> a
forall m a. Monoid m => (a -> m) -> Const a a -> m
forall a m. Monoid m => Const a m -> m
forall a a. Const a a -> Bool
forall a a. Const a a -> Int
forall a a. Const a a -> [a]
forall a a. (a -> a -> a) -> Const a a -> a
forall a m a. Monoid m => (a -> m) -> Const a a -> m
forall a b a. (b -> a -> b) -> b -> Const a a -> b
forall a a b. (a -> b -> b) -> b -> Const a 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 :: forall a. Num a => Const a a -> a
$cproduct :: forall a a. Num a => Const a a -> a
sum :: forall a. Num a => Const a a -> a
$csum :: forall a a. Num a => Const a a -> a
minimum :: forall a. Ord a => Const a a -> a
$cminimum :: forall a a. Ord a => Const a a -> a
maximum :: forall a. Ord a => Const a a -> a
$cmaximum :: forall a a. Ord a => Const a a -> a
elem :: forall a. Eq a => a -> Const a a -> Bool
$celem :: forall a a. Eq a => a -> Const a a -> Bool
length :: forall a. Const a a -> Int
$clength :: forall a a. Const a a -> Int
null :: forall a. Const a a -> Bool
$cnull :: forall a a. Const a a -> Bool
toList :: forall a. Const a a -> [a]
$ctoList :: forall a a. Const a a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Const a a -> a
$cfoldl1 :: forall a a. (a -> a -> a) -> Const a a -> a
foldr1 :: forall a. (a -> a -> a) -> Const a a -> a
$cfoldr1 :: forall a a. (a -> a -> a) -> Const a a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Const a a -> b
$cfoldl' :: forall a b a. (b -> a -> b) -> b -> Const a a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Const a a -> b
$cfoldl :: forall a b a. (b -> a -> b) -> b -> Const a a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Const a a -> b
$cfoldr' :: forall a a b. (a -> b -> b) -> b -> Const a a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Const a a -> b
$cfoldr :: forall a a b. (a -> b -> b) -> b -> Const a a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Const a a -> m
$cfoldMap' :: forall a m a. Monoid m => (a -> m) -> Const a a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Const a a -> m
$cfoldMap :: forall a m a. Monoid m => (a -> m) -> Const a a -> m
fold :: forall m. Monoid m => Const a m -> m
$cfold :: forall a m. Monoid m => Const a m -> m
Foldable
             , forall a. Functor (Const a)
forall a. Foldable (Const a)
forall a (m :: * -> *) a. Monad m => Const a (m a) -> m (Const a a)
forall a (f :: * -> *) a.
Applicative f =>
Const a (f a) -> f (Const a a)
forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Const a a -> m (Const a b)
forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Const a a -> f (Const a 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 (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Const a a -> f (Const a b)
sequence :: forall (m :: * -> *) a. Monad m => Const a (m a) -> m (Const a a)
$csequence :: forall a (m :: * -> *) a. Monad m => Const a (m a) -> m (Const a a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Const a a -> m (Const a b)
$cmapM :: forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Const a a -> m (Const a b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Const a (f a) -> f (Const a a)
$csequenceA :: forall a (f :: * -> *) a.
Applicative f =>
Const a (f a) -> f (Const a a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Const a a -> f (Const a b)
$ctraverse :: forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Const a a -> f (Const a b)
Traversable
             , Ptr (Const a b) -> IO (Const a b)
Ptr (Const a b) -> Int -> IO (Const a b)
Ptr (Const a b) -> Int -> Const a b -> IO ()
Ptr (Const a b) -> Const a b -> IO ()
Const a b -> Int
forall b. Ptr b -> Int -> IO (Const a b)
forall b. Ptr b -> Int -> Const a b -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall a k (b :: k).
Storable a =>
Ptr (Const a b) -> IO (Const a b)
forall a k (b :: k).
Storable a =>
Ptr (Const a b) -> Int -> IO (Const a b)
forall a k (b :: k).
Storable a =>
Ptr (Const a b) -> Int -> Const a b -> IO ()
forall a k (b :: k).
Storable a =>
Ptr (Const a b) -> Const a b -> IO ()
forall a k (b :: k). Storable a => Const a b -> Int
forall a k (b :: k) b. Storable a => Ptr b -> Int -> IO (Const a b)
forall a k (b :: k) b.
Storable a =>
Ptr b -> Int -> Const a b -> IO ()
poke :: Ptr (Const a b) -> Const a b -> IO ()
$cpoke :: forall a k (b :: k).
Storable a =>
Ptr (Const a b) -> Const a b -> IO ()
peek :: Ptr (Const a b) -> IO (Const a b)
$cpeek :: forall a k (b :: k).
Storable a =>
Ptr (Const a b) -> IO (Const a b)
pokeByteOff :: forall b. Ptr b -> Int -> Const a b -> IO ()
$cpokeByteOff :: forall a k (b :: k) b.
Storable a =>
Ptr b -> Int -> Const a b -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (Const a b)
$cpeekByteOff :: forall a k (b :: k) b. Storable a => Ptr b -> Int -> IO (Const a b)
pokeElemOff :: Ptr (Const a b) -> Int -> Const a b -> IO ()
$cpokeElemOff :: forall a k (b :: k).
Storable a =>
Ptr (Const a b) -> Int -> Const a b -> IO ()
peekElemOff :: Ptr (Const a b) -> Int -> IO (Const a b)
$cpeekElemOff :: forall a k (b :: k).
Storable a =>
Ptr (Const a b) -> Int -> IO (Const a b)
alignment :: Const a b -> Int
$calignment :: forall a k (b :: k). Storable a => Const a b -> Int
sizeOf :: Const a b -> Int
$csizeOf :: forall a k (b :: k). Storable a => Const a b -> Int
Storable
             , forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a k (b :: k) x. Rep (Const a b) x -> Const a b
forall a k (b :: k) x. Const a b -> Rep (Const a b) x
$cto :: forall a k (b :: k) x. Rep (Const a b) x -> Const a b
$cfrom :: forall a k (b :: k) x. Const a b -> Rep (Const a b) x
Generic
             )

-- | A value with a phantom 'Symbol' label. It is not a
-- Haskell 'Functor', but it is used in many of the same places a
-- 'Functor' is used in vinyl.
--
-- Morally: newtype ElField (s, t) = Field t
-- But GHC doesn't allow that
newtype ElField (t :: (Symbol, Type)) = Field (Snd t)

deriving instance Eq t => Eq (ElField '(s,t))
deriving instance Ord t => Ord (ElField '(s,t))

instance KnownSymbol s => Generic (ElField '(s,a)) where
  type Rep (ElField '(s,a)) = C1 ('MetaCons s 'PrefixI 'False) (Rec0 a)
  from :: forall x. ElField '(s, a) -> Rep (ElField '(s, a)) x
from (Field Snd '(s, a)
x) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall k i c (p :: k). c -> K1 i c p
K1 Snd '(s, a)
x)
  to :: forall x. Rep (ElField '(s, a)) x -> ElField '(s, a)
to (M1 (K1 a
x)) = forall (t :: (Symbol, *)). Snd t -> ElField t
Field a
x

instance (Num t, KnownSymbol s) => Num (ElField '(s,t)) where
  Field Snd '(s, t)
x + :: ElField '(s, t) -> ElField '(s, t) -> ElField '(s, t)
+ Field Snd '(s, t)
y = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (Snd '(s, t)
xforall a. Num a => a -> a -> a
+Snd '(s, t)
y)
  Field Snd '(s, t)
x * :: ElField '(s, t) -> ElField '(s, t) -> ElField '(s, t)
* Field Snd '(s, t)
y = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (Snd '(s, t)
xforall a. Num a => a -> a -> a
*Snd '(s, t)
y)
  abs :: ElField '(s, t) -> ElField '(s, t)
abs (Field Snd '(s, t)
x) = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (forall a. Num a => a -> a
abs Snd '(s, t)
x)
  signum :: ElField '(s, t) -> ElField '(s, t)
signum (Field Snd '(s, t)
x) = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (forall a. Num a => a -> a
signum Snd '(s, t)
x)
  fromInteger :: Integer -> ElField '(s, t)
fromInteger = forall (t :: (Symbol, *)). Snd t -> ElField t
Field forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger
  negate :: ElField '(s, t) -> ElField '(s, t)
negate (Field Snd '(s, t)
x) = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (forall a. Num a => a -> a
negate Snd '(s, t)
x)

instance Semigroup t => Semigroup (ElField '(s,t)) where
  Field Snd '(s, t)
x <> :: ElField '(s, t) -> ElField '(s, t) -> ElField '(s, t)
<> Field Snd '(s, t)
y = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (Snd '(s, t)
x forall a. Semigroup a => a -> a -> a
<> Snd '(s, t)
y)

instance (KnownSymbol s, Monoid t) => Monoid (ElField '(s,t)) where
  mempty :: ElField '(s, t)
mempty = forall (t :: (Symbol, *)). Snd t -> ElField t
Field forall a. Monoid a => a
mempty
  mappend :: ElField '(s, t) -> ElField '(s, t) -> ElField '(s, t)
mappend (Field Snd '(s, t)
x) (Field Snd '(s, t)
y) = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (forall a. Monoid a => a -> a -> a
mappend Snd '(s, t)
x Snd '(s, t)
y)

instance (Real t, KnownSymbol s) => Real (ElField '(s,t)) where
  toRational :: ElField '(s, t) -> Rational
toRational (Field Snd '(s, t)
x) = forall a. Real a => a -> Rational
toRational Snd '(s, t)
x

instance (Fractional t, KnownSymbol s) => Fractional (ElField '(s,t)) where
  fromRational :: Rational -> ElField '(s, t)
fromRational = forall (t :: (Symbol, *)). Snd t -> ElField t
Field forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational
  Field Snd '(s, t)
x / :: ElField '(s, t) -> ElField '(s, t) -> ElField '(s, t)
/ Field Snd '(s, t)
y = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (Snd '(s, t)
x forall a. Fractional a => a -> a -> a
/ Snd '(s, t)
y)

instance (Floating t, KnownSymbol s) => Floating (ElField '(s,t)) where
  pi :: ElField '(s, t)
pi = forall (t :: (Symbol, *)). Snd t -> ElField t
Field forall a. Floating a => a
pi
  exp :: ElField '(s, t) -> ElField '(s, t)
exp (Field Snd '(s, t)
x) = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (forall a. Floating a => a -> a
exp Snd '(s, t)
x)
  log :: ElField '(s, t) -> ElField '(s, t)
log (Field Snd '(s, t)
x) = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (forall a. Floating a => a -> a
log Snd '(s, t)
x)
  sin :: ElField '(s, t) -> ElField '(s, t)
sin (Field Snd '(s, t)
x) = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (forall a. Floating a => a -> a
sin Snd '(s, t)
x)
  cos :: ElField '(s, t) -> ElField '(s, t)
cos (Field Snd '(s, t)
x) = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (forall a. Floating a => a -> a
cos Snd '(s, t)
x)
  asin :: ElField '(s, t) -> ElField '(s, t)
asin (Field Snd '(s, t)
x) = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (forall a. Floating a => a -> a
asin Snd '(s, t)
x)
  acos :: ElField '(s, t) -> ElField '(s, t)
acos (Field Snd '(s, t)
x) = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (forall a. Floating a => a -> a
acos Snd '(s, t)
x)
  atan :: ElField '(s, t) -> ElField '(s, t)
atan (Field Snd '(s, t)
x) = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (forall a. Floating a => a -> a
atan Snd '(s, t)
x)
  sinh :: ElField '(s, t) -> ElField '(s, t)
sinh (Field Snd '(s, t)
x) = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (forall a. Floating a => a -> a
sinh Snd '(s, t)
x)
  cosh :: ElField '(s, t) -> ElField '(s, t)
cosh (Field Snd '(s, t)
x) = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (forall a. Floating a => a -> a
cosh Snd '(s, t)
x)
  asinh :: ElField '(s, t) -> ElField '(s, t)
asinh (Field Snd '(s, t)
x) = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (forall a. Floating a => a -> a
asinh Snd '(s, t)
x)
  acosh :: ElField '(s, t) -> ElField '(s, t)
acosh (Field Snd '(s, t)
x) = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (forall a. Floating a => a -> a
acosh Snd '(s, t)
x)
  atanh :: ElField '(s, t) -> ElField '(s, t)
atanh (Field Snd '(s, t)
x) = forall (t :: (Symbol, *)). Snd t -> ElField t
Field (forall a. Floating a => a -> a
atanh Snd '(s, t)
x)

instance (RealFrac t, KnownSymbol s) => RealFrac (ElField '(s,t)) where
  properFraction :: forall b. Integral b => ElField '(s, t) -> (b, ElField '(s, t))
properFraction (Field Snd '(s, t)
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: (Symbol, *)). Snd t -> ElField t
Field (forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Snd '(s, t)
x)

instance (Show t, KnownSymbol s) => Show (ElField '(s,t)) where
  show :: ElField '(s, t) -> String
show (Field Snd '(s, t)
x) = forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy::Proxy s) forall a. [a] -> [a] -> [a]
++String
" :-> "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Snd '(s, t)
x

instance forall s t. (KnownSymbol s, Storable t)
    => Storable (ElField '(s,t)) where
  sizeOf :: ElField '(s, t) -> Int
sizeOf ElField '(s, t)
_ = forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined::t)
  alignment :: ElField '(s, t) -> Int
alignment ElField '(s, t)
_ = forall a. Storable a => a -> Int
alignment (forall a. HasCallStack => a
undefined::t)
  peek :: Ptr (ElField '(s, t)) -> IO (ElField '(s, t))
peek Ptr (ElField '(s, t))
ptr = forall (t :: (Symbol, *)). Snd t -> ElField t
Field forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr (ElField '(s, t))
ptr)
  poke :: Ptr (ElField '(s, t)) -> ElField '(s, t) -> IO ()
poke Ptr (ElField '(s, t))
ptr (Field Snd '(s, t)
x) = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr (ElField '(s, t))
ptr) Snd '(s, t)
x
instance Show a => Show (Const a b) where
  show :: Const a b -> String
show (Const a
x) = String
"(Const "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show a
x forall a. [a] -> [a] -> [a]
++String
")"

instance Eq a => Eq (Const a b) where
  Const a
x == :: Const a b -> Const a b -> Bool
== Const a
y = a
x forall a. Eq a => a -> a -> Bool
== a
y

instance (Functor f, Functor g) => Functor (Compose f g) where
  fmap :: forall a b. (a -> b) -> Compose f g a -> Compose f g b
fmap a -> b
f (Compose f (g a)
x) = forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) f (g a)
x)

instance (Foldable f, Foldable g) => Foldable (Compose f g) where
  foldMap :: forall m a. Monoid m => (a -> m) -> Compose f g a -> m
foldMap a -> m
f (Compose f (g a)
t) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) f (g a)
t

instance (Traversable f, Traversable g) => Traversable (Compose f g) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Compose f g a -> f (Compose f g b)
traverse a -> f b
f (Compose f (g a)
t) = forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) f (g a)
t

instance (Applicative f, Applicative g) => Applicative (Compose f g) where
  pure :: forall a. a -> Compose f g a
pure a
x = forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x))
  Compose f (g (a -> b))
f <*> :: forall a b. Compose f g (a -> b) -> Compose f g a -> Compose f g b
<*> Compose f (g a)
x = forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose (forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (g (a -> b))
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (g a)
x)

instance Show (f (g a)) => Show (Compose f g a) where
  show :: Compose f g a -> String
show (Compose f (g a)
x) = forall a. Show a => a -> String
show f (g a)
x

instance Applicative Identity where
  pure :: forall a. a -> Identity a
pure = forall a. a -> Identity a
Identity
  Identity a -> b
f <*> :: forall a b. Identity (a -> b) -> Identity a -> Identity b
<*> Identity a
x = forall a. a -> Identity a
Identity (a -> b
f a
x)

instance Monad Identity where
  return :: forall a. a -> Identity a
return = forall a. a -> Identity a
Identity
  Identity a
x >>= :: forall a b. Identity a -> (a -> Identity b) -> Identity b
>>= a -> Identity b
f = a -> Identity b
f a
x

instance Show a => Show (Identity a) where
  show :: Identity a -> String
show (Identity a
x) = forall a. Show a => a -> String
show a
x

instance Applicative Thunk where
  pure :: forall a. a -> Thunk a
pure = forall a. a -> Thunk a
Thunk
  (Thunk a -> b
f) <*> :: forall a b. Thunk (a -> b) -> Thunk a -> Thunk b
<*> (Thunk a
x) = forall a. a -> Thunk a
Thunk (a -> b
f a
x)

instance Monad Thunk where
  return :: forall a. a -> Thunk a
return = forall a. a -> Thunk a
Thunk
  (Thunk a
x) >>= :: forall a b. Thunk a -> (a -> Thunk b) -> Thunk b
>>= a -> Thunk b
f = a -> Thunk b
f a
x

instance Show a => Show (Thunk a) where
  show :: Thunk a -> String
show (Thunk a
x) = forall a. Show a => a -> String
show a
x

instance (Functor f, Functor g) => Functor (Lift (,) f g) where
  fmap :: forall a b. (a -> b) -> Lift (,) f g a -> Lift (,) f g b
fmap a -> b
f (Lift (f a
x, g a
y)) = forall l l' k (op :: l -> l' -> *) (f :: k -> l) (g :: k -> l')
       (x :: k).
op (f x) (g x) -> Lift op f g x
Lift (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
x, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f g a
y)

instance (Functor f, Functor g) => Functor (Lift Either f g) where
  fmap :: forall a b. (a -> b) -> Lift Either f g a -> Lift Either f g b
fmap a -> b
f (Lift (Left f a
x)) = forall l l' k (op :: l -> l' -> *) (f :: k -> l) (g :: k -> l')
       (x :: k).
op (f x) (g x) -> Lift op f g x
Lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall a b. (a -> b) -> a -> b
$ f a
x
  fmap a -> b
f (Lift (Right g a
x)) = forall l l' k (op :: l -> l' -> *) (f :: k -> l) (g :: k -> l')
       (x :: k).
op (f x) (g x) -> Lift op f g x
Lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall a b. (a -> b) -> a -> b
$ g a
x

instance (Applicative f, Applicative g) => Applicative (Lift (,) f g) where
  pure :: forall a. a -> Lift (,) f g a
pure a
x = forall l l' k (op :: l -> l' -> *) (f :: k -> l) (g :: k -> l')
       (x :: k).
op (f x) (g x) -> Lift op f g x
Lift (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x, forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  Lift (f (a -> b)
f, g (a -> b)
g) <*> :: forall a b.
Lift (,) f g (a -> b) -> Lift (,) f g a -> Lift (,) f g b
<*> Lift (f a
x, g a
y) = forall l l' k (op :: l -> l' -> *) (f :: k -> l) (g :: k -> l')
       (x :: k).
op (f x) (g x) -> Lift op f g x
Lift (f (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
x, g (a -> b)
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g a
y)

-- $setup
-- >>> import Data.Vinyl.Core
-- >>> :set -XDataKinds
--

{- $example
    The data types in this module are used to build interpretation
    fuctions for a 'Rec'. To build a 'Rec' that is simply a heterogeneous
    list, use 'Identity':

>>> :{
let myRec1 :: Rec Identity '[Int,Bool,Char]
    myRec1 = Identity 4 :& Identity True :& Identity 'c' :& RNil
:}

    For a record in which the fields are optional, you could alternatively
    write:

>>> :{
let myRec2 :: Rec Maybe '[Int,Bool,Char]
    myRec2 = Just 4 :& Nothing :& Nothing :& RNil
:}

    And we can gather all of the effects with 'rtraverse':

>>> let r2 = rtraverse (fmap Identity) myRec2
>>> :t r2
r2 :: Maybe (Rec Identity '[Int, Bool, Char])
>>> r2
Nothing

    If the fields only exist once an environment is provided, you can
    build the record as follows:

>>> :{
let myRec3 :: Rec ((->) Int) '[Int,Bool,Char]
    myRec3 = (+5) :& (const True) :& (head . show) :& RNil
:}

    And again, we can collect these effects with "rtraverse":

>>> (rtraverse (fmap Identity) myRec3) 8
{13, True, '8'}

    If you want the composition of these two effects, you can use "Compose":

>>> import Data.Char (chr)
>>> :{
let safeDiv a b = if b == 0 then Nothing else Just (div a b)
    safeChr i = if i >= 32 && i <= 126 then Just (chr i) else Nothing
    myRec4 :: Rec (Compose ((->) Int) Maybe) '[Int,Char]
    myRec4 = (Compose $ safeDiv 42) :& (Compose safeChr) :& RNil
:}

-}

{- $ecosystem
    Of the five data types provided by this modules, three can
    be found in others places: "Identity", "Compose", and "Const".
    They are included with "vinyl" to help keep the dependency
    list small. The differences will be discussed here.

    The "Data.Functor.Identity" module was originally provided
    by "transformers". When GHC 7.10 was released, it was moved
    into "base-4.8". The "Identity" data type provided by that
    module is well recognized across the haskell ecosystem
    and has typeclass instances for lots of common typeclasses.
    The significant difference between it and the copy of
    it provided here is that this one has a different 'Show'
    instance. This is illustrated below:

>>> Identity "hello"
"hello"

    But, when using "Identity" from "base":

>>> import qualified Data.Functor.Identity as Base
>>> Base.Identity "hello"
Identity "hello"

    This 'Show' instance makes records look nicer in GHCi.
    Feel free to use "Data.Functor.Identity" if you do not
    need the prettier output or if you need the many additional
    typeclass instances that are provided for the standard
    "Identity".

    The story with "Compose" and "Const" is much more simple.
    These also exist in "transformers", although "Const"
    is named "Constant" there. Prior to the release of
    "transformers-0.5", they were not polykinded, making
    them unusable for certain universes. However, in
    "transformers-0.5" and forward, they have been made
    polykinded. This means that they are just as usable with 'Rec'
    as the vinyl equivalents but with many more typeclass
    instances such as 'Ord' and 'Show'.
-}