Copyright | (c) Laurent P. René de Cotret |
---|---|
License | MIT |
Maintainer | laurent.decotret@outlook.com |
Stability | experimental |
Portability | portable |
Safe Haskell | None |
Language | GHC2021 |
Data.Frame
Description
This is an experimental interface to dataframes.
This module defines the type machinery and some functions to process data frames. Data frames are structures where every row corresponds to an object, but data is stored in contiguous arrays known as columns.
A user guide is provided in the Data.Frame.Tutorial module.
Synopsis
- type family Column (f :: Type -> Type) x where ...
- class Frameable (t :: (Type -> Type) -> Type)
- type Row (dt :: (Type -> Type) -> Type) = dt Identity
- type Frame (dt :: (Type -> Type) -> Type) = dt Vector
- fromRows :: (Frameable t, Foldable f) => f (Row t) -> Frame t
- toRows :: Frameable t => Frame t -> Vector (Row t)
- fields :: Frameable t => Row t -> [(String, String)]
- null :: Frameable t => Frame t -> Bool
- length :: Frameable t => Frame t -> Int
- mapRows :: (Frameable t1, Frameable t2) => (Row t1 -> Row t2) -> Frame t1 -> Frame t2
- mapRowsM :: (Frameable t1, Frameable t2, Monad m) => (Row t1 -> m (Row t2)) -> Frame t1 -> m (Frame t2)
- filterRows :: Frameable t => (Row t -> Bool) -> Frame t -> Frame t
- foldlRows :: Frameable t => (b -> Row t -> b) -> b -> Frame t -> b
- sortRowsBy :: Frameable t => (Row t -> Row t -> Ordering) -> Frame t -> Frame t
- sortRowsByUnique :: Frameable t => (Row t -> Row t -> Ordering) -> Frame t -> Frame t
- sortRowsByKey :: Indexable t => Frame t -> Frame t
- sortRowsByKeyUnique :: Indexable t => Frame t -> Frame t
- sortRowsByKeyUniqueOn :: (Ord k, Indexable t) => (Key t -> k) -> Frame t -> Frame t
- display :: Frameable t => Frame t -> String
- displayWith :: Frameable t => DisplayOptions t -> Frame t -> String
- data DisplayOptions (t :: (Type -> Type) -> Type) = DisplayOptions {
- maximumNumberOfRows :: Int
- rowDisplayFunction :: Row t -> [(String, String)]
- defaultDisplayOptions :: forall (t :: (Type -> Type) -> Type). Frameable t => DisplayOptions t
- ilookup :: Frameable t => Int -> Frame t -> Maybe (Row t)
- iat :: Frame t -> (Int, Frame t -> Vector a) -> Maybe a
- class (Frameable t, Eq (Key t), Ord (Key t)) => Indexable (t :: (Type -> Type) -> Type) where
- lookup :: Indexable t => Key t -> Frame t -> Maybe (Row t)
- at :: Indexable t => Frame t -> (Key t, Frame t -> Vector a) -> Maybe a
- zipRowsWith :: (Frameable t1, Frameable t2, Frameable t3) => (Row t1 -> Row t2 -> Row t3) -> Frame t1 -> Frame t2 -> Frame t3
- mergeWithStrategy :: (Indexable t1, Indexable t2, Frameable t3, Key t1 ~ Key t2) => MergeStrategy (Key t1) t1 t2 t3 -> Frame t1 -> Frame t2 -> Frame t3
- mergeWithStrategyOn :: (Ord k, Indexable t1, Indexable t2, Frameable t3) => (Key t1 -> k) -> (Key t2 -> k) -> MergeStrategy k t1 t2 t3 -> Frame t1 -> Frame t2 -> Frame t3
- matchedStrategy :: (k -> Row t1 -> Row t2 -> Row t3) -> MergeStrategy k t1 t2 t3
- data These a b
Defining dataframe types
type family Column (f :: Type -> Type) x where ... Source #
Type family which allows for higher-kinded record types in two forms:
- Single record type using
Identity
, where
;Column
Identity a ~ a - Record type whose elements are some other functor (usually
Vector
).
Types are created like regular record types, but each element
must have the type
instead of Column
f aa
. For example:
>>>
:{
data Student f = MkStudent { studentName :: Column f String , studentAge :: Column f Int , studentMathGrade :: Column f Char } deriving (Generic, Frameable) :}
class Frameable (t :: (Type -> Type) -> Type) Source #
Typeclass that endows any record type t
with the ability to be packaged
as a dataframe.
Under no circumstances should you write instances for Frameable
; instead,
simply derive an instance of Generic
for t
. For example:
>>>
:set -XDeriveAnyClass
>>>
:{
data Store f = MkStore { storeName :: Column f String , storeId :: Column f Int , storeAddress :: Column f String } deriving (Generic, Frameable) :}
type Row (dt :: (Type -> Type) -> Type) = dt Identity Source #
Type synonym for a record type with scalar elements
type Frame (dt :: (Type -> Type) -> Type) = dt Vector Source #
Type synonym for a record type whose elements are arrays (columns)
Construction and deconstruction
fromRows :: (Frameable t, Foldable f) => f (Row t) -> Frame t Source #
Build a dataframe from a container of rows.
For the inverse operation, see toRows
.
toRows :: Frameable t => Frame t -> Vector (Row t) Source #
Deconstruct a dataframe into its rows.
For the inverse operation, see fromRows
.
fields :: Frameable t => Row t -> [(String, String)] Source #
Return the field names associated with a row or frame.
This is useful to display frames via display
.
Operations on rows
length :: Frameable t => Frame t -> Int Source #
Access the length of a dataframe, i.e. the number of rows.
mapRows :: (Frameable t1, Frameable t2) => (Row t1 -> Row t2) -> Frame t1 -> Frame t2 Source #
Map a function over each row individually.
For mapping with a monadic action, see mapRowsM
.
mapRowsM :: (Frameable t1, Frameable t2, Monad m) => (Row t1 -> m (Row t2)) -> Frame t1 -> m (Frame t2) Source #
Map each element of a dataframe to a monadic action, evaluate these actions from left to right, and collect the result in a new dataframe.
For mapping without a monadic action, see mapRows
.
Arguments
:: Frameable t | |
=> (b -> Row t -> b) | Reduction function that takes in individual rows |
-> b | Initial value for the accumulator |
-> Frame t | Data frame |
-> b |
Left-associative fold of a structure, with strict application of the operator.
Sorting rows in frames
sortRowsBy :: Frameable t => (Row t -> Row t -> Ordering) -> Frame t -> Frame t Source #
Sort the rows of a frame using a custom comparison function.
Use the function on
from Data.Function to easily create
comparison functions. See the example below.
If you wish to prune rows with duplicates, see sortRowsByUnique
.
If your dataframe has an instance of Indexable
, see sortRowsByKey
.
For example, let's say we want to sort a dataframe of students by their first name:
>>>
:{
data Student f = MkStudent { studentName :: Column f String , studentAge :: Column f Int , studentMathGrade :: Column f Char } deriving (Generic, Frameable) students = fromRows [ MkStudent "Erika" 13 'D' , MkStudent "Beatrice" 13 'B' , MkStudent "David" 13 'A' , MkStudent "Albert" 12 'C' , MkStudent "Frank" 11 'C' , MkStudent "Clara" 12 'A' ] :}
>>>
import Data.Function (on)
>>>
putStrLn $ display $ sortRowsBy (compare `on` studentName) students
studentName | studentAge | studentMathGrade ----------- | ---------- | ---------------- "Albert" | 12 | 'C' "Beatrice" | 13 | 'B' "Clara" | 12 | 'A' "David" | 13 | 'A' "Erika" | 13 | 'D' "Frank" | 11 | 'C'
The underlying sorting algorithm is timsort (via
sortBy
), which minimizes the number
of comparisons used.
sortRowsByUnique :: Frameable t => (Row t -> Row t -> Ordering) -> Frame t -> Frame t Source #
Sort the rows of a frame using a custom comparison function.
Use the function on
from Data.Function to easily create
comparison functions. See the example below.
If your dataframe has an instance of Indexable
, see sortRowsByKey
.
For example, let's say we want to sort a dataframe of students by their first name:
>>>
:{
data Student f = MkStudent { studentName :: Column f String , studentAge :: Column f Int , studentMathGrade :: Column f Char } deriving (Generic, Frameable) students = fromRows [ MkStudent "Erika" 13 'D' , MkStudent "Beatrice" 13 'B' , MkStudent "David" 13 'A' , MkStudent "Albert" 12 'C' , MkStudent "Frank" 11 'C' , MkStudent "Clara" 12 'A' ] :}
>>>
import Data.Function (on)
>>>
putStrLn $ display $ sortRowsBy (compare `on` studentName) students
studentName | studentAge | studentMathGrade ----------- | ---------- | ---------------- "Albert" | 12 | 'C' "Beatrice" | 13 | 'B' "Clara" | 12 | 'A' "David" | 13 | 'A' "Erika" | 13 | 'D' "Frank" | 11 | 'C'
The underlying sorting algorithm is timsort (via
sortBy
), which minimizes the number
of comparisons used.
sortRowsByKey :: Indexable t => Frame t -> Frame t Source #
Sort the rows of a frame using the index defined by
the Indexable
typeclass.
If your dataframe does not have an instance of Indexable
,
see sortRowsBy
.
To prune rows with duplicate keys, see sortRowsByKeyUnique
.
For example:
>>>
:{
data Student f = MkStudent { studentName :: Column f String , studentAge :: Column f Int , studentMathGrade :: Column f Char } deriving (Generic, Frameable) instance Indexable Student where type Key Student = String index = studentName students = fromRows [ MkStudent "Erika" 13 'D' , MkStudent "Beatrice" 13 'B' , MkStudent "David" 13 'A' , MkStudent "Albert" 12 'C' , MkStudent "Frank" 11 'C' , MkStudent "Clara" 12 'A' ] :}
>>>
import Data.Function (on)
>>>
putStrLn $ display $ sortRowsByKey students
studentName | studentAge | studentMathGrade ----------- | ---------- | ---------------- "Albert" | 12 | 'C' "Beatrice" | 13 | 'B' "Clara" | 12 | 'A' "David" | 13 | 'A' "Erika" | 13 | 'D' "Frank" | 11 | 'C'
The underlying sorting algorithm is timsort (via
sortBy
), which minimizes the number
of comparisons used.
Displaying frames
display :: Frameable t => Frame t -> String Source #
Display a
using default Frame
tDisplayOptions
.
Although this is up to you, we strongly recommend that the Show
instance for
be:Frame
t
instance Show (Frame t) where show = display
Example:
>>>
:{
data Student f = MkStudent { studentName :: Column f String , studentAge :: Column f Int , studentMathGrade :: Column f Char } deriving (Generic, Frameable) :}
>>>
students = fromRows $ Vector.fromList [MkStudent "Albert" 12 'C', MkStudent "Beatrice" 13 'B', MkStudent "Clara" 12 'A']
>>>
putStrLn (display students)
studentName | studentAge | studentMathGrade ----------- | ---------- | ---------------- "Albert" | 12 | 'C' "Beatrice" | 13 | 'B' "Clara" | 12 | 'A'
Customizing the display of frames
displayWith :: Frameable t => DisplayOptions t -> Frame t -> String Source #
Display a
using custom Frame
tDisplayOptions
.
Example:
>>>
:{
data Student f = MkStudent { studentName :: Column f String , studentAge :: Column f Int , studentMathGrade :: Column f Char } deriving (Generic, Frameable) :}
>>>
:{
students = fromRows $ Vector.fromList [ MkStudent "Albert" 12 'C' , MkStudent "Beatrice" 13 'B' , MkStudent "Clara" 12 'A' , MkStudent "David" 13 'A' , MkStudent "Erika" 13 'D' , MkStudent "Frank" 11 'C' ] :}
>>>
putStrLn (displayWith (defaultDisplayOptions{maximumNumberOfRows=2}) students)
studentName | studentAge | studentMathGrade ----------- | ---------- | ---------------- "Albert" | 12 | 'C' ... | ... | ... "Frank" | 11 | 'C'
data DisplayOptions (t :: (Type -> Type) -> Type) Source #
Control how displayWith
behaves.
Constructors
DisplayOptions | |
Fields
|
defaultDisplayOptions :: forall (t :: (Type -> Type) -> Type). Frameable t => DisplayOptions t Source #
Default
display options.Frame
t
Indexing operations
Based on integer indices
ilookup :: Frameable t => Int -> Frame t -> Maybe (Row t) Source #
Access a row from a dataframe by its integer index. Indexing starts at 0, representing the first row.
If the index is larger than the number of rows, this function
returns Nothing
.
To access a specific row AND column, iat
is much more efficient.
To lookup a row based on a non-integer index, see lookup
.
Based on indexable frames
class (Frameable t, Eq (Key t), Ord (Key t)) => Indexable (t :: (Type -> Type) -> Type) where Source #
Typeclass for dataframes with an index, a column or set of columns that can be used to search through rows.
An index need not be unique, but the type of its keys must be an instance of Eq
.
lookup :: Indexable t => Key t -> Frame t -> Maybe (Row t) Source #
Look up a row in a data frame by key. The specific key
is defined by the Indexable
instance of type t
.
The first row whose index matches the supplied key is
returned. If no row has a matching key, returns Nothing
.
If you need to look up a particular row and column,
at
is much more efficient.
To lookup a row based on an integer index, see ilookup
.
Merging dataframes
Zipping rows in order
zipRowsWith :: (Frameable t1, Frameable t2, Frameable t3) => (Row t1 -> Row t2 -> Row t3) -> Frame t1 -> Frame t2 -> Frame t3 Source #
Zip two frames together using a combination function. Rows from each frame are matched in order; the resulting frame will only contain as many rows as the shortest of the two input frames
Merging using an index
mergeWithStrategy :: (Indexable t1, Indexable t2, Frameable t3, Key t1 ~ Key t2) => MergeStrategy (Key t1) t1 t2 t3 -> Frame t1 -> Frame t2 -> Frame t3 Source #
Merge two dataframes using a merging strategy, where the indexes
of the dataframes have the same type. See mergeWithStrategyOn
to merge dataframes with different indexes.
A merging strategy handles the possibility of rows missing in the
left and/or right dataframes. Merge strategies can be user-defined,
or you can use predefined strategies (e.g. matchedStrategy
).
Note that (
) means that the type of keys in
in both dataframes must be the same.Key
t1 ~ Key
t2
In the example below, we have two dataframes: one containing store names, and one containing addresses. Both dataframes have use a unique identification number to relate their data to specific stores.
We want to build a summary of information about stores, containing each store's name and address.
>>>
:{
data Store f = MkStore { storeId :: Column f Int , storeName :: Column f String } deriving (Generic, Frameable) instance Indexable Store where type Key Store = Int index = storeId :}
>>>
:{
data Address f = MkAddress { addressStoreId :: Column f Int , addressCivicNumber :: Column f Int , addressStreetName :: Column f String } deriving (Generic, Frameable) instance Show (Row Address) where show (MkAddress _ civicNum streetName) = mconcat [show civicNum, " ", streetName] instance Indexable Address where type Key Address = Int index = addressStoreId :}
>>>
:{
data StoreSummary f = MkStoreSummary { storeSummaryName :: Column f String , storeSummaryAddress :: Column f (Row Address) } deriving (Generic, Frameable) deriving instance Show (Row StoreSummary) :}
>>>
:{
stores = fromRows [ MkStore 1 "Maxi" , MkStore 2 "Metro" , MkStore 3 "Sobeys" , MkStore 4 "Loblaws" ] :}
>>>
:{
addresses = fromRows [ MkAddress 1 1982 "14th Avenue" , MkAddress 2 10 "Main Street" , MkAddress 3 914 "Prima Street" -- Missing address for store id 4 , MkAddress 5 1600 "Cosgrove Lane" ] :}
>>>
:{
putStrLn $ display $ mergeWithStrategy (matchedStrategy (\_ store address -> MkStoreSummary (storeName store) address)) stores addresses :} storeSummaryName | storeSummaryAddress ---------------- | ------------------- "Maxi" | 1982 14th Avenue "Metro" | 10 Main Street "Sobeys" | 914 Prima Street
Arguments
:: (Ord k, Indexable t1, Indexable t2, Frameable t3) | |
=> (Key t1 -> k) | How to map the index of the left dataframe onto a key of type |
-> (Key t2 -> k) | How to map the index of the right dataframe onto a key of type |
-> MergeStrategy k t1 t2 t3 | |
-> Frame t1 | |
-> Frame t2 | |
-> Frame t3 |
Merge two dataframes using a merging strategy, where the indexes
of the dataframes are mapped to some key of type k
.
See mergeWithStrategy
for further notes and examples.
matchedStrategy :: (k -> Row t1 -> Row t2 -> Row t3) -> MergeStrategy k t1 t2 t3 Source #
Merge strategy which only works if both the left and right rows are found.
If you are familiar with relational databases, matchedStrategy
is an inner join.
Helpers to define your own merge strategies
The These
type represents values with two non-exclusive possibilities.
This can be useful to represent combinations of two values, where the
combination is defined if either input is. Algebraically, the type
represents These
A B(A + B + AB)
, which doesn't factor easily into
sums and products--a type like
is unclear and
awkward to use.Either
A (B, Maybe
A)
These
has straightforward instances of Functor
, Monad
, &c., and
behaves like a hybrid error/writer monad, as would be expected.
For zipping and unzipping of structures with These
values, see
Data.Align.
Instances
Assoc These | Since: these-0.8 | ||||
Swap These | Since: these-0.8 | ||||
Defined in Data.These | |||||
Bifoldable These | |||||
Bifoldable1 These | Since: these-1.2 | ||||
Defined in Data.These | |||||
Bifunctor These | |||||
Bitraversable These | |||||
Defined in Data.These Methods bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> These a b -> f (These c d) # | |||||
Eq2 These | Since: these-1.1.1 | ||||
Ord2 These | Since: these-1.1.1 | ||||
Defined in Data.These | |||||
Read2 These | Since: these-1.1.1 | ||||
Defined in Data.These Methods liftReadsPrec2 :: (Int -> ReadS a) -> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (These a b) # liftReadList2 :: (Int -> ReadS a) -> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [These a b] # liftReadPrec2 :: ReadPrec a -> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (These a b) # liftReadListPrec2 :: ReadPrec a -> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec [These a b] # | |||||
Show2 These | Since: these-1.1.1 | ||||
NFData2 These | Since: these-1.1.1 | ||||
Defined in Data.These | |||||
Hashable2 These | Since: these-1.1.1 | ||||
Defined in Data.These | |||||
Generic1 (These a :: Type -> Type) | |||||
Defined in Data.These Associated Types
| |||||
Foldable (These a) | |||||
Defined in Data.These Methods fold :: Monoid m => These a m -> m # foldMap :: Monoid m => (a0 -> m) -> These a a0 -> m # foldMap' :: Monoid m => (a0 -> m) -> These a a0 -> m # foldr :: (a0 -> b -> b) -> b -> These a a0 -> b # foldr' :: (a0 -> b -> b) -> b -> These a a0 -> b # foldl :: (b -> a0 -> b) -> b -> These a a0 -> b # foldl' :: (b -> a0 -> b) -> b -> These a a0 -> b # foldr1 :: (a0 -> a0 -> a0) -> These a a0 -> a0 # foldl1 :: (a0 -> a0 -> a0) -> These a a0 -> a0 # toList :: These a a0 -> [a0] # elem :: Eq a0 => a0 -> These a a0 -> Bool # maximum :: Ord a0 => These a a0 -> a0 # minimum :: Ord a0 => These a a0 -> a0 # | |||||
Eq a => Eq1 (These a) | Since: these-1.1.1 | ||||
Ord a => Ord1 (These a) | Since: these-1.1.1 | ||||
Defined in Data.These | |||||
Read a => Read1 (These a) | Since: these-1.1.1 | ||||
Defined in Data.These Methods liftReadsPrec :: (Int -> ReadS a0) -> ReadS [a0] -> Int -> ReadS (These a a0) # liftReadList :: (Int -> ReadS a0) -> ReadS [a0] -> ReadS [These a a0] # liftReadPrec :: ReadPrec a0 -> ReadPrec [a0] -> ReadPrec (These a a0) # liftReadListPrec :: ReadPrec a0 -> ReadPrec [a0] -> ReadPrec [These a a0] # | |||||
Show a => Show1 (These a) | Since: these-1.1.1 | ||||
Traversable (These a) | |||||
Semigroup a => Applicative (These a) | |||||
Functor (These a) | |||||
Semigroup a => Monad (These a) | |||||
NFData a => NFData1 (These a) | Since: these-1.1.1 | ||||
Defined in Data.These | |||||
Hashable a => Hashable1 (These a) | Since: these-1.1.1 | ||||
Defined in Data.These | |||||
(Data a, Data b) => Data (These a b) | |||||
Defined in Data.These Methods gfoldl :: (forall d b0. Data d => c (d -> b0) -> d -> c b0) -> (forall g. g -> c g) -> These a b -> c (These a b) # gunfold :: (forall b0 r. Data b0 => c (b0 -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (These a b) # toConstr :: These a b -> Constr # dataTypeOf :: These a b -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (These a b)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (These a b)) # gmapT :: (forall b0. Data b0 => b0 -> b0) -> These a b -> These a b # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> These a b -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> These a b -> r # gmapQ :: (forall d. Data d => d -> u) -> These a b -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> These a b -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> These a b -> m (These a b) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> These a b -> m (These a b) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> These a b -> m (These a b) # | |||||
(Semigroup a, Semigroup b) => Semigroup (These a b) | |||||
Generic (These a b) | |||||
Defined in Data.These Associated Types
| |||||
(Read a, Read b) => Read (These a b) | |||||
(Show a, Show b) => Show (These a b) | |||||
(Binary a, Binary b) => Binary (These a b) | Since: these-0.7.1 | ||||
(NFData a, NFData b) => NFData (These a b) | Since: these-0.7.1 | ||||
Defined in Data.These | |||||
(Eq a, Eq b) => Eq (These a b) | |||||
(Ord a, Ord b) => Ord (These a b) | |||||
(Hashable a, Hashable b) => Hashable (These a b) | |||||
Defined in Data.These | |||||
type Rep1 (These a :: Type -> Type) | |||||
Defined in Data.These type Rep1 (These a :: Type -> Type) = D1 ('MetaData "These" "Data.These" "these-1.2.1-7GnonDuteui1oqOT8PvD14" 'False) (C1 ('MetaCons "This" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a)) :+: (C1 ('MetaCons "That" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) Par1) :+: C1 ('MetaCons "These" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) Par1))) | |||||
type Rep (These a b) | |||||
Defined in Data.These type Rep (These a b) = D1 ('MetaData "These" "Data.These" "these-1.2.1-7GnonDuteui1oqOT8PvD14" 'False) (C1 ('MetaCons "This" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a)) :+: (C1 ('MetaCons "That" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 b)) :+: C1 ('MetaCons "These" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 b)))) |