{-# 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)

{- $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 { Identity a -> a
getIdentity :: a }
    deriving ( a -> Identity b -> Identity a
(a -> b) -> Identity a -> Identity b
(forall a b. (a -> b) -> Identity a -> Identity b)
-> (forall a b. a -> Identity b -> Identity a) -> Functor Identity
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
<$ :: a -> Identity b -> Identity a
$c<$ :: forall a b. a -> Identity b -> Identity a
fmap :: (a -> b) -> Identity a -> Identity b
$cfmap :: forall a b. (a -> b) -> Identity a -> Identity b
Functor
             , Identity a -> Bool
(a -> m) -> Identity a -> m
(a -> b -> b) -> b -> Identity a -> b
(forall m. Monoid m => Identity m -> m)
-> (forall m a. Monoid m => (a -> m) -> Identity a -> m)
-> (forall m a. Monoid m => (a -> m) -> Identity a -> m)
-> (forall a b. (a -> b -> b) -> b -> Identity a -> b)
-> (forall a b. (a -> b -> b) -> b -> Identity a -> b)
-> (forall b a. (b -> a -> b) -> b -> Identity a -> b)
-> (forall b a. (b -> a -> b) -> b -> Identity a -> b)
-> (forall a. (a -> a -> a) -> Identity a -> a)
-> (forall a. (a -> a -> a) -> Identity a -> a)
-> (forall a. Identity a -> [a])
-> (forall a. Identity a -> Bool)
-> (forall a. Identity a -> Int)
-> (forall a. Eq a => a -> Identity a -> Bool)
-> (forall a. Ord a => Identity a -> a)
-> (forall a. Ord a => Identity a -> a)
-> (forall a. Num a => Identity a -> a)
-> (forall a. Num a => Identity a -> a)
-> Foldable Identity
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 :: Identity a -> a
$cproduct :: forall a. Num a => Identity a -> a
sum :: Identity a -> a
$csum :: forall a. Num a => Identity a -> a
minimum :: Identity a -> a
$cminimum :: forall a. Ord a => Identity a -> a
maximum :: Identity a -> a
$cmaximum :: forall a. Ord a => Identity a -> a
elem :: a -> Identity a -> Bool
$celem :: forall a. Eq a => a -> Identity a -> Bool
length :: Identity a -> Int
$clength :: forall a. Identity a -> Int
null :: Identity a -> Bool
$cnull :: forall a. Identity a -> Bool
toList :: Identity a -> [a]
$ctoList :: forall a. Identity a -> [a]
foldl1 :: (a -> a -> a) -> Identity a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Identity a -> a
foldr1 :: (a -> a -> a) -> Identity a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Identity a -> a
foldl' :: (b -> a -> b) -> b -> Identity a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Identity a -> b
foldl :: (b -> a -> b) -> b -> Identity a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Identity a -> b
foldr' :: (a -> b -> b) -> b -> Identity a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Identity a -> b
foldr :: (a -> b -> b) -> b -> Identity a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Identity a -> b
foldMap' :: (a -> m) -> Identity a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Identity a -> m
foldMap :: (a -> m) -> Identity a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Identity a -> m
fold :: Identity m -> m
$cfold :: forall m. Monoid m => Identity m -> m
Foldable
             , Functor Identity
Foldable Identity
Functor Identity
-> Foldable Identity
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Identity a -> f (Identity b))
-> (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 (m :: * -> *) a.
    Monad m =>
    Identity (m a) -> m (Identity a))
-> Traversable Identity
(a -> f b) -> Identity a -> f (Identity b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => 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 :: Identity (m a) -> m (Identity a)
$csequence :: forall (m :: * -> *) a. Monad m => Identity (m a) -> m (Identity a)
mapM :: (a -> m b) -> Identity a -> m (Identity b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Identity a -> m (Identity b)
sequenceA :: Identity (f a) -> f (Identity a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Identity (f a) -> f (Identity a)
traverse :: (a -> f b) -> Identity a -> f (Identity b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Identity a -> f (Identity b)
$cp2Traversable :: Foldable Identity
$cp1Traversable :: Functor Identity
Traversable
             , Ptr b -> Int -> IO (Identity a)
Ptr b -> Int -> Identity a -> IO ()
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
(Identity a -> Int)
-> (Identity a -> Int)
-> (Ptr (Identity a) -> Int -> IO (Identity a))
-> (Ptr (Identity a) -> Int -> Identity a -> IO ())
-> (forall b. Ptr b -> Int -> IO (Identity a))
-> (forall b. Ptr b -> Int -> Identity a -> IO ())
-> (Ptr (Identity a) -> IO (Identity a))
-> (Ptr (Identity a) -> Identity a -> IO ())
-> Storable (Identity a)
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 :: Ptr b -> Int -> Identity a -> IO ()
$cpokeByteOff :: forall a b. Storable a => Ptr b -> Int -> Identity a -> IO ()
peekByteOff :: 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
(Identity a -> Identity a -> Bool)
-> (Identity a -> Identity a -> Bool) -> Eq (Identity a)
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
             , Eq (Identity a)
Eq (Identity a)
-> (Identity a -> Identity a -> Ordering)
-> (Identity a -> Identity a -> Bool)
-> (Identity a -> Identity a -> Bool)
-> (Identity a -> Identity a -> Bool)
-> (Identity a -> Identity a -> Bool)
-> (Identity a -> Identity a -> Identity a)
-> (Identity a -> Identity a -> Identity a)
-> Ord (Identity a)
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
$cp1Ord :: forall a. Ord a => Eq (Identity a)
Ord
             , (forall x. Identity a -> Rep (Identity a) x)
-> (forall x. Rep (Identity a) x -> Identity a)
-> Generic (Identity a)
forall x. Rep (Identity a) x -> Identity a
forall x. Identity a -> Rep (Identity a) x
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 { Thunk a -> a
getThunk :: a }
    deriving ( a -> Thunk b -> Thunk a
(a -> b) -> Thunk a -> Thunk b
(forall a b. (a -> b) -> Thunk a -> Thunk b)
-> (forall a b. a -> Thunk b -> Thunk a) -> Functor Thunk
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
<$ :: a -> Thunk b -> Thunk a
$c<$ :: forall a b. a -> Thunk b -> Thunk a
fmap :: (a -> b) -> Thunk a -> Thunk b
$cfmap :: forall a b. (a -> b) -> Thunk a -> Thunk b
Functor
             , Thunk a -> Bool
(a -> m) -> Thunk a -> m
(a -> b -> b) -> b -> Thunk a -> b
(forall m. Monoid m => Thunk m -> m)
-> (forall m a. Monoid m => (a -> m) -> Thunk a -> m)
-> (forall m a. Monoid m => (a -> m) -> Thunk a -> m)
-> (forall a b. (a -> b -> b) -> b -> Thunk a -> b)
-> (forall a b. (a -> b -> b) -> b -> Thunk a -> b)
-> (forall b a. (b -> a -> b) -> b -> Thunk a -> b)
-> (forall b a. (b -> a -> b) -> b -> Thunk a -> b)
-> (forall a. (a -> a -> a) -> Thunk a -> a)
-> (forall a. (a -> a -> a) -> Thunk a -> a)
-> (forall a. Thunk a -> [a])
-> (forall a. Thunk a -> Bool)
-> (forall a. Thunk a -> Int)
-> (forall a. Eq a => a -> Thunk a -> Bool)
-> (forall a. Ord a => Thunk a -> a)
-> (forall a. Ord a => Thunk a -> a)
-> (forall a. Num a => Thunk a -> a)
-> (forall a. Num a => Thunk a -> a)
-> Foldable Thunk
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 :: Thunk a -> a
$cproduct :: forall a. Num a => Thunk a -> a
sum :: Thunk a -> a
$csum :: forall a. Num a => Thunk a -> a
minimum :: Thunk a -> a
$cminimum :: forall a. Ord a => Thunk a -> a
maximum :: Thunk a -> a
$cmaximum :: forall a. Ord a => Thunk a -> a
elem :: a -> Thunk a -> Bool
$celem :: forall a. Eq a => a -> Thunk a -> Bool
length :: Thunk a -> Int
$clength :: forall a. Thunk a -> Int
null :: Thunk a -> Bool
$cnull :: forall a. Thunk a -> Bool
toList :: Thunk a -> [a]
$ctoList :: forall a. Thunk a -> [a]
foldl1 :: (a -> a -> a) -> Thunk a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Thunk a -> a
foldr1 :: (a -> a -> a) -> Thunk a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Thunk a -> a
foldl' :: (b -> a -> b) -> b -> Thunk a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Thunk a -> b
foldl :: (b -> a -> b) -> b -> Thunk a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Thunk a -> b
foldr' :: (a -> b -> b) -> b -> Thunk a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Thunk a -> b
foldr :: (a -> b -> b) -> b -> Thunk a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Thunk a -> b
foldMap' :: (a -> m) -> Thunk a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Thunk a -> m
foldMap :: (a -> m) -> Thunk a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Thunk a -> m
fold :: Thunk m -> m
$cfold :: forall m. Monoid m => Thunk m -> m
Foldable
             , Functor Thunk
Foldable Thunk
Functor Thunk
-> Foldable Thunk
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Thunk a -> f (Thunk b))
-> (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 (m :: * -> *) a. Monad m => Thunk (m a) -> m (Thunk a))
-> Traversable Thunk
(a -> f b) -> Thunk a -> f (Thunk b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => 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 :: Thunk (m a) -> m (Thunk a)
$csequence :: forall (m :: * -> *) a. Monad m => Thunk (m a) -> m (Thunk a)
mapM :: (a -> m b) -> Thunk a -> m (Thunk b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Thunk a -> m (Thunk b)
sequenceA :: Thunk (f a) -> f (Thunk a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Thunk (f a) -> f (Thunk a)
traverse :: (a -> f b) -> Thunk a -> f (Thunk b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Thunk a -> f (Thunk b)
$cp2Traversable :: Foldable Thunk
$cp1Traversable :: Functor Thunk
Traversable
             )

newtype Lift (op :: l -> l' -> *) (f :: k -> l) (g :: k -> l') (x :: k)
  = Lift { 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 { Compose f g x -> f (g x)
getCompose :: f (g x) }
    deriving (Ptr b -> Int -> IO (Compose f g x)
Ptr b -> Int -> Compose f g x -> IO ()
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
(Compose f g x -> Int)
-> (Compose f g x -> Int)
-> (Ptr (Compose f g x) -> Int -> IO (Compose f g x))
-> (Ptr (Compose f g x) -> Int -> Compose f g x -> IO ())
-> (forall b. Ptr b -> Int -> IO (Compose f g x))
-> (forall b. Ptr b -> Int -> Compose f g x -> IO ())
-> (Ptr (Compose f g x) -> IO (Compose f g x))
-> (Ptr (Compose f g x) -> Compose f g x -> IO ())
-> Storable (Compose f g x)
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 :: 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 :: 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 x. Compose f g x -> Rep (Compose f g x) x)
-> (forall x. Rep (Compose f g x) x -> Compose f g x)
-> Generic (Compose f g x)
forall x. Rep (Compose f g x) x -> Compose f g x
forall x. Compose f g x -> Rep (Compose f g x) x
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 = f (g a) -> Compose f g a
forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose (f (g a)
x f (g a) -> f (g a) -> f (g a)
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 = f (g a) -> Compose f g a
forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose f (g a)
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) = f (g a) -> Compose f g a
forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose (f (g a) -> f (g a) -> f (g a)
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 :: (f (g a) -> h (k a)) -> (:.) f g a -> (:.) h k a
onCompose f (g a) -> h (k a)
f = h (k a) -> (:.) h k a
forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose (h (k a) -> (:.) h k a)
-> ((:.) f g a -> h (k a)) -> (:.) f g a -> (:.) h k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (g a) -> h (k a)
f (f (g a) -> h (k a))
-> ((:.) f g a -> f (g a)) -> (:.) f g a -> h (k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:.) f g a -> f (g a)
forall l (f :: l -> *) k (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 { Const a b -> a
getConst :: a }
    deriving ( (a -> b) -> Const a a -> Const a b
(forall a b. (a -> b) -> Const a a -> Const a b)
-> (forall a b. a -> Const a b -> Const a a) -> Functor (Const a)
forall a b. a -> Const a b -> Const a a
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
<$ :: a -> Const a b -> Const a a
$c<$ :: forall a a b. a -> Const a b -> Const a a
fmap :: (a -> b) -> Const a a -> Const a b
$cfmap :: forall a a b. (a -> b) -> Const a a -> Const a b
Functor
             , (a -> m) -> Const a a -> m
(forall m. Monoid m => Const a m -> m)
-> (forall m a. Monoid m => (a -> m) -> Const a a -> m)
-> (forall m a. Monoid m => (a -> m) -> Const a a -> m)
-> (forall a b. (a -> b -> b) -> b -> Const a a -> b)
-> (forall a b. (a -> b -> b) -> b -> Const a a -> b)
-> (forall b a. (b -> a -> b) -> b -> Const a a -> b)
-> (forall b a. (b -> a -> b) -> b -> Const a a -> b)
-> (forall a. (a -> a -> a) -> Const a a -> a)
-> (forall a. (a -> a -> a) -> Const a a -> a)
-> (forall a. Const a a -> [a])
-> (forall a. Const a a -> Bool)
-> (forall a. Const a a -> Int)
-> (forall a. Eq a => a -> Const a a -> Bool)
-> (forall a. Ord a => Const a a -> a)
-> (forall a. Ord a => Const a a -> a)
-> (forall a. Num a => Const a a -> a)
-> (forall a. Num a => Const a a -> a)
-> Foldable (Const a)
forall a. Eq a => a -> Const a a -> Bool
forall a. Num a => Const a a -> a
forall a. Ord a => Const a a -> a
forall m. Monoid m => Const a m -> m
forall a. Const a a -> Bool
forall a. Const a a -> Int
forall a. Const a a -> [a]
forall a. (a -> a -> a) -> Const a a -> a
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 b a. (b -> a -> b) -> b -> Const a a -> b
forall a b. (a -> b -> b) -> b -> Const a a -> b
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 :: Const a a -> a
$cproduct :: forall a a. Num a => Const a a -> a
sum :: Const a a -> a
$csum :: forall a a. Num a => Const a a -> a
minimum :: Const a a -> a
$cminimum :: forall a a. Ord a => Const a a -> a
maximum :: Const a a -> a
$cmaximum :: forall a a. Ord a => Const a a -> a
elem :: a -> Const a a -> Bool
$celem :: forall a a. Eq a => a -> Const a a -> Bool
length :: Const a a -> Int
$clength :: forall a a. Const a a -> Int
null :: Const a a -> Bool
$cnull :: forall a a. Const a a -> Bool
toList :: Const a a -> [a]
$ctoList :: forall a a. Const a a -> [a]
foldl1 :: (a -> a -> a) -> Const a a -> a
$cfoldl1 :: forall a a. (a -> a -> a) -> Const a a -> a
foldr1 :: (a -> a -> a) -> Const a a -> a
$cfoldr1 :: forall a a. (a -> a -> a) -> Const a a -> a
foldl' :: (b -> a -> b) -> b -> Const a a -> b
$cfoldl' :: forall a b a. (b -> a -> b) -> b -> Const a a -> b
foldl :: (b -> a -> b) -> b -> Const a a -> b
$cfoldl :: forall a b a. (b -> a -> b) -> b -> Const a a -> b
foldr' :: (a -> b -> b) -> b -> Const a a -> b
$cfoldr' :: forall a a b. (a -> b -> b) -> b -> Const a a -> b
foldr :: (a -> b -> b) -> b -> Const a a -> b
$cfoldr :: forall a a b. (a -> b -> b) -> b -> Const a a -> b
foldMap' :: (a -> m) -> Const a a -> m
$cfoldMap' :: forall a m a. Monoid m => (a -> m) -> Const a a -> m
foldMap :: (a -> m) -> Const a a -> m
$cfoldMap :: forall a m a. Monoid m => (a -> m) -> Const a a -> m
fold :: Const a m -> m
$cfold :: forall a m. Monoid m => Const a m -> m
Foldable
             , Functor (Const a)
Foldable (Const a)
Functor (Const a)
-> Foldable (Const a)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Const a a -> f (Const a b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Const a (f a) -> f (Const a a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Const a a -> m (Const a b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Const a (m a) -> m (Const a a))
-> Traversable (Const a)
(a -> f b) -> Const a a -> f (Const a b)
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 (m :: * -> *) a. Monad m => Const a (m a) -> m (Const a a)
forall (f :: * -> *) a.
Applicative f =>
Const a (f a) -> f (Const a a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Const a a -> m (Const a b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Const a a -> f (Const a b)
sequence :: Const a (m a) -> m (Const a a)
$csequence :: forall a (m :: * -> *) a. Monad m => Const a (m a) -> m (Const a a)
mapM :: (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 :: Const a (f a) -> f (Const a a)
$csequenceA :: forall a (f :: * -> *) a.
Applicative f =>
Const a (f a) -> f (Const a a)
traverse :: (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)
$cp2Traversable :: forall a. Foldable (Const a)
$cp1Traversable :: forall a. Functor (Const a)
Traversable
             , Ptr b -> Int -> IO (Const a b)
Ptr b -> Int -> Const a b -> IO ()
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
(Const a b -> Int)
-> (Const a b -> Int)
-> (Ptr (Const a b) -> Int -> IO (Const a b))
-> (Ptr (Const a b) -> Int -> Const a b -> IO ())
-> (forall b. Ptr b -> Int -> IO (Const a b))
-> (forall b. Ptr b -> Int -> Const a b -> IO ())
-> (Ptr (Const a b) -> IO (Const a b))
-> (Ptr (Const a b) -> Const a b -> IO ())
-> Storable (Const a b)
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 :: Ptr b -> Int -> Const a b -> IO ()
$cpokeByteOff :: forall a k (b :: k) b.
Storable a =>
Ptr b -> Int -> Const a b -> IO ()
peekByteOff :: 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 x. Const a b -> Rep (Const a b) x)
-> (forall x. Rep (Const a b) x -> Const a b)
-> Generic (Const a b)
forall x. Rep (Const a b) x -> Const a b
forall x. Const a b -> Rep (Const a b) x
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.
data ElField (field :: (Symbol, Type)) where
  Field :: KnownSymbol s => !t -> ElField '(s,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 :: ElField '(s, a) -> Rep (ElField '(s, a)) x
from (Field t
x) = K1 R t x -> M1 C ('MetaCons s 'PrefixI 'False) (K1 R t) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (t -> K1 R t x
forall k i c (p :: k). c -> K1 i c p
K1 t
x)
  to :: Rep (ElField '(s, a)) x -> ElField '(s, a)
to (M1 (K1 x)) = a -> ElField '(s, a)
forall (s :: Symbol) t. KnownSymbol s => t -> ElField '(s, t)
Field a
x

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

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

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

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

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

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

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

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

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

instance (Functor f, Functor g) => Functor (Compose f g) where
  fmap :: (a -> b) -> Compose f g a -> Compose f g b
fmap a -> b
f (Compose f (g a)
x) = f (g b) -> Compose f g b
forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose ((g a -> g b) -> f (g a) -> f (g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> g a -> g b
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 :: (a -> m) -> Compose f g a -> m
foldMap a -> m
f (Compose f (g a)
t) = (g a -> m) -> f (g a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> g a -> m
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 :: (a -> f b) -> Compose f g a -> f (Compose f g b)
traverse a -> f b
f (Compose f (g a)
t) = f (g b) -> Compose f g b
forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose (f (g b) -> Compose f g b) -> f (f (g b)) -> f (Compose f g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (g a -> f (g b)) -> f (g a) -> f (f (g b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f b) -> g a -> f (g b)
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 :: a -> Compose f g a
pure a
x = f (g a) -> Compose f g a
forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose (g a -> f (g a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> g a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x))
  Compose f (g (a -> b))
f <*> :: Compose f g (a -> b) -> Compose f g a -> Compose f g b
<*> Compose f (g a)
x = f (g b) -> Compose f g b
forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose (g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (g (a -> b) -> g a -> g b) -> f (g (a -> b)) -> f (g a -> g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (g (a -> b))
f f (g a -> g b) -> f (g a) -> f (g b)
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) = f (g a) -> String
forall a. Show a => a -> String
show f (g a)
x

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

instance Monad Identity where
  return :: a -> Identity a
return = a -> Identity a
forall a. a -> Identity a
Identity
  Identity a
x >>= :: 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) = a -> String
forall a. Show a => a -> String
show a
x

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

instance Monad Thunk where
  return :: a -> Thunk a
return = a -> Thunk a
forall a. a -> Thunk a
Thunk
  (Thunk a
x) >>= :: 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) = a -> String
forall a. Show a => a -> String
show a
x

instance (Functor f, Functor g) => Functor (Lift (,) f g) where
  fmap :: (a -> b) -> Lift (,) f g a -> Lift (,) f g b
fmap a -> b
f (Lift (f a
x, g a
y)) = (f b, g b) -> Lift (,) f g b
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 ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
x, (a -> b) -> g a -> g b
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 :: (a -> b) -> Lift Either f g a -> Lift Either f g b
fmap a -> b
f (Lift (Left f a
x)) = Either (f b) (g b) -> Lift Either f g b
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 (Either (f b) (g b) -> Lift Either f g b)
-> (f a -> Either (f b) (g b)) -> f a -> Lift Either f g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f b -> Either (f b) (g b)
forall a b. a -> Either a b
Left (f b -> Either (f b) (g b))
-> (f a -> f b) -> f a -> Either (f b) (g b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (f a -> Lift Either f g b) -> f a -> Lift Either f g b
forall a b. (a -> b) -> a -> b
$ f a
x
  fmap a -> b
f (Lift (Right g a
x)) = Either (f b) (g b) -> Lift Either f g b
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 (Either (f b) (g b) -> Lift Either f g b)
-> (g a -> Either (f b) (g b)) -> g a -> Lift Either f g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g b -> Either (f b) (g b)
forall a b. b -> Either a b
Right (g b -> Either (f b) (g b))
-> (g a -> g b) -> g a -> Either (f b) (g b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (g a -> Lift Either f g b) -> g a -> Lift Either f g b
forall a b. (a -> b) -> a -> b
$ g a
x

instance (Applicative f, Applicative g) => Applicative (Lift (,) f g) where
  pure :: a -> Lift (,) f g a
pure a
x = (f a, g a) -> Lift (,) f g a
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 (a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x, a -> g a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  Lift (f (a -> b)
f, g (a -> b)
g) <*> :: Lift (,) f g (a -> b) -> Lift (,) f g a -> Lift (,) f g b
<*> Lift (f a
x, g a
y) = (f b, g b) -> Lift (,) f g b
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 f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
x, g (a -> b)
g g (a -> b) -> g a -> g b
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'.
-}