{-# LANGUAGE CPP                   #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE UndecidableInstances  #-}
-- |
-- @fixed-vector@ library provides general API for working with short
-- N-element arrays. Functions in this module work on data types which
-- are instances of 'Vector' type class. We provide instances for data
-- types from @base@: tuples, 'Data.Complex.Complex', and few others.
-- There are several length polymorphic arrays:
--
--  * Lazy boxed arrays "Data.Vector.Fixed.Boxed".
--
--  * Strict boxed arrays "Data.Vector.Fixed.Strict".
--
--  * Arrays backed by single @ByteArray@: "Data.Vector.Fixed.Primitive".
--
--  * Arrays backed by pinned memory: "Data.Vector.Fixed.Storable".
--
--  * Arrays which infer array representation from element data type:
--    "Data.Vector.Fixed.Unboxed"
--
--  * Continuation based 'Data.Vector.Fixed.Cont.ContVec' which used
--    by library internally.
--
-- Type level naturals don't have support for induction so all type
-- level computation with length and indices are done using Peano
-- numerals ('PeanoNum'). Type level naturals are only used as type
-- parameters for defining length of arrays.
--
-- [@Instances for tuples@]
--
-- Library provides instances for tuples. They however come with caveat.
-- Let look at 'Vector' instance for 2-tuple:
--
-- > instance b ~ a => Vector ((,) b) a
--
-- Tuple could only be @Vector@ instance if all elements have same
-- type.  so first element fixes type of second one. Thus functions
-- which change element type like 'map' won't work:
--
-- > >>> map (== 1) ((1,2) :: (Int,Int))
-- >
-- > <interactive>:3:1:
-- >     Couldn't match type `Int' with `Bool'
-- >     In the expression: F.map (== 1) ((1, 2) :: (Int, Int))
-- >     In an equation for `it': it = map (== 1) ((1, 2) :: (Int, Int))
--
-- This could be solved either by switching to @ContVec@ manually:
--
-- >>> (vector . map (==1) . cvec) ((1, 2) :: Tuple2 Int) :: Tuple2 Bool
-- (True,False)
--
-- or by using functions genereic in vector type from module
-- "Data.Vector.Fixed.Generic".
module Data.Vector.Fixed (
    -- * Vector type class
    Vector(..)
  , Dim
  , Arity
  , ArityPeano
  , Fun(..)
  , length
    -- ** Peano numbers
  , PeanoNum(..)
  , C.Peano
  , C.N1, C.N2, C.N3, C.N4, C.N5, C.N6, C.N7, C.N8
    -- * Construction and destructions
    -- $construction

    -- ** Constructors
  , mk0
  , mk1
  , mk2
  , mk3
  , mk4
  , mk5
  , mk6
  , mk7
  , mk8
  , mkN
    -- ** Pattern synonyms
  , pattern V1
  , pattern V2
  , pattern V3
  , pattern V4
    -- * Functions
    -- ** Creation
  , replicate
  , replicateM
  , generate
  , generateM
  , unfoldr
  , basis
    -- ** Transformations
  , head
  , tail
  , cons
  , snoc
  , concat
  , reverse
    -- ** Indexing & lenses
  , C.Index
  , (!)
  , index
  , set
  , element
  , elementTy
    -- ** Maps
  , map
  , mapM
  , mapM_
  , imap
  , imapM
  , imapM_
  , scanl
  , scanl1
  , sequence
  , sequence_
  , traverse
  , distribute
  , collect
    -- ** Folds
  , foldl
  , foldl'
  , foldr
  , foldl1
  , fold
  , foldMap
  , ifoldl
  , ifoldr
  , foldM
  , ifoldM
    -- *** Special folds
  , sum
  , maximum
  , minimum
  , and
  , or
  , all
  , any
  , find
    -- ** Zips
  , zipWith
  , zipWith3
  , zipWithM
  , zipWithM_
  , izipWith
  , izipWith3
  , izipWithM
  , izipWithM_
    -- *** Special zips
  , eq
  , ord
    -- ** Conversion
  , convert
  , toList
  , fromList
  , fromList'
  , fromListM
  , fromFoldable
    -- * Data types
  , VecList(..)
  , VecPeano(..)
  , Only(..)
  , Empty(..)
    -- ** Tuple synonyms
  , Tuple2
  , Tuple3
  , Tuple4
  , Tuple5
    -- ** Continuation-based vectors
  , ContVec
  , empty
  , vector
  , cvec
    -- * Instance deriving
  , ViaFixed(..)
    -- ** Storable
    -- $storable
  , defaultAlignemnt
  , defaultSizeOf
  , defaultPeek
  , defaultPoke
    -- ** NFData
  , defaultRnf
    -- * Deprecated functions
  , sequenceA
  ) where

import Control.Applicative (Applicative(..))
import Control.DeepSeq     (NFData(..))
import Data.Coerce
import Data.Data           (Data)
import Data.Monoid         (Monoid(..))
import Data.Semigroup      (Semigroup(..))
import Data.Foldable       qualified as F
import Data.Traversable    qualified as T
import Foreign.Storable    (Storable(..))
import GHC.TypeLits

import Data.Vector.Fixed.Cont     (Vector(..),Dim,length,ContVec,PeanoNum(..),
                                   vector,cvec,empty,Arity,ArityPeano,Fun(..),accum,apply)
import Data.Vector.Fixed.Cont     qualified as C
import Data.Vector.Fixed.Internal as I

import Prelude (Show(..),Eq(..),Ord(..),Num(..),Functor(..),id,(.),($),(<$>))


-- $construction
--
-- There are several ways to construct fixed vectors except using
-- their constructor if it's available. For small ones it's possible
-- to use functions 'mk1', 'mk2', etc.
--
-- >>> mk3 'a' 'b' 'c' :: (Char,Char,Char)
-- ('a','b','c')
--
-- Another way is to use pattern synonyms for construction and
-- inspection of vectors:
--
-- >>> V2 'a' 'b' :: (Char,Char)
-- ('a','b')
--
-- >>> case ('a','b') of V2 a b -> [a,b]
-- "ab"
--
-- Last option is to use 'convert' to convert between different vector
-- types of same length. For example
--
-- > v = convert (x,y,z)
--
-- This could be used in view patterns as well:
--
-- > foo :: Vec3 Double -> Foo
-- > foo (convert -> (x,y,z)) = ...
--
-- Pattern synonyms use this trick internally.


-- $storable
--
-- Default implementation of methods for Storable type class assumes
-- that individual elements of vector are stored as N-element array.


-- | Type-based vector with statically known length parametrized by
--   GHC's type naturals
newtype VecList (n :: Nat) a = VecList (VecPeano (C.Peano n) a)

-- | Standard GADT-based vector with statically known length
--   parametrized by Peano numbers.
data VecPeano (n :: PeanoNum) a where
  Nil  :: VecPeano 'Z a
  Cons :: a -> VecPeano n a -> VecPeano ('S n) a

type instance Dim (VecList  n) = C.Peano n
type instance Dim (VecPeano n) = n

instance Arity n => Vector (VecList n) a where
  construct :: Fun (Dim (VecList n)) a (VecList n a)
construct = VecPeano (Peano n) a -> VecList n a
forall (n :: Nat) a. VecPeano (Peano n) a -> VecList n a
VecList (VecPeano (Peano n) a -> VecList n a)
-> Fun (Peano n) a (VecPeano (Peano n) a)
-> Fun (Peano n) a (VecList n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (v :: * -> *) a. Vector v a => Fun (Dim v) a (v a)
construct @(VecPeano (C.Peano n)) @a
  inspect :: forall b. VecList n a -> Fun (Dim (VecList n)) a b -> b
inspect (VecList VecPeano (Peano n) a
v) = VecPeano (Peano n) a -> Fun (Dim (VecPeano (Peano n))) a b -> b
forall b.
VecPeano (Peano n) a -> Fun (Dim (VecPeano (Peano n))) a b -> b
forall (v :: * -> *) a b. Vector v a => v a -> Fun (Dim v) a b -> b
inspect VecPeano (Peano n) a
v
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance C.ArityPeano n => Vector (VecPeano n) a where
  construct :: Fun (Dim (VecPeano n)) a (VecPeano n a)
construct = (forall (k :: PeanoNum). T_List a n ('S k) -> a -> T_List a n k)
-> (T_List a n 'Z -> VecPeano n a)
-> T_List a n n
-> Fun n a (VecPeano n a)
forall (n :: PeanoNum) (t :: PeanoNum -> *) a b.
ArityPeano n =>
(forall (k :: PeanoNum). t ('S k) -> a -> t k)
-> (t 'Z -> b) -> t n -> Fun n a b
forall (t :: PeanoNum -> *) a b.
(forall (k :: PeanoNum). t ('S k) -> a -> t k)
-> (t 'Z -> b) -> t n -> Fun n a b
accum
    (\(T_List VecPeano ('S k) a -> VecPeano n a
f) a
a -> (VecPeano k a -> VecPeano n a) -> T_List a n k
forall a (n :: PeanoNum) (k :: PeanoNum).
(VecPeano k a -> VecPeano n a) -> T_List a n k
T_List (VecPeano ('S k) a -> VecPeano n a
f (VecPeano ('S k) a -> VecPeano n a)
-> (VecPeano k a -> VecPeano ('S k) a)
-> VecPeano k a
-> VecPeano n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> VecPeano k a -> VecPeano ('S k) a
forall a (n :: PeanoNum). a -> VecPeano n a -> VecPeano ('S n) a
Cons a
a))
    (\(T_List VecPeano 'Z a -> VecPeano n a
f)   -> VecPeano 'Z a -> VecPeano n a
f VecPeano 'Z a
forall a. VecPeano 'Z a
Nil)
    ((VecPeano n a -> VecPeano n a) -> T_List a n n
forall a (n :: PeanoNum) (k :: PeanoNum).
(VecPeano k a -> VecPeano n a) -> T_List a n k
T_List VecPeano n a -> VecPeano n a
forall a. a -> a
id :: T_List a n n)
  inspect :: forall b. VecPeano n a -> Fun (Dim (VecPeano n)) a b -> b
inspect VecPeano n a
v
    = ContVec n a -> Fun (Dim (ContVec n)) a b -> b
forall b. ContVec n a -> Fun (Dim (ContVec n)) a b -> b
forall (v :: * -> *) a b. Vector v a => v a -> Fun (Dim v) a b -> b
inspect ((forall (k :: PeanoNum).
 Flip VecPeano a ('S k) -> (a, Flip VecPeano a k))
-> Flip VecPeano a n -> ContVec n a
forall (n :: PeanoNum) (t :: PeanoNum -> *) a.
ArityPeano n =>
(forall (k :: PeanoNum). t ('S k) -> (a, t k))
-> t n -> ContVec n a
apply Flip VecPeano a ('S k) -> (a, Flip VecPeano a k)
forall (k :: PeanoNum).
Flip VecPeano a ('S k) -> (a, Flip VecPeano a k)
step (VecPeano n a -> Flip VecPeano a n
forall {k} {k} (f :: k -> k -> *) (a :: k) (n :: k).
f n a -> Flip f a n
Flip VecPeano n a
v) :: C.ContVec n a)
    where
      step :: Flip VecPeano a ('S k)  -> (a, Flip VecPeano a k)
      step :: forall (k :: PeanoNum).
Flip VecPeano a ('S k) -> (a, Flip VecPeano a k)
step (Flip (Cons a
a VecPeano n a
xs)) = (a
a, VecPeano k a -> Flip VecPeano a k
forall {k} {k} (f :: k -> k -> *) (a :: k) (n :: k).
f n a -> Flip f a n
Flip VecPeano k a
VecPeano n a
xs)
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

newtype Flip f a n = Flip (f n a)
newtype T_List a n k = T_List (VecPeano k a -> VecPeano n a)



deriving via ViaFixed (VecList n) instance (Arity n) => Functor     (VecList n)
deriving via ViaFixed (VecList n) instance (Arity n) => Applicative (VecList n)
deriving via ViaFixed (VecList n) instance (Arity n) => F.Foldable  (VecList n)

instance Arity n => T.Traversable (VecList n) where
  sequence :: forall (m :: * -> *) a.
Monad m =>
VecList n (m a) -> m (VecList n a)
sequence  = VecList n (m a) -> m (VecList n a)
forall (v :: * -> *) a (f :: * -> *).
(Vector v a, Vector v (f a), Applicative f) =>
v (f a) -> f (v a)
sequence
  sequenceA :: forall (f :: * -> *) a.
Applicative f =>
VecList n (f a) -> f (VecList n a)
sequenceA = VecList n (f a) -> f (VecList n a)
forall (v :: * -> *) a (f :: * -> *).
(Vector v a, Vector v (f a), Applicative f) =>
v (f a) -> f (v a)
sequence
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> VecList n a -> f (VecList n b)
traverse  = (a -> f b) -> VecList n a -> f (VecList n b)
forall (v :: * -> *) a b (f :: * -> *).
(Vector v a, Vector v b, Applicative f) =>
(a -> f b) -> v a -> f (v b)
mapM
  mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> VecList n a -> m (VecList n b)
mapM      = (a -> m b) -> VecList n a -> m (VecList n b)
forall (v :: * -> *) a b (f :: * -> *).
(Vector v a, Vector v b, Applicative f) =>
(a -> f b) -> v a -> f (v b)
mapM
  {-# INLINE sequence  #-}
  {-# INLINE sequenceA #-}
  {-# INLINE mapM      #-}
  {-# INLINE traverse  #-}

deriving via ViaFixed (VecList n) a instance (Arity n, Show      a) => Show      (VecList n a)
deriving via ViaFixed (VecList n) a instance (Arity n, Eq        a) => Eq        (VecList n a)
deriving via ViaFixed (VecList n) a instance (Arity n, Ord       a) => Ord       (VecList n a)
deriving via ViaFixed (VecList n) a instance (Arity n, NFData    a) => NFData    (VecList n a)
deriving via ViaFixed (VecList n) a instance (Arity n, Semigroup a) => Semigroup (VecList n a)
deriving via ViaFixed (VecList n) a instance (Arity n, Monoid    a) => Monoid    (VecList n a)
deriving via ViaFixed (VecList n) a instance (Arity n, Storable  a) => Storable  (VecList n a)



deriving via ViaFixed (VecPeano n) instance (ArityPeano n) => Functor     (VecPeano n)
deriving via ViaFixed (VecPeano n) instance (ArityPeano n) => Applicative (VecPeano n)
deriving via ViaFixed (VecPeano n) instance (ArityPeano n) => F.Foldable  (VecPeano n)

instance ArityPeano n => T.Traversable (VecPeano n) where
  sequence :: forall (m :: * -> *) a.
Monad m =>
VecPeano n (m a) -> m (VecPeano n a)
sequence  = VecPeano n (m a) -> m (VecPeano n a)
forall (v :: * -> *) a (f :: * -> *).
(Vector v a, Vector v (f a), Applicative f) =>
v (f a) -> f (v a)
sequence
  sequenceA :: forall (f :: * -> *) a.
Applicative f =>
VecPeano n (f a) -> f (VecPeano n a)
sequenceA = VecPeano n (f a) -> f (VecPeano n a)
forall (v :: * -> *) a (f :: * -> *).
(Vector v a, Vector v (f a), Applicative f) =>
v (f a) -> f (v a)
sequence
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> VecPeano n a -> f (VecPeano n b)
traverse  = (a -> f b) -> VecPeano n a -> f (VecPeano n b)
forall (v :: * -> *) a b (f :: * -> *).
(Vector v a, Vector v b, Applicative f) =>
(a -> f b) -> v a -> f (v b)
mapM
  mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> VecPeano n a -> m (VecPeano n b)
mapM      = (a -> m b) -> VecPeano n a -> m (VecPeano n b)
forall (v :: * -> *) a b (f :: * -> *).
(Vector v a, Vector v b, Applicative f) =>
(a -> f b) -> v a -> f (v b)
mapM
  {-# INLINE sequence  #-}
  {-# INLINE sequenceA #-}
  {-# INLINE mapM      #-}
  {-# INLINE traverse  #-}

deriving via ViaFixed (VecPeano n) a instance (ArityPeano n, Show      a) => Show      (VecPeano n a)
deriving via ViaFixed (VecPeano n) a instance (ArityPeano n, Eq        a) => Eq        (VecPeano n a)
deriving via ViaFixed (VecPeano n) a instance (ArityPeano n, Ord       a) => Ord       (VecPeano n a)
deriving via ViaFixed (VecPeano n) a instance (ArityPeano n, NFData    a) => NFData    (VecPeano n a)
deriving via ViaFixed (VecPeano n) a instance (ArityPeano n, Semigroup a) => Semigroup (VecPeano n a)
deriving via ViaFixed (VecPeano n) a instance (ArityPeano n, Monoid    a) => Monoid    (VecPeano n a)
deriving via ViaFixed (VecPeano n) a instance (ArityPeano n, Storable  a) => Storable  (VecPeano n a)



-- | Single-element tuple.
newtype Only a = Only a
                 deriving (Int -> Only a -> ShowS
[Only a] -> ShowS
Only a -> String
(Int -> Only a -> ShowS)
-> (Only a -> String) -> ([Only a] -> ShowS) -> Show (Only a)
forall a. Show a => Int -> Only a -> ShowS
forall a. Show a => [Only a] -> ShowS
forall a. Show a => Only a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Only a -> ShowS
showsPrec :: Int -> Only a -> ShowS
$cshow :: forall a. Show a => Only a -> String
show :: Only a -> String
$cshowList :: forall a. Show a => [Only a] -> ShowS
showList :: [Only a] -> ShowS
Show,Only a -> Only a -> Bool
(Only a -> Only a -> Bool)
-> (Only a -> Only a -> Bool) -> Eq (Only a)
forall a. Eq a => Only a -> Only a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Only a -> Only a -> Bool
== :: Only a -> Only a -> Bool
$c/= :: forall a. Eq a => Only a -> Only a -> Bool
/= :: Only a -> Only a -> Bool
Eq,Eq (Only a)
Eq (Only a) =>
(Only a -> Only a -> Ordering)
-> (Only a -> Only a -> Bool)
-> (Only a -> Only a -> Bool)
-> (Only a -> Only a -> Bool)
-> (Only a -> Only a -> Bool)
-> (Only a -> Only a -> Only a)
-> (Only a -> Only a -> Only a)
-> Ord (Only a)
Only a -> Only a -> Bool
Only a -> Only a -> Ordering
Only a -> Only a -> Only 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 (Only a)
forall a. Ord a => Only a -> Only a -> Bool
forall a. Ord a => Only a -> Only a -> Ordering
forall a. Ord a => Only a -> Only a -> Only a
$ccompare :: forall a. Ord a => Only a -> Only a -> Ordering
compare :: Only a -> Only a -> Ordering
$c< :: forall a. Ord a => Only a -> Only a -> Bool
< :: Only a -> Only a -> Bool
$c<= :: forall a. Ord a => Only a -> Only a -> Bool
<= :: Only a -> Only a -> Bool
$c> :: forall a. Ord a => Only a -> Only a -> Bool
> :: Only a -> Only a -> Bool
$c>= :: forall a. Ord a => Only a -> Only a -> Bool
>= :: Only a -> Only a -> Bool
$cmax :: forall a. Ord a => Only a -> Only a -> Only a
max :: Only a -> Only a -> Only a
$cmin :: forall a. Ord a => Only a -> Only a -> Only a
min :: Only a -> Only a -> Only a
Ord,Typeable (Only a)
Typeable (Only a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Only a -> c (Only a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Only a))
-> (Only a -> Constr)
-> (Only a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Only a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Only a)))
-> ((forall b. Data b => b -> b) -> Only a -> Only a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Only a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Only a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Only a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Only a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Only a -> m (Only a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Only a -> m (Only a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Only a -> m (Only a))
-> Data (Only a)
Only a -> Constr
Only a -> DataType
(forall b. Data b => b -> b) -> Only a -> Only a
forall a. Data a => Typeable (Only a)
forall a. Data a => Only a -> Constr
forall a. Data a => Only a -> DataType
forall a.
Data a =>
(forall b. Data b => b -> b) -> Only a -> Only a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Only a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Only a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Only a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Only a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Only a -> m (Only a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Only a -> m (Only a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Only a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Only a -> c (Only a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Only a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Only a))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Only a -> u
forall u. (forall d. Data d => d -> u) -> Only a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Only a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Only a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Only a -> m (Only a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Only a -> m (Only a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Only a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Only a -> c (Only a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Only a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Only a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Only a -> c (Only a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Only a -> c (Only a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Only a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Only a)
$ctoConstr :: forall a. Data a => Only a -> Constr
toConstr :: Only a -> Constr
$cdataTypeOf :: forall a. Data a => Only a -> DataType
dataTypeOf :: Only a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Only a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Only a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Only a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Only a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Only a -> Only a
gmapT :: (forall b. Data b => b -> b) -> Only a -> Only a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Only a -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Only a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Only a -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Only a -> r
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Only a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Only a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Only a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Only a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Only a -> m (Only a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Only a -> m (Only a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Only a -> m (Only a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Only a -> m (Only a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Only a -> m (Only a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Only a -> m (Only a)
Data,(forall a b. (a -> b) -> Only a -> Only b)
-> (forall a b. a -> Only b -> Only a) -> Functor Only
forall a b. a -> Only b -> Only a
forall a b. (a -> b) -> Only a -> Only b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Only a -> Only b
fmap :: forall a b. (a -> b) -> Only a -> Only b
$c<$ :: forall a b. a -> Only b -> Only a
<$ :: forall a b. a -> Only b -> Only a
Functor,(forall m. Monoid m => Only m -> m)
-> (forall m a. Monoid m => (a -> m) -> Only a -> m)
-> (forall m a. Monoid m => (a -> m) -> Only a -> m)
-> (forall a b. (a -> b -> b) -> b -> Only a -> b)
-> (forall a b. (a -> b -> b) -> b -> Only a -> b)
-> (forall b a. (b -> a -> b) -> b -> Only a -> b)
-> (forall b a. (b -> a -> b) -> b -> Only a -> b)
-> (forall a. (a -> a -> a) -> Only a -> a)
-> (forall a. (a -> a -> a) -> Only a -> a)
-> (forall a. Only a -> [a])
-> (forall a. Only a -> Bool)
-> (forall a. Only a -> Int)
-> (forall a. Eq a => a -> Only a -> Bool)
-> (forall a. Ord a => Only a -> a)
-> (forall a. Ord a => Only a -> a)
-> (forall a. Num a => Only a -> a)
-> (forall a. Num a => Only a -> a)
-> Foldable Only
forall a. Eq a => a -> Only a -> Bool
forall a. Num a => Only a -> a
forall a. Ord a => Only a -> a
forall m. Monoid m => Only m -> m
forall a. Only a -> Bool
forall a. Only a -> Int
forall a. Only a -> [a]
forall a. (a -> a -> a) -> Only a -> a
forall m a. Monoid m => (a -> m) -> Only a -> m
forall b a. (b -> a -> b) -> b -> Only a -> b
forall a b. (a -> b -> b) -> b -> Only 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
$cfold :: forall m. Monoid m => Only m -> m
fold :: forall m. Monoid m => Only m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Only a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Only a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Only a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Only a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Only a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Only a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Only a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Only a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Only a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Only a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Only a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Only a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Only a -> a
foldr1 :: forall a. (a -> a -> a) -> Only a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Only a -> a
foldl1 :: forall a. (a -> a -> a) -> Only a -> a
$ctoList :: forall a. Only a -> [a]
toList :: forall a. Only a -> [a]
$cnull :: forall a. Only a -> Bool
null :: forall a. Only a -> Bool
$clength :: forall a. Only a -> Int
length :: forall a. Only a -> Int
$celem :: forall a. Eq a => a -> Only a -> Bool
elem :: forall a. Eq a => a -> Only a -> Bool
$cmaximum :: forall a. Ord a => Only a -> a
maximum :: forall a. Ord a => Only a -> a
$cminimum :: forall a. Ord a => Only a -> a
minimum :: forall a. Ord a => Only a -> a
$csum :: forall a. Num a => Only a -> a
sum :: forall a. Num a => Only a -> a
$cproduct :: forall a. Num a => Only a -> a
product :: forall a. Num a => Only a -> a
F.Foldable,Functor Only
Foldable Only
(Functor Only, Foldable Only) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Only a -> f (Only b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Only (f a) -> f (Only a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Only a -> m (Only b))
-> (forall (m :: * -> *) a. Monad m => Only (m a) -> m (Only a))
-> Traversable Only
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 => Only (m a) -> m (Only a)
forall (f :: * -> *) a. Applicative f => Only (f a) -> f (Only a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Only a -> m (Only b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Only a -> f (Only b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Only a -> f (Only b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Only a -> f (Only b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Only (f a) -> f (Only a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Only (f a) -> f (Only a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Only a -> m (Only b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Only a -> m (Only b)
$csequence :: forall (m :: * -> *) a. Monad m => Only (m a) -> m (Only a)
sequence :: forall (m :: * -> *) a. Monad m => Only (m a) -> m (Only a)
T.Traversable)

instance Monoid a => Monoid (Only a) where
  mempty :: Only a
mempty  = a -> Only a
forall a. a -> Only a
Only a
forall a. Monoid a => a
mempty
  mappend :: Only a -> Only a -> Only a
mappend = Only a -> Only a -> Only a
forall a. Semigroup a => a -> a -> a
(<>)
instance (Semigroup a) => Semigroup (Only a) where
  <> :: Only a -> Only a -> Only a
(<>) = (a -> a -> a) -> Only a -> Only a -> Only a
forall a b. Coercible a b => a -> b
coerce (forall a. Semigroup a => a -> a -> a
(<>) @a)
  {-# INLINE (<>) #-}


instance NFData a => NFData (Only a) where
  rnf :: Only a -> ()
rnf (Only a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a

type instance Dim Only = C.N1

instance Vector Only a where
  construct :: Fun (Dim Only) a (Only a)
construct = Fn N1 a (Only a) -> Fun N1 a (Only a)
forall (n :: PeanoNum) a b. Fn n a b -> Fun n a b
Fun Fn N1 a (Only a)
a -> Only a
forall a. a -> Only a
Only
  inspect :: forall b. Only a -> Fun (Dim Only) a b -> b
inspect (Only a
a) (Fun Fn (Dim Only) a b
f) = Fn (Dim Only) a b
a -> b
f a
a
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance (Storable a) => Storable (Only a) where
  alignment :: Only a -> Int
alignment = (a -> Int) -> Only a -> Int
forall a b. Coercible a b => a -> b
coerce (forall a. Storable a => a -> Int
alignment @a)
  sizeOf :: Only a -> Int
sizeOf    = (a -> Int) -> Only a -> Int
forall a b. Coercible a b => a -> b
coerce (forall a. Storable a => a -> Int
sizeOf    @a)
  peek :: Ptr (Only a) -> IO (Only a)
peek      = (Ptr a -> IO a) -> Ptr (Only a) -> IO (Only a)
forall a b. Coercible a b => a -> b
coerce (forall a. Storable a => Ptr a -> IO a
peek      @a)
  poke :: Ptr (Only a) -> Only a -> IO ()
poke      = (Ptr a -> a -> IO ()) -> Ptr (Only a) -> Only a -> IO ()
forall a b. Coercible a b => a -> b
coerce (forall a. Storable a => Ptr a -> a -> IO ()
poke      @a)


-- | Empty tuple.
data Empty a = Empty
  deriving (Int -> Empty a -> ShowS
[Empty a] -> ShowS
Empty a -> String
(Int -> Empty a -> ShowS)
-> (Empty a -> String) -> ([Empty a] -> ShowS) -> Show (Empty a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (a :: k). Int -> Empty a -> ShowS
forall k (a :: k). [Empty a] -> ShowS
forall k (a :: k). Empty a -> String
$cshowsPrec :: forall k (a :: k). Int -> Empty a -> ShowS
showsPrec :: Int -> Empty a -> ShowS
$cshow :: forall k (a :: k). Empty a -> String
show :: Empty a -> String
$cshowList :: forall k (a :: k). [Empty a] -> ShowS
showList :: [Empty a] -> ShowS
Show,Empty a -> Empty a -> Bool
(Empty a -> Empty a -> Bool)
-> (Empty a -> Empty a -> Bool) -> Eq (Empty a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (a :: k). Empty a -> Empty a -> Bool
$c== :: forall k (a :: k). Empty a -> Empty a -> Bool
== :: Empty a -> Empty a -> Bool
$c/= :: forall k (a :: k). Empty a -> Empty a -> Bool
/= :: Empty a -> Empty a -> Bool
Eq,Eq (Empty a)
Eq (Empty a) =>
(Empty a -> Empty a -> Ordering)
-> (Empty a -> Empty a -> Bool)
-> (Empty a -> Empty a -> Bool)
-> (Empty a -> Empty a -> Bool)
-> (Empty a -> Empty a -> Bool)
-> (Empty a -> Empty a -> Empty a)
-> (Empty a -> Empty a -> Empty a)
-> Ord (Empty a)
Empty a -> Empty a -> Bool
Empty a -> Empty a -> Ordering
Empty a -> Empty a -> Empty 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 k (a :: k). Eq (Empty a)
forall k (a :: k). Empty a -> Empty a -> Bool
forall k (a :: k). Empty a -> Empty a -> Ordering
forall k (a :: k). Empty a -> Empty a -> Empty a
$ccompare :: forall k (a :: k). Empty a -> Empty a -> Ordering
compare :: Empty a -> Empty a -> Ordering
$c< :: forall k (a :: k). Empty a -> Empty a -> Bool
< :: Empty a -> Empty a -> Bool
$c<= :: forall k (a :: k). Empty a -> Empty a -> Bool
<= :: Empty a -> Empty a -> Bool
$c> :: forall k (a :: k). Empty a -> Empty a -> Bool
> :: Empty a -> Empty a -> Bool
$c>= :: forall k (a :: k). Empty a -> Empty a -> Bool
>= :: Empty a -> Empty a -> Bool
$cmax :: forall k (a :: k). Empty a -> Empty a -> Empty a
max :: Empty a -> Empty a -> Empty a
$cmin :: forall k (a :: k). Empty a -> Empty a -> Empty a
min :: Empty a -> Empty a -> Empty a
Ord,Typeable (Empty a)
Typeable (Empty a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Empty a -> c (Empty a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Empty a))
-> (Empty a -> Constr)
-> (Empty a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Empty a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Empty a)))
-> ((forall b. Data b => b -> b) -> Empty a -> Empty a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Empty a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Empty a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Empty a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Empty a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Empty a -> m (Empty a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Empty a -> m (Empty a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Empty a -> m (Empty a))
-> Data (Empty a)
Empty a -> Constr
Empty a -> DataType
(forall b. Data b => b -> b) -> Empty a -> Empty a
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Empty a -> u
forall u. (forall d. Data d => d -> u) -> Empty a -> [u]
forall k (a :: k). (Typeable a, Typeable k) => Typeable (Empty a)
forall k (a :: k). (Typeable a, Typeable k) => Empty a -> Constr
forall k (a :: k). (Typeable a, Typeable k) => Empty a -> DataType
forall k (a :: k).
(Typeable a, Typeable k) =>
(forall b. Data b => b -> b) -> Empty a -> Empty a
forall k (a :: k) u.
(Typeable a, Typeable k) =>
Int -> (forall d. Data d => d -> u) -> Empty a -> u
forall k (a :: k) u.
(Typeable a, Typeable k) =>
(forall d. Data d => d -> u) -> Empty a -> [u]
forall k (a :: k) r r'.
(Typeable a, Typeable k) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Empty a -> r
forall k (a :: k) r r'.
(Typeable a, Typeable k) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Empty a -> r
forall k (a :: k) (m :: * -> *).
(Typeable a, Typeable k, Monad m) =>
(forall d. Data d => d -> m d) -> Empty a -> m (Empty a)
forall k (a :: k) (m :: * -> *).
(Typeable a, Typeable k, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Empty a -> m (Empty a)
forall k (a :: k) (c :: * -> *).
(Typeable a, Typeable k) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Empty a)
forall k (a :: k) (c :: * -> *).
(Typeable a, Typeable k) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Empty a -> c (Empty a)
forall k (a :: k) (t :: * -> *) (c :: * -> *).
(Typeable a, Typeable k, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Empty a))
forall k (a :: k) (t :: * -> * -> *) (c :: * -> *).
(Typeable a, Typeable k, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Empty a))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Empty a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Empty a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Empty a -> m (Empty a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Empty a -> m (Empty a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Empty a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Empty a -> c (Empty a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Empty a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Empty a))
$cgfoldl :: forall k (a :: k) (c :: * -> *).
(Typeable a, Typeable k) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Empty a -> c (Empty a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Empty a -> c (Empty a)
$cgunfold :: forall k (a :: k) (c :: * -> *).
(Typeable a, Typeable k) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Empty a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Empty a)
$ctoConstr :: forall k (a :: k). (Typeable a, Typeable k) => Empty a -> Constr
toConstr :: Empty a -> Constr
$cdataTypeOf :: forall k (a :: k). (Typeable a, Typeable k) => Empty a -> DataType
dataTypeOf :: Empty a -> DataType
$cdataCast1 :: forall k (a :: k) (t :: * -> *) (c :: * -> *).
(Typeable a, Typeable k, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Empty a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Empty a))
$cdataCast2 :: forall k (a :: k) (t :: * -> * -> *) (c :: * -> *).
(Typeable a, Typeable k, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Empty a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Empty a))
$cgmapT :: forall k (a :: k).
(Typeable a, Typeable k) =>
(forall b. Data b => b -> b) -> Empty a -> Empty a
gmapT :: (forall b. Data b => b -> b) -> Empty a -> Empty a
$cgmapQl :: forall k (a :: k) r r'.
(Typeable a, Typeable k) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Empty a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Empty a -> r
$cgmapQr :: forall k (a :: k) r r'.
(Typeable a, Typeable k) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Empty a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Empty a -> r
$cgmapQ :: forall k (a :: k) u.
(Typeable a, Typeable k) =>
(forall d. Data d => d -> u) -> Empty a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Empty a -> [u]
$cgmapQi :: forall k (a :: k) u.
(Typeable a, Typeable k) =>
Int -> (forall d. Data d => d -> u) -> Empty a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Empty a -> u
$cgmapM :: forall k (a :: k) (m :: * -> *).
(Typeable a, Typeable k, Monad m) =>
(forall d. Data d => d -> m d) -> Empty a -> m (Empty a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Empty a -> m (Empty a)
$cgmapMp :: forall k (a :: k) (m :: * -> *).
(Typeable a, Typeable k, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Empty a -> m (Empty a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Empty a -> m (Empty a)
$cgmapMo :: forall k (a :: k) (m :: * -> *).
(Typeable a, Typeable k, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Empty a -> m (Empty a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Empty a -> m (Empty a)
Data,(forall a b. (a -> b) -> Empty a -> Empty b)
-> (forall a b. a -> Empty b -> Empty a) -> Functor Empty
forall a b. a -> Empty b -> Empty a
forall a b. (a -> b) -> Empty a -> Empty b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Empty a -> Empty b
fmap :: forall a b. (a -> b) -> Empty a -> Empty b
$c<$ :: forall a b. a -> Empty b -> Empty a
<$ :: forall a b. a -> Empty b -> Empty a
Functor,(forall m. Monoid m => Empty m -> m)
-> (forall m a. Monoid m => (a -> m) -> Empty a -> m)
-> (forall m a. Monoid m => (a -> m) -> Empty a -> m)
-> (forall a b. (a -> b -> b) -> b -> Empty a -> b)
-> (forall a b. (a -> b -> b) -> b -> Empty a -> b)
-> (forall b a. (b -> a -> b) -> b -> Empty a -> b)
-> (forall b a. (b -> a -> b) -> b -> Empty a -> b)
-> (forall a. (a -> a -> a) -> Empty a -> a)
-> (forall a. (a -> a -> a) -> Empty a -> a)
-> (forall a. Empty a -> [a])
-> (forall a. Empty a -> Bool)
-> (forall a. Empty a -> Int)
-> (forall a. Eq a => a -> Empty a -> Bool)
-> (forall a. Ord a => Empty a -> a)
-> (forall a. Ord a => Empty a -> a)
-> (forall a. Num a => Empty a -> a)
-> (forall a. Num a => Empty a -> a)
-> Foldable Empty
forall a. Eq a => a -> Empty a -> Bool
forall a. Num a => Empty a -> a
forall a. Ord a => Empty a -> a
forall m. Monoid m => Empty m -> m
forall a. Empty a -> Bool
forall a. Empty a -> Int
forall a. Empty a -> [a]
forall a. (a -> a -> a) -> Empty a -> a
forall m a. Monoid m => (a -> m) -> Empty a -> m
forall b a. (b -> a -> b) -> b -> Empty a -> b
forall a b. (a -> b -> b) -> b -> Empty 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
$cfold :: forall m. Monoid m => Empty m -> m
fold :: forall m. Monoid m => Empty m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Empty a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Empty a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Empty a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Empty a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Empty a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Empty a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Empty a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Empty a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Empty a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Empty a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Empty a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Empty a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Empty a -> a
foldr1 :: forall a. (a -> a -> a) -> Empty a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Empty a -> a
foldl1 :: forall a. (a -> a -> a) -> Empty a -> a
$ctoList :: forall a. Empty a -> [a]
toList :: forall a. Empty a -> [a]
$cnull :: forall a. Empty a -> Bool
null :: forall a. Empty a -> Bool
$clength :: forall a. Empty a -> Int
length :: forall a. Empty a -> Int
$celem :: forall a. Eq a => a -> Empty a -> Bool
elem :: forall a. Eq a => a -> Empty a -> Bool
$cmaximum :: forall a. Ord a => Empty a -> a
maximum :: forall a. Ord a => Empty a -> a
$cminimum :: forall a. Ord a => Empty a -> a
minimum :: forall a. Ord a => Empty a -> a
$csum :: forall a. Num a => Empty a -> a
sum :: forall a. Num a => Empty a -> a
$cproduct :: forall a. Num a => Empty a -> a
product :: forall a. Num a => Empty a -> a
F.Foldable,Functor Empty
Foldable Empty
(Functor Empty, Foldable Empty) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Empty a -> f (Empty b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Empty (f a) -> f (Empty a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Empty a -> m (Empty b))
-> (forall (m :: * -> *) a. Monad m => Empty (m a) -> m (Empty a))
-> Traversable Empty
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 => Empty (m a) -> m (Empty a)
forall (f :: * -> *) a. Applicative f => Empty (f a) -> f (Empty a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Empty a -> m (Empty b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Empty a -> f (Empty b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Empty a -> f (Empty b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Empty a -> f (Empty b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Empty (f a) -> f (Empty a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Empty (f a) -> f (Empty a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Empty a -> m (Empty b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Empty a -> m (Empty b)
$csequence :: forall (m :: * -> *) a. Monad m => Empty (m a) -> m (Empty a)
sequence :: forall (m :: * -> *) a. Monad m => Empty (m a) -> m (Empty a)
T.Traversable)

instance NFData (Empty a) where
  rnf :: Empty a -> ()
rnf Empty a
Empty = ()

type instance Dim Empty = 'Z

instance Vector Empty a where
  construct :: Fun (Dim Empty) a (Empty a)
construct = Fn 'Z a (Empty a) -> Fun 'Z a (Empty a)
forall (n :: PeanoNum) a b. Fn n a b -> Fun n a b
Fun Fn 'Z a (Empty a)
Empty a
forall {k} (a :: k). Empty a
Empty
  inspect :: forall b. Empty a -> Fun (Dim Empty) a b -> b
inspect Empty a
_ (Fun Fn (Dim Empty) a b
b) = b
Fn (Dim Empty) a b
b
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

type Tuple2 a = (a,a)
type Tuple3 a = (a,a,a)
type Tuple4 a = (a,a,a,a)
type Tuple5 a = (a,a,a,a,a)


----------------------------------------------------------------
-- Deriving
----------------------------------------------------------------

-- | Newtype for deriving instance for data types which has instance
--   of 'Vector'. It supports 'Eq', 'Ord', 'Semigroup', 'Monoid',
--   'Storable', 'NFData', 'Functor', 'Applicative', 'Foldable'.
newtype ViaFixed v a = ViaFixed (v a)

type instance Dim (ViaFixed v) = Dim v

instance Vector v a => Vector (ViaFixed v) a where
  construct :: Fun (Dim (ViaFixed v)) a (ViaFixed v a)
construct = v a -> ViaFixed v a
forall {k} (v :: k -> *) (a :: k). v a -> ViaFixed v a
ViaFixed (v a -> ViaFixed v a)
-> Fun (Dim v) a (v a) -> Fun (Dim v) a (ViaFixed v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fun (Dim v) a (v a)
forall (v :: * -> *) a. Vector v a => Fun (Dim v) a (v a)
construct
  inspect :: forall b. ViaFixed v a -> Fun (Dim (ViaFixed v)) a b -> b
inspect (ViaFixed v a
v) = v a -> Fun (Dim v) a b -> b
forall b. v a -> Fun (Dim v) a b -> b
forall (v :: * -> *) a b. Vector v a => v a -> Fun (Dim v) a b -> b
inspect v a
v
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance (Vector v a, Show a) => Show (ViaFixed v a) where
  showsPrec :: Int -> ViaFixed v a -> ShowS
showsPrec = (Int -> v a -> ShowS) -> Int -> ViaFixed v a -> ShowS
forall a b. Coercible a b => a -> b
coerce (forall (v :: * -> *) a. (Vector v a, Show a) => Int -> v a -> ShowS
I.showsPrec @v @a)

instance (Vector v a, Eq a) => Eq (ViaFixed v a) where
  == :: ViaFixed v a -> ViaFixed v a -> Bool
(==) = (v a -> v a -> Bool) -> ViaFixed v a -> ViaFixed v a -> Bool
forall a b. Coercible a b => a -> b
coerce (forall (v :: * -> *) a. (Vector v a, Eq a) => v a -> v a -> Bool
eq @v @a)
  {-# INLINE (==) #-}

instance (Vector v a, Ord a) => Ord (ViaFixed v a) where
  compare :: ViaFixed v a -> ViaFixed v a -> Ordering
compare = (v a -> v a -> Ordering)
-> ViaFixed v a -> ViaFixed v a -> Ordering
forall a b. Coercible a b => a -> b
coerce (forall (v :: * -> *) a.
(Vector v a, Ord a) =>
v a -> v a -> Ordering
ord @v @a)
  {-# INLINE compare #-}

instance (Vector v a, NFData a) => NFData (ViaFixed v a) where
  rnf :: ViaFixed v a -> ()
rnf = (v a -> ()) -> ViaFixed v a -> ()
forall a b. Coercible a b => a -> b
coerce (forall a (v :: * -> *). (NFData a, Vector v a) => v a -> ()
defaultRnf @a @v)
  {-# INLINE rnf #-}

instance (Vector v a, Semigroup a) => Semigroup (ViaFixed v a) where
  <> :: ViaFixed v a -> ViaFixed v a -> ViaFixed v a
(<>) = (v a -> v a -> v a) -> ViaFixed v a -> ViaFixed v a -> ViaFixed v a
forall a b. Coercible a b => a -> b
coerce (forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
zipWith @v @a a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>))
  {-# INLINE (<>) #-}

instance (Vector v a, Monoid a) => Monoid (ViaFixed v a) where
  mempty :: ViaFixed v a
mempty = v a -> ViaFixed v a
forall a b. Coercible a b => a -> b
coerce (forall (v :: * -> *) a. Vector v a => a -> v a
replicate @v @a a
forall a. Monoid a => a
mempty)
  {-# INLINE mempty #-}

instance (Vector v a, Storable a) => Storable (ViaFixed v a) where
  alignment :: ViaFixed v a -> Int
alignment = (v a -> Int) -> ViaFixed v a -> Int
forall a b. Coercible a b => a -> b
coerce (forall a (v :: * -> *). Storable a => v a -> Int
defaultAlignemnt @a @v)
  sizeOf :: ViaFixed v a -> Int
sizeOf    = (v a -> Int) -> ViaFixed v a -> Int
forall a b. Coercible a b => a -> b
coerce (forall a (v :: * -> *). (Storable a, Vector v a) => v a -> Int
defaultSizeOf    @a @v)
  peek :: Ptr (ViaFixed v a) -> IO (ViaFixed v a)
peek      = (Ptr (v a) -> IO (v a)) -> Ptr (ViaFixed v a) -> IO (ViaFixed v a)
forall a b. Coercible a b => a -> b
coerce (forall a (v :: * -> *).
(Storable a, Vector v a) =>
Ptr (v a) -> IO (v a)
defaultPeek      @a @v)
  poke :: Ptr (ViaFixed v a) -> ViaFixed v a -> IO ()
poke      = (Ptr (v a) -> v a -> IO ())
-> Ptr (ViaFixed v a) -> ViaFixed v a -> IO ()
forall a b. Coercible a b => a -> b
coerce (forall a (v :: * -> *).
(Storable a, Vector v a) =>
Ptr (v a) -> v a -> IO ()
defaultPoke      @a @v)
  {-# INLINE alignment #-}
  {-# INLINE sizeOf    #-}
  {-# INLINE peek      #-}
  {-# INLINE poke      #-}

instance (forall a. Vector v a) => Functor (ViaFixed v) where
  fmap :: forall a b. (a -> b) -> ViaFixed v a -> ViaFixed v b
fmap = (a -> b) -> ViaFixed v a -> ViaFixed v b
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
map
  {-# INLINE fmap #-}

instance (forall a. Vector v a) => Applicative (ViaFixed v) where
  pure :: forall a. a -> ViaFixed v a
pure   = a -> ViaFixed v a
forall (v :: * -> *) a. Vector v a => a -> v a
replicate
  <*> :: forall a b. ViaFixed v (a -> b) -> ViaFixed v a -> ViaFixed v b
(<*>)  = ((a -> b) -> a -> b)
-> ViaFixed v (a -> b) -> ViaFixed v a -> ViaFixed v b
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
zipWith (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($)
  liftA2 :: forall a b c.
(a -> b -> c) -> ViaFixed v a -> ViaFixed v b -> ViaFixed v c
liftA2 = (a -> b -> c) -> ViaFixed v a -> ViaFixed v b -> ViaFixed v c
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
zipWith
  ViaFixed v a
a <* :: forall a b. ViaFixed v a -> ViaFixed v b -> ViaFixed v a
<* ViaFixed v b
_ = ViaFixed v a
a
  ViaFixed v a
_ *> :: forall a b. ViaFixed v a -> ViaFixed v b -> ViaFixed v b
*> ViaFixed v b
b = ViaFixed v b
b
  {-# INLINE pure   #-}
  {-# INLINE (<*>)  #-}
  {-# INLINE (<*)   #-}
  {-# INLINE (*>)   #-}
  {-# INLINE liftA2 #-}

instance (forall a. Vector v a) => F.Foldable (ViaFixed v) where
  foldMap' :: forall m a. Monoid m => (a -> m) -> ViaFixed v a -> m
foldMap' a -> m
f = (m -> a -> m) -> m -> ViaFixed v a -> m
forall (v :: * -> *) a b.
Vector v a =>
(b -> a -> b) -> b -> v a -> b
foldl' (\ m
acc a
a -> m
acc m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
a) m
forall a. Monoid a => a
mempty
  foldr :: forall a b. (a -> b -> b) -> b -> ViaFixed v a -> b
foldr      = (a -> b -> b) -> b -> ViaFixed v a -> b
forall (v :: * -> *) a b.
Vector v a =>
(a -> b -> b) -> b -> v a -> b
foldr
  foldl :: forall b a. (b -> a -> b) -> b -> ViaFixed v a -> b
foldl      = (b -> a -> b) -> b -> ViaFixed v a -> b
forall (v :: * -> *) a b.
Vector v a =>
(b -> a -> b) -> b -> v a -> b
foldl
  foldl' :: forall b a. (b -> a -> b) -> b -> ViaFixed v a -> b
foldl'     = (b -> a -> b) -> b -> ViaFixed v a -> b
forall (v :: * -> *) a b.
Vector v a =>
(b -> a -> b) -> b -> v a -> b
foldl'
  toList :: forall a. ViaFixed v a -> [a]
toList     = ViaFixed v a -> [a]
forall (v :: * -> *) a. Vector v a => v a -> [a]
toList
  sum :: forall a. Num a => ViaFixed v a -> a
sum        = ViaFixed v a -> a
forall (v :: * -> *) a. (Vector v a, Num a) => v a -> a
sum
  product :: forall a. Num a => ViaFixed v a -> a
product    = (a -> a -> a) -> a -> ViaFixed v a -> a
forall (v :: * -> *) a b.
Vector v a =>
(b -> a -> b) -> b -> v a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(*) a
0
  {-# INLINE foldMap' #-}
  {-# INLINE foldr    #-}
  {-# INLINE foldl    #-}
  {-# INLINE foldl'   #-}
  {-# INLINE toList   #-}
  {-# INLINE sum      #-}
  {-# INLINE product  #-}
-- GHC<9.2 fails to compile this
#if MIN_VERSION_base(4,16,0)
  length :: forall a. ViaFixed v a -> Int
length = ViaFixed v a -> Int
forall (v :: * -> *) a. ArityPeano (Dim v) => v a -> Int
length
  {-# INLINE length #-}
#endif


----------------------------------------------------------------
-- Patterns
----------------------------------------------------------------

pattern V1 :: (Vector v a, Dim v ~ C.N1) => a -> v a
pattern $mV1 :: forall {r} {v :: * -> *} {a}.
(Vector v a, Dim v ~ N1) =>
v a -> (a -> r) -> ((# #) -> r) -> r
$bV1 :: forall (v :: * -> *) a. (Vector v a, Dim v ~ N1) => a -> v a
V1 x <- (convert -> (Only x)) where
  V1 a
x = a -> v a
forall (v :: * -> *) a. (Vector v a, Dim v ~ N1) => a -> v a
mk1 a
x
#if MIN_VERSION_base(4,16,0)
{-# INLINE   V1 #-}
{-# COMPLETE V1 #-}
#endif

pattern V2 :: (Vector v a, Dim v ~ C.N2) => a -> a -> v a
pattern $mV2 :: forall {r} {v :: * -> *} {a}.
(Vector v a, Dim v ~ N2) =>
v a -> (a -> a -> r) -> ((# #) -> r) -> r
$bV2 :: forall (v :: * -> *) a. (Vector v a, Dim v ~ N2) => a -> a -> v a
V2 x y <- (convert -> (x,y)) where
  V2 a
x a
y = a -> a -> v a
forall (v :: * -> *) a. (Vector v a, Dim v ~ N2) => a -> a -> v a
mk2 a
x a
y
#if MIN_VERSION_base(4,16,0)
{-# INLINE   V2 #-}
{-# COMPLETE V2 #-}
#endif

pattern V3 :: (Vector v a, Dim v ~ C.N3) => a -> a -> a -> v a
pattern $mV3 :: forall {r} {v :: * -> *} {a}.
(Vector v a, Dim v ~ N3) =>
v a -> (a -> a -> a -> r) -> ((# #) -> r) -> r
$bV3 :: forall (v :: * -> *) a.
(Vector v a, Dim v ~ N3) =>
a -> a -> a -> v a
V3 x y z <- (convert -> (x,y,z)) where
  V3 a
x a
y a
z = a -> a -> a -> v a
forall (v :: * -> *) a.
(Vector v a, Dim v ~ N3) =>
a -> a -> a -> v a
mk3 a
x a
y a
z
#if MIN_VERSION_base(4,16,0)
{-# INLINE   V3 #-}
{-# COMPLETE V3 #-}
#endif

pattern V4 :: (Vector v a, Dim v ~ C.N4) => a -> a -> a -> a -> v a
pattern $mV4 :: forall {r} {v :: * -> *} {a}.
(Vector v a, Dim v ~ N4) =>
v a -> (a -> a -> a -> a -> r) -> ((# #) -> r) -> r
$bV4 :: forall (v :: * -> *) a.
(Vector v a, Dim v ~ N4) =>
a -> a -> a -> a -> v a
V4 t x y z <- (convert -> (t,x,y,z)) where
  V4 a
t a
x a
y a
z = a -> a -> a -> a -> v a
forall (v :: * -> *) a.
(Vector v a, Dim v ~ N4) =>
a -> a -> a -> a -> v a
mk4 a
t a
x a
y a
z
#if MIN_VERSION_base(4,16,0)
{-# INLINE   V4 #-}
{-# COMPLETE V4 #-}
#endif

-- $setup
--
-- >>> import Data.Char
-- >>> import Prelude (Int,Bool(..))