How would I go about deriving the function
getField :: (Generic a, HasDatatypeInfo a) => Proxy (name :: Symbol) -> a -> b
to project a field from an arbitrary record using a type-level string (Symbol), using the generics-sop library?
This is similar to Retrieving record function in generic SOP, but I have the following problems:
The OP does not explain how to go the last mile to get the signature I desire.
The OP defines complex special-purpose helper types, which I am keen to avoid
The given solution only errors out at runtime, but compile-time matching should be possible, since a type-level DataTypeInfo is provided through the DatatypeInfoOf type family (nice to have, but not necessary).
The lens-sop package also seems to do something similar, but I can't work out how to make it work for me.
I would also prefer a solution that uses the IsProductType typeclass.
I know this is a mess of an answer and not really what you were looking for, but it's the best I can do right now. Note that this works for both product types and sum types where all the constructors have the specified field name.
I think this could likely be simplified somewhat by separating the name lookup from the rest of the product handling. That is: use the datatype info to calculate the field number (as a unary natural), then use that number to dig through the code. Unfortunately, generics-sop doesn't seem to have really wonderful facilities for working with list zipping, so I ended up doing a lot "by hand".
{-# language EmptyCase, GADTs, TypeFamilies, DataKinds, TypeOperators, RankNTypes #-}
{-# language UndecidableInstances, UndecidableSuperClasses #-}
{-# language AllowAmbiguousTypes, TypeApplications, MultiParamTypeClasses,
FlexibleContexts, FlexibleInstances, MagicHash, UnboxedTuples, ScopedTypeVariables #-}
{-# language ConstraintKinds #-}
{-# OPTIONS_GHC -Wall #-}
module Data.Proj where
import Data.Kind (Type, Constraint)
import Generics.SOP
import Generics.SOP.Type.Metadata as GST
import GHC.TypeLits
import Data.Type.Equality (type (==))
-- This is what you were looking for, but slightly more flexible.
genericPrj :: forall s b a.
( Generic a
, HasFieldNS s b (GetConstructorInfos (DatatypeInfoOf a)) (Code a))
=> a -> b
genericPrj a = case genericPrj# #s a of (# b #) -> b
-- This version lets you force the *extraction* of a field without
-- forcing the field itself.
genericPrj# :: forall s b a.
( Generic a
, HasFieldNS s b (GetConstructorInfos (DatatypeInfoOf a)) (Code a))
=> a -> (# b #)
genericPrj# a = case from a of
SOP xs -> extraction #s #b #(GetConstructorInfos (DatatypeInfoOf a)) #(Code a) xs
-- | Extract info about the constructor(s) from 'GST.DatatypeInfo'.
type family GetConstructorInfos (inf :: GST.DatatypeInfo) :: [GST.ConstructorInfo] where
GetConstructorInfos ('GST.ADT _ _ infos _) = infos
GetConstructorInfos ('GST.Newtype _ _ info) = '[info]
class HasFieldNS (s :: Symbol) b (cis :: [GST.ConstructorInfo]) (code :: [[Type]]) where
extraction :: NS (NP I) code -> (# b #)
instance HasFieldNS s b cis '[] where
extraction x = case x of
instance (HasFieldNP' s b r c, HasFieldNS s b cis cs, rec ~ 'GST.Record q r, VerifyRecord rec)
=> HasFieldNS s b (rec ': cis) (c ': cs) where
extraction (Z x) = extractIt #s #b #rec #c x
extraction (S x) = extraction #s #b #cis #cs x
type family VerifyRecord rec :: Constraint where
VerifyRecord ('GST.Record _ _) = ()
VerifyRecord _ = TypeError ('Text "Constructor is not in record form.")
-- | Given info about a constructor, a list of its field types, and the name and
-- type of a field, produce an extraction function.
class HasFieldNP (s :: Symbol) b (ci :: GST.ConstructorInfo) (fields :: [Type]) where
extractIt :: NP I fields -> (# b #)
instance (HasFieldNP' s b fi fields, ci ~ 'GST.Record _cn fi)
=> HasFieldNP s b ci fields where
extractIt = extractIt' #s #_ #fi
class HasFieldNP' (s :: Symbol) b (fi :: [GST.FieldInfo]) (fields :: [Type]) where
extractIt' :: NP I fields -> (# b #)
class TypeError ('Text "Can't find field " ':<>: 'ShowType s)
=> MissingField (s :: Symbol) where
impossible :: a
instance MissingField s => HasFieldNP' s b fi '[] where
extractIt' = impossible #s ()
instance HasFieldNP'' s b (fi == s) field fis fields =>
HasFieldNP' s b ('GST.FieldInfo fi ': fis) (field ': fields) where
extractIt' = extractIt'' #s #b #(fi == s) #field #fis #fields
class HasFieldNP'' (s :: Symbol) b (match :: Bool) (field :: Type) (fis :: [GST.FieldInfo]) (fields :: [Type]) where
extractIt'' :: NP I (field ': fields) -> (# b #)
instance b ~ field => HasFieldNP'' _s b 'True field fis fields where
extractIt'' (I x :* _) = (# x #)
instance (HasFieldNP' s b fis fields) => HasFieldNP'' s b 'False _field fis fields where
extractIt'' (_ :* fields) = extractIt' #s #b #fis fields
Examples
data Foo
= Foo {blob :: Int, greg :: String}
| Bar {hello :: Char, blob :: Int}
deriveGeneric ''Foo
genericPrj #"blob" (Foo 12 "yo") ===> 12
genericPrj #"blob" (Bar 'x' 5) ===> 5
genericPrj# #"blob" (Bar 'x' 5) ===> (# 5 #)
myAbsurd :: Void -> a
myAbsurd = genericPrj #"whatever"
data Booby a
= Booby {foo :: a}
| Bobby {bar :: a}
deriveGeneric ''Booby
genericPrj #"foo" (Booby 'a')
-- Type error because Bobby has no foo field
As of version 0.1.1.0, records-sop provides this function:
getField :: forall s a b ra. (IsRecord a ra, IsElemOf s b ra) => a -> b
which needs the field name supplied as a type application rather than a proxy, like so:
data Foo = Foo { bar :: Int }
getField #"bar" (Foo 42) === 42
This provides compile-time extraction, although it will still need a bit of casting around to fit in with existing code in my project that manipulates standard generics-sop metadata.
This only works on single-constructor types. #dfeuer's answer also supports sum types.
Thank you #kosmikus, the coauthor of generics-sop and author of records-sop, for implementing this in response to this question!
Related
Are there examples of generics-sop that mimic SYB's everywhere/mkT behavior?
What I'm attempting to do, but not seeing how to do it successfully, is replace the everywhere (mkT fixupSymbol) in main with an equivalent Generics.SOP construction, i.e., use Generics.SOP to recurse into the product (I (AbsAddr value)) and replace it with (I (SymAddr label)).
I could pass the symbol table to gformatOperands, polluting the formatOperands signature. That seems suboptimal.
Without fixupSymbol, the output would look like:
LD B, 0x0000
LD C, 0x1234
CALL 0x4567
Resolving addresses to symbolic labels:
gensop % stack ghci
Using main module: 1. Package `gensop' component exe:gensop with main-is file: <...>/Main.hs
gensop-0.1: configure (exe)
Configuring gensop-0.1...
gensop-0.1: initial-build-steps (exe)
Configuring GHCi with the following packages: gensop
GHCi, version 8.6.3: http://www.haskell.org/ghc/ :? for help
[1 of 1] Compiling Main ( <...>/Main.hs, interpreted )
*Main> main
LD B, 0x0000
LD C, label1
CALL label2
*Main>
Cut down version of code:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Main where
import Data.Data
import Data.Foldable (foldl)
import Data.Word (Word8, Word16)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Text.Printf
import Generics.SOP
import Generics.SOP.TH (deriveGeneric)
import Data.Generics.Aliases (mkT)
import Data.Generics.Schemes (everywhere)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as H
import Data.Sequence (Seq, (|>))
import qualified Data.Sequence as Seq
type Z80addr = Word16
type Z80word = Word8
class Z80operand x where
formatOperand :: x -> Text
main :: IO()
main = mapM_ T.putStrLn (foldl printIns Seq.empty $ everywhere (mkT fixupSymbol) insnSeq)
-- -------------------------------------------------^ Does this have a Generics.SOP equivalent?
where
printIns accum ins = accum |> T.concat ([mnemonic, gFormatOperands] <*> [ins])
mnemonic (LD _) = "LD "
mnemonic (CALL _) = "CALL "
-- Generics.SOP: Fairly straightforward
gFormatOperands {-elt-} =
T.intercalate ", " . hcollapse . hcmap disOperandProxy (mapIK formatOperand) . from {-elt-}
where
disOperandProxy = Proxy :: Proxy Z80operand
-- Translate an absolute address, generally hidden inside an instruction operand, into a symbolic address
-- if present in the symbol table.
fixupSymbol addr#(AbsAddr absAddr) = maybe addr SymAddr (absAddr `H.lookup` symtab)
fixupSymbol other = other
insnSeq :: Seq Z80instruction
insnSeq = Seq.singleton (LD (Reg8Imm B 0x0))
|> (LD (Reg8Indirect C (AbsAddr 0x1234)))
|> (CALL (AbsAddr 0x4567))
symtab :: HashMap Z80addr Text
symtab = H.fromList [ (0x1234, "label1"), (0x4567, "label2")]
-- | Symbolic and absolute addresses. Absolute addresses can be translated into symbolic
-- labels.
data SymAbsAddr = AbsAddr Z80addr | SymAddr Text
deriving (Eq, Ord, Typeable, Data)
data Z80reg8 = A | B | C
deriving (Eq, Ord, Typeable, Data)
-- | Cut down version of the Z80 instruction set
data Z80instruction = LD OperLD | CALL SymAbsAddr
deriving (Eq, Ord, Typeable, Data)
-- | Load operands
data OperLD = Reg8Imm Z80reg8 Z80word | Reg8Indirect Z80reg8 SymAbsAddr
deriving (Eq, Ord, Typeable, Data)
$(deriveGeneric ''SymAbsAddr)
$(deriveGeneric ''Z80reg8)
$(deriveGeneric ''Z80instruction)
$(deriveGeneric ''OperLD)
instance Z80operand Z80word where
formatOperand word = T.pack $ printf "0x%04x" word
instance Z80operand SymAbsAddr where
formatOperand (AbsAddr addr) = T.pack $ printf "0x04x" addr
formatOperand (SymAddr label) = label
instance Z80operand Z80reg8 where
formatOperand A = "A"
formatOperand B = "B"
formatOperand C = "C"
instance Z80operand OperLD where
formatOperand (Reg8Imm reg imm) = T.concat [formatOperand reg, ", ", formatOperand imm]
formatOperand (Reg8Indirect reg addr) = T.concat [formatOperand reg, ", ", formatOperand addr]
The gensop.cabal file:
cabal-version: >= 1.12
name: gensop
version: 0.1
build-type: Simple
author: scooter-me-fecit
description: No description.
license: GPL-3
executable gensop
default-language: Haskell2010
main-is: Main.hs
build-depends:
base,
containers,
bytestring,
generics-sop,
syb,
text,
unordered-containers
default-extensions:
OverloadedStrings,
FlexibleInstances
ghc-options: -Wall
generics-sop provides no equivalents for recursive traversal schemes, such as these functions. If you need to deal with recursion in this library, the possible solution is to implement them. Although, defining such functions in SOP is related to some difficulties because it has a core generic view on data that doesn't distinguish recursive nodes from leaves. Recursion in this setting can be managed using closed type families (CTF) and some type class machinery. Closed type families allow you:
to implement the type-safe cast, which is needed for defining mkT,
to resolve the cases of recursive and non-recursive nodes—different
instances of a type class—which otherwise overlap. (Another option
is using pragmas for overlapping instances, a recent GHC feature;
there is, however, some bias about overlapping instances in the
Haskell community, so this solution is often considered as
undesired.)
Using CTF for treating recursion has been described in an unpublished paper “Handling Recursion in Generic Programming Using Closed Type Families”, which uses the generics-sop library as a case study; it provides examples of defining recursive schemes in SOP.
SYB's everywhere supports families of mutually recursive datatypes. The following implementation allows to specify them as type-level lists.
{-# LANGUAGE DeriveGeneric, TypeFamilies, DataKinds,
TypeApplications, ScopedTypeVariables, MultiParamTypeClasses,
ConstraintKinds, FlexibleContexts, AllowAmbiguousTypes,
FlexibleInstances, UndecidableInstances,
UndecidableSuperClasses, TypeOperators, RankNTypes #-}
import Generics.SOP
import Generics.SOP.NS
import GHC.Exts (Constraint)
import Data.Type.Equality
type family Equal a x :: Bool where
Equal a a = 'True
Equal _ _ = 'False
class DecideEq (eq :: Bool) (a :: *) (b :: *) where
decideEq :: Maybe (b :~: a)
instance a ~ b => DecideEq True a b where
decideEq = Just Refl
instance DecideEq False a b where
decideEq = Nothing
type ProofCast a b = DecideEq (Equal a b) a b
castEq :: forall a b. ProofCast a b => b -> Maybe a
castEq t = (\d -> castWith d t) <$> decideEq #(Equal a b)
type Transform a b = (Generic a, Generic b, ProofCast a b, ProofCast b a)
mkT :: Transform a b => (a -> a) -> b -> b
mkT f x = maybe x id $ castEq =<< f <$> castEq x
type family In (a :: *) (fam :: [*]) :: Bool where
In a ([a] ': fam) = 'True
In [a] (a ': fam) = 'True
In a (a ': fam) = 'True
In a (_ ': fam) = In a fam
In _ '[] = 'False
class CaseEverywhere' (inFam :: Bool) (c :: * -> Constraint)
(fam :: [*]) (x :: *) (y :: *) where
caseEverywhere' :: (forall b . c b => b -> b) -> I x -> I y
instance c x => CaseEverywhere' 'False c fam x x where
caseEverywhere' f = I . f . unI
instance (c x, Everywhere x c fam) => CaseEverywhere' 'True c fam x x where
caseEverywhere' f = I . f . everywhere #fam #c f . unI
class CaseEverywhere' (In x fam) c fam x y => CaseEverywhere c fam x y
instance CaseEverywhere' (In x fam) c fam x y => CaseEverywhere c fam x y
caseEverywhere :: forall c fam x y . CaseEverywhere c fam x y
=> (forall b . c b => b -> b) -> I x -> I y
caseEverywhere = caseEverywhere' #(In x fam) #c #fam
type Everywhere a c fam =
(Generic a, AllZip2 (CaseEverywhere c fam) (Code a) (Code a))
everywhere :: forall fam c a . Everywhere a c fam
=> (forall b . c b => b -> b) -> a -> a
everywhere f = to . everywhere_SOP . from
where
everywhere_SOP = trans_SOP (Proxy #(CaseEverywhere c fam)) $
caseEverywhere #c #fam f
Usage
First, this can be examined with a small-scale example taken from the SYB paper. The implemented SOP-based everywhere, as compared to SYB's one, additionally takes two type arguments, passed through the explicit type application. The first one specifies a family of mutually recursive datatypes as a type list. The traversal will treat as recursive only those nodes whose types are specified in that list. The second argument is needed to provide a compiler with a ‘proof’ object for type-cast. The T synonym for the Transform constraint serves to allow its partial application.
data Company = C [Dept]
data Dept = D Name Manager [SubUnit]
data SubUnit = PU Employee | DU Dept
data Employee = E Person Salary
data Person = P Name Address
data Salary = S Float
type Manager = Employee
type Name = String
type Address = String
class Transform a b => T a b
instance Transform a b => T a b
type CompanyF = '[Company, Dept, SubUnit, Employee]
increase :: Float -> Company -> Company
increase k = everywhere #CompanyF #(T Salary) (mkT (incS k))
incS :: Float -> Salary -> Salary
incS k (Sal s) = Sal (s * (1 + k))
The defined everywhere / mkT functions are ready for using in your code, but it misses some Generic instances. To apply everywhere to insnSeq, you need a Generic (Seq Z80instruction) instance. Yet you can't obtain it, because the Data.Sequence module doesn't export the internal representation of it. A possible fix is applying fmap to the sequence. So now you can write:
{-# LANGUAGE TypeApplications #-}
...
type Z80 = '[SymAbsAddr, Z80reg8, Z80instruction, OperLD]
main :: IO()
main = mapM_ T.putStrLn (foldl printIns Seq.empty $
fmap (everywhere #Z80 #(T SymAbsAddr) (mkT fixupSymbol)) insnSeq)
You should provide the Generic instances for all types of nodes that this traverses, recursive and non-recursive. So next, this demands the Generic instances for Word8, Word16, and Text. While the Generic Text instance can be generated via deriveGeneric, the others can't, because of their special GHC representation. So you'll have to do it manually; this definition is straightforward:
$(deriveGeneric ''Text)
instance Generic Word8 where
type Code Word8 = '[ '[Word8]]
from x = SOP (Z (I x :* Nil))
to (SOP ((Z (I x :* Nil)))) = x
instance Generic Word16 where
type Code Word16 = '[ '[Word16]]
from x = SOP (Z (I x :* Nil))
to (SOP ((Z (I x :* Nil)))) = x
This code is boilerplate, but the newest GHC extension DerivingVia could nicely simplify this, reducing the second definition. Hopefully, this useful feature will be improved with possibilities for standalone deriving, so it will be possible to say instead:
deriving via Word8 instance Generic Word16
The whole code now works well, and main yields the expected result.
I'm looking for a function, that, given the necessary return type, will return the part of a product parameter that matches that type, based purely on the structure of the type passed to the function.
For example:
data MyProduct = MyProduct String Int Bool
prod = MyProduct "yes" 0 False
func prod :: Boolean -- would return False
func prod :: String -- would return "yes"
func prod :: Double -- compiler error
And similarly, for the same function func, but a different product:
data AnotherProduct = AP (Maybe Int) Char
ap = AP Nothing 'C'
func ap :: Maybe Int -- would return Nothing
Does such a function exist? I feel this should be possible, perhaps using Generic. I know that this is possible in other languages, such as Scala with the Shapeless library, but I can't work out how best to approach this in Haskell.
As per #Li-yao_Xia's answer, it is possible to do this with GHC.Generics (which is what generic-lens uses behind the scenes). The code in generic-lens is probably a little hard to follow, so here's how you can do it from scratch.
The way GHC.Generics works, it represents a particular type, such as:
data MyProduct = MyProduct String Int Bool deriving (Generic)
by means of an isomorphic type Rep MyProduct that looks like this:
> :kind! Rep MyProduct
Rep MyProduct :: * -> *
= D1
('MetaData "MyProduct" "GenericFetch3" "main" 'False)
(C1
('MetaCons "MyProduct" 'PrefixI 'False)
(S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 String)
:*: (S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Int)
:*: S1
('MetaSel
'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
(Rec0 Bool))))
This is admittedly a little crazy, but most of this nested type consists of metadata wrappers represented by D1, C1, and S1 types. If you remove those wrappers, it boils down to:
Rep MyProduct = Rec0 String :*: Rec0 Int :*: Rec0 Bool
which helps show how the representation is structured.
Anyway, to write a generic function, you create a typeclass that can process a Rep a using instances to handle metadata wrappers and the small set of type constructors used to represent products, sums, etc.
In our case, we're going to define a typeclass Fetch' that lets us fetch the first value of type b out of a representation t (i.e., so t will be Rep MyProduct or something similar):
class Fetch' t b where
fetch' :: t p -> Maybe b
For now, we're not going to require that t actually contain a b, which is why we allow fetch' to return Nothing.
We'll need an instance to process metadata:
instance Fetch' t b => Fetch' (M1 i m t) b where
fetch' (M1 x) = fetch' x
Since all the metadata wrappers (D1, S1, and C1) are actually aliases (M1 D, M1 S, M1 C respectively), we can handle them all with an M1 instance that passes the fetch' through the wrapper.
We'll also need one to process products:
instance (Fetch' s b, Fetch' t b) => Fetch' (s :*: t) b where
fetch' (s :*: t) = fetch' s <|> fetch' t
This will just fetch the b out of the left-hand side of the product or -- failing that -- out of the right-hand side.
And we'll need an instance to fetch a b out of a (top-level) field of the matching type (which matches the Rec0 above, since that's just an alias for K1 R):
instance Fetch' (K1 i b) b where
fetch' (K1 x) = Just x
as well as an overlapped catch-all that will handle fields of the wrong type:
instance {-# OVERLAPPABLE #-} Fetch' (K1 i b) a where
fetch' (K1 _) = Nothing
We could also optionally handle the other possible type constructors in these representations (namely, V1, U1, and :+:) which I've done in the complete example below.
Anyway, with those instances in place, we could write:
fetch1 :: (Generic t, Fetch' (Rep t) b) => t -> b
fetch1 = fromJust . fetch' . from
and this works fine:
> fetch1 prod :: String
"yes"
> fetch1 prod :: Int
0
> fetch1 prod :: Bool
False
but as with #luqui's answer based on Data generics, it doesn't catch bad fields at compile time but rather crashes at runtime:
> fetch1 prod :: Double
*** Exception: Maybe.fromJust: Nothing
To fix this, we can introduce a type family that calculates whether a data structure (or rather it's Rep) actually contains the needed field, like so:
type family Has t b where
Has (s :*: t) b = Or (Has s b) (Has t b)
Has (K1 i b) b = 'True
Has (K1 i a) b = 'False
Has (M1 i m t) b = Has t b
with the usual definition for the type family Or. Now, we can add this as a constraint in the definition of fetch:
fetch :: ( Generic t
, Has (Rep t) b ~ 'True
, Fetch' (Rep t) b)
=> t -> b
fetch = fromJust . fetch' . from
and now we get a compile time error for bad fields:
> fetch prod :: String
"yes"
> fetch prod :: Double
<interactive>:83:1: error:
• Couldn't match type ‘'False’ with ‘'True’
arising from a use of ‘fetch’
• In the expression: fetch prod :: Double
In an equation for ‘it’: it = fetch prod :: Double
>
Anyway, putting the whole thing together, and adding instances and Has definitions for all the constructors, we get the following version. Note that for sum types (i.e., (:+:)), it only allows field types that can be found in all terms in the sum (and so are guaranteed to be present). Unlike the typed function in generic-lens, this version allows multiple fields of the target type in a product and just picks the first one.
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module GenericFetch where
import Control.Applicative
import Data.Maybe
import GHC.Generics
data MyProduct = MyProduct String Int Bool deriving (Generic)
prod :: MyProduct
prod = MyProduct "yes" 0 False
data AnotherProduct = AP (Maybe Int) Char deriving (Generic)
ap :: AnotherProduct
ap = AP Nothing 'C'
data ASum = A Int String | B Int Double deriving (Generic)
asum :: ASum
asum = A 10 "hello"
class Fetch' t b where
fetch' :: t p -> Maybe b
instance Fetch' V1 b where
fetch' _ = Nothing
instance Fetch' U1 b where
fetch' _ = Nothing
instance (Fetch' s b, Fetch' t b) => Fetch' (s :+: t) b where
fetch' (L1 s) = fetch' s
fetch' (R1 t) = fetch' t
instance (Fetch' s b, Fetch' t b) => Fetch' (s :*: t) b where
fetch' (s :*: t) = fetch' s <|> fetch' t
instance Fetch' (K1 i b) b where
fetch' (K1 x) = Just x
instance {-# OVERLAPPABLE #-} Fetch' (K1 i b) a where
fetch' (K1 _) = Nothing
instance Fetch' t b => Fetch' (M1 i m t) b where
fetch' (M1 x) = fetch' x
type family Has t b where
Has V1 b = 'False
Has U1 b = 'False
Has (s :+: t) b = And (Has s b) (Has t b)
Has (s :*: t) b = Or (Has s b) (Has t b)
Has (K1 i b) b = 'True
Has (K1 i a) b = 'False
Has (M1 i m t) b = Has t b
type family Or a b where
Or 'False 'False = 'False
Or a b = 'True
type family And a b where
And 'True 'True = 'True
And a b = 'False
fetch :: ( Generic t
, Has (Rep t) b ~ 'True
, Fetch' (Rep t) b)
=> t -> b
fetch = fromJust . fetch' . from
giving:
> :l GenericFetch
> fetch prod :: Int
0
> fetch prod :: Double
...type error...
> fetch ap :: Maybe Int
Nothing
> fetch ap :: Int
...type error...
> fetch asum :: Int
10
> fetch asum :: String
... type error: no string in `B` constructor...
>
Here's how to get a list of all compatible fields:
import Data.Data
import Data.Typeable
import Data.Maybe (maybeToList)
fields :: (Data a, Typeable b) => a -> [b]
fields = gmapQr (++) [] (maybeToList . cast)
The product types you use should derive Data. This can be done automatically with {-# LANGUAGE DeriveDataTypeable #-}
data MyProduct = MyProduct String Int Bool
deriving (Typeable, Data)
See the docs for gmapQr and cast.
The only caveat is that I can't think of a way to give a compile-time error when you request a field that is not present, as you requested. We would need some sort of compile-time version of Data.Data. I'm not aware of any such thing, though I suspect it is possible (it would probably be a bit more of a pain though––that deriving Data is doing a lot of the heavy lifting for us!).
One solution is in generic-lens. In particular, getTyped #T :: P -> T will access a field of type T in any product type P (that is an instance of Generic). Here's an example in GHCi (for more details, see the README):
> :set -XDeriveGeneric -XTypeApplications
> import Data.Generics.Product
> import GHC.Generics
> data MyProduct = MyProduct String Int Bool deriving Generic
> getTyped #Int (MyProduct "Hello" 33 True)
33
> getTyped #Int (0 :: Int, "hello")
0
This cannot be done with under the Haskell 98 standard. In general, a parametric function cannot change behavior based the concrete type that it becomes. It must remain generic.
As a thought process as to why this might be consider the case:
data MpProduct a = My Product Int Int String [a]
What should the func return asked for an Int? What about when a is Char?
Now, I'm not saying that some crack-shot of a programmer with a deep knowledge of GHC extensions could not make this happen, but it is not possible with the standard Hindley Milner typechecker.
I have two data types and the second one is the copy of first, but with Maybe on each field.
data A = {a :: Int, b :: String}
data B = {c :: Maybe Int, d :: Maybe String}
Is there a way to make a functions
f :: A -> B
g :: B -> A -> A
without any knowledge about fields itself? (if value of first argument is nothing g will take default value from second argument)
This can be done with generics-sop, a library that extends the default Generics machinery of GHC.
"generics-sop" can take a regular record and deduce a generic representation for it. This representation has a type parameter that wraps every field, and the library allows Applicative sequence-like operations across the record fields.
{-# language TypeOperators #-}
{-# language DeriveGeneric #-}
{-# language TypeFamilies #-}
{-# language DataKinds #-}
import qualified GHC.Generics as GHC
import Generics.SOP
data A = A {a :: Int, b :: String} deriving (Show,GHC.Generic)
instance Generic A -- this Generic is from generics-sop
defaulty :: (Generic a, Code a ~ '[ xs ]) => NP Maybe xs -> a -> a
defaulty maybes r = case (from r) of
SOP (Z np) -> let result = hliftA2 (\m i -> maybe i I m) maybes np
in to (SOP (Z result))
main :: IO ()
main = do
print $ defaulty (Nothing :* Just "bar" :* Nil) (A 99 "foo")
Nothing :* Just "bar" :* Nil is a generic representation that matches the list of fields in the original record definition. Notice that each field in the representation is wrapped in Maybe.
See here for another example of generics-sop.
How about:
{-# LANGUAGE RankNTypes #-}
data R f = R { a :: f Int, b :: f String, c :: f Char }
newtype I a = I { unI :: a }
fromMaybeI :: I a -> Maybe a -> I a
fromMaybeI a Nothing = a
fromMaybeI _ (Just a) = I a
fromMaybeR :: R I -> R Maybe -> R I
fromMaybeR ri rm =
R (go a) (go b) (go c)
where
go :: (forall f. R f -> f a) -> I a
go x = fromMaybeI (x ri) (x rm)
R Maybe is the record with Maybe values, R I is the record with concrete values.
Using RankNTypes reduces the amount of boilerplate code in fromMaybeR.
One downside is that you have use I and unI to construct and
access the field values.
I have a list of heterogeneous types (or at least that's what I have in mind):
data Nul
data Bits b otherBits where
BitsLst :: b -> otherBits -> Bits b otherBits
NoMoreBits :: Bits b Nul
Now, given an input type b, I want to go through all the slabs of Bits with type b and summarize them, ignoring other slabs with type b' /= b:
class Monoid r => EncodeBit b r | b -> r where
encodeBit :: b -> r
class AbstractFoldable aMulti r where
manyFold :: r -> aMulti -> r
instance (EncodeBit b r, AbstractFoldable otherBits r) =>
AbstractFoldable (Bits b otherBits ) r where
manyFold r0 (BitsLst bi other) = manyFold (r0 `mappend` (encodeBit bi)) other
manyFold b0 NoMoreBits = b0
instance AbstractFoldable otherBits r =>
AbstractFoldable (Bits nb otherBits ) r where
manyFold r0 (BitsLst _ other) = manyFold r0 other
manyFold b0 NoMoreBits = b0
But the compiler wants none of it. And with good reason, since both instance declarations have the same head. Question: what is the correct way of folding over Bits with an arbitrary type?
Note: the above example is compiled with
{-# LANGUAGE MultiParamTypeClasses,
FunctionalDependencies,
GADTs,
DataKinds,
FlexibleInstances,
FlexibleContexts
#-}
Answering your comment:
Actually, I can do if I can filter the heterogeneous list by type. Is that possible?
You can filter the heterogeneous list by type if you add a Typeable constraint to b.
The main idea is we will use Data.Typeable's cast :: (Typeable a, Typeable b) => a -> Maybe b to determine if each item in the list is of a certain type. This will require a Typeable constraint for each item in the list. Instead of building a new list type with this constraint built in, we will make the ability to check if All types in a list meet some constraint.
Our goal is to make the following program output [True,False], filtering a heterogeneous list to only its Bool elements. I will endevour to place the language extensions and imports with the first snippet they are needed for
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
example :: HList (Bool ': String ': Bool ': String ': '[])
example = HCons True $ HCons "Jack" $ HCons False $ HCons "Jill" $ HNil
main = do
print (ofType example :: [Bool])
HList here is a fairly standard definition of a heterogeneous list in haskell using DataKinds
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
data HList (l :: [*]) where
HCons :: h -> HList t -> HList (h ': t)
HNil :: HList '[]
We want to write ofType with a signature like "if All things in a heterogeneous list are Typeable, get a list of those things of a specific Typeable type.
import Data.Typeable
ofType :: (All Typeable l, Typeable a) => HList l -> [a]
To do this, we need to develop the notion of All things in a list of types satisfying some constraint. We will store the dictionaries for satisfied constraints in a GADT that either captures both the head constraint dictionary and constraints for All of the the tail or proves that the list is empty. A type list satisfies a constraint for All it's items if we can capture the dictionaries for it.
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ConstraintKinds #-}
-- requires the constraints† package.
-- Constraint is actually in GHC.Prim
-- it's just easier to get to this way
import Data.Constraint (Constraint)
class All (c :: * -> Constraint) (l :: [*]) where
allDict :: p1 c -> p2 l -> DList c l
data DList (ctx :: * -> Constraint) (l :: [*]) where
DCons :: (ctx h, All ctx t) => DList ctx (h ': t)
DNil :: DList ctx '[]
DList really is a list of dictionaries. DCons captures the dictionary for the constraint applied to the head item (ctx h) and all the dictionaries for the remainder of the list (All ctx t). We can't get the dictionaries for the tail directly from the constructor, but we can write a function that extracts them from the dictionary for All ctx t.
{-# LANGUAGE ScopedTypeVariables #-}
import Data.Proxy
dtail :: forall ctx h t. DList ctx (h ': t) -> DList ctx t
dtail DCons = allDict (Proxy :: Proxy ctx) (Proxy :: Proxy t)
An empty list of types trivially satisfies any constraint applied to all of its items
instance All c '[] where
allDict _ _ = DNil
If the head of a list satisfies a constraint and all of the tail does too, then everything in the list satisfies the constraint.
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
instance (c h, All c t) => All c (h ': t) where
allDict _ _ = DCons
We can now write ofType, which requires foralls for scoping type variables with ScopedTypeVariables.
import Data.Maybe
ofType :: forall a l. (All Typeable l, Typeable a) => HList l -> [a]
ofType l = ofType' (allDict (Proxy :: Proxy Typeable) l) l
where
ofType' :: forall l. (All Typeable l) => DList Typeable l -> HList l -> [a]
ofType' d#DCons (HCons x t) = maybeToList (cast x) ++ ofType' (dtail d) t
ofType' DNil HNil = []
We are zipping the HList together with its dictionaries with maybeToList . cast and concatenating the results. We can make that explicit with RankNTypes.
{-# LANGUAGE RankNTypes #-}
import Data.Monoid (Monoid, (<>), mempty)
zipDHWith :: forall c w l p. (All c l, Monoid w) => (forall a. (c a) => a -> w) -> p c -> HList l -> w
zipDHWith f p l = zipDHWith' (allDict p l) l
where
zipDHWith' :: forall l. (All c l) => DList c l -> HList l -> w
zipDHWith' d#DCons (HCons x t) = f x <> zipDHWith' (dtail d) t
zipDHWith' DNil HNil = mempty
ofType :: (All Typeable l, Typeable a) => HList l -> [a]
ofType = zipDHWith (maybeToList . cast) (Proxy :: Proxy Typeable)
†constraints
Record or simple ADT in haskell are pretty much equivalent to boxed tuples.
Is there a way (ideally some fancy extensions or a lib from the haksell platform) which allow conversion between such type and tuples ?
I'm (fairly ) new to haskell and I'm trying to build some reporting tool in Haskell. This involves reading/writing csv files and database tables. Things are pretty much straight forward using tuples, but involve a bit of boiler plate when using plain class.
The boilerplate seams nearly identical in both way, but I didn't find a nice way to do it only once, except maybe from doing a conversion (data <-> tuple) and use the native conversion from tuple to CSV/table.
Update
All the answer I got back so far, assumes that I need something totally generic and I want tuple.
I don't want tuple, I have tuple and I don't want them, therefore the need to convert them.
In fact I just want to reduce the boiler plate (to 0 :-)) but I don't need necessarily the function(s) to have the same name for every types.
For example I can easily convert a tuple to anything by uncurrying one of its constructors.
The problem is I need uncurryN which I can't find anywhere (except in a template haskell tutorial).
The reverse is harder to do.
I'm not asking for a solution (althout all the answers I got are greats because I'm not familiar whith the different way of meta-programming in Haskell) but more, as I don't like to reinvent the wheel, if the wheel existed already (for example this uncurryN, could have been written by hand till 20 and packed in nice package)
Updated2
Apparently a uncurry package exists, but it stills solves half the problem.
You might want to look at GHC.Generics. It basically encodes each ADT as products ((,)) and sums (Either). As an example, here is how you could show this representation using generics:
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
import GHC.Generics
class Tuple p where
showRepresentation :: p -> String
default showRepresentation :: (Generic p, GTuple (Rep p)) => p -> String
showRepresentation = gshowRepresentation . from
class GTuple p where
gshowRepresentation :: p x -> String
instance Tuple k => GTuple (K1 i k) where
gshowRepresentation (K1 t) = showRepresentation t
instance GTuple f => GTuple (M1 i c f) where
gshowRepresentation (M1 f) = gshowRepresentation f
instance (GTuple f, GTuple g) => GTuple (f :*: g) where
gshowRepresentation (f :*: g) = gshowRepresentation f ++ " * " ++ gshowRepresentation g
-- Some instances for the "primitive" types
instance Tuple Int where showRepresentation = show
instance Tuple Bool where showRepresentation = show
instance Tuple () where showRepresentation = show
--------------------------------------------------------------------------------
data Example = Example Int () Bool deriving Generic
instance Tuple Example
main :: IO ()
main = putStrLn $ showRepresentation $ Example 3 () False
-- prints: 3 * () * False
You can find more documentation in the GHC.Generics module. I also found the paper about it, A Generic Deriving Mechanism for Haskell to be quite readable (it was one of the few papers I read).
The lens library, in modules Control.Lens.Iso and Control.Lens.Wrapped, has a few utilities that make working with such conversions easier. Unfortunately, at the moment the Template Haskell machinery for such cases does not handle records, only newtypes, so you'll have to define the instances yourself. For example:
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
import Control.Lens
data Foo = Foo { baz :: Int, bar :: Int } deriving Show
instance Wrapped Foo where
type Unwrapped Foo = (Int,Int)
_Wrapped' = iso (\(Foo baz' bar') -> (baz',bar')) (\(baz',bar') -> Foo baz' bar')
Now we can wrap and unwrap easily:
*Main> (2,3) ^. _Unwrapped' :: Foo
Foo {baz = 2, bar = 3}
*Main> Foo 2 3 ^. _Wrapped'
(2,3)
We can also modify a Foo using a function that works on the tuple:
*Main> over _Wrapped' (\(x,y)->(succ x,succ y)) $ Foo 2 5
Foo {baz = 3, bar = 6}
And the reverse:
*Main> under _Wrapped' (\(Foo x y)->(Foo (succ x) (succ y))) $ (2,5)
(3,6)
If you want real n-tuples (and not just some other data that is semantically equivalent) it's going to be cumbersome without Template Haskell.
For example, if you want to convert
data Foo = Foo Int String Int
data Bar = Bar String String Int Int
into
type FooTuple = (Int, String, Int)
type BarTuple = (String, String, Int, Int)
both GHC.Generics and SYB will be problematic because the result type needs to be different depending on the fields of the datatype. Even though both are calle "tuples", (Int, String, Int) and (String, String, Int, Int) are completely separate types and there are no convenient ways to work with n-arity tuples in a generic fashion. Here's one way to achieve the above using GHC.Generics:
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveGeneric #-}
-- Generic instance to turn generic g x into some n-tuple whose exact
-- type depends on g.
class GTuple g where
type NTuple g
gtoTuple :: g x -> NTuple g
-- Unwarp generic metadata
instance GTuple f => GTuple (M1 i c f) where
type NTuple (M1 i c f) = NTuple f
gtoTuple = gtoTuple . unM1
-- Turn individual fields into a Single type which we need to build up
-- the final tuples.
newtype Single x = Single x
instance GTuple (K1 i k) where
type NTuple (K1 i k) = Single k
gtoTuple (K1 x) = Single x
-- To combine multiple fields, we need a new Combine type-class.
-- It can take singular elements or tuples and combine them into
-- a larger tuple.
--
class Combine a b where
type Combination a b
combine :: a -> b -> Combination a b
-- It's not very convenient because it needs a lot of instances for different
-- combinations of things we can combine.
instance Combine (Single a) (Single b) where
type Combination (Single a) (Single b) = (a, b)
combine (Single a) (Single b) = (a, b)
instance Combine (Single a) (b, c) where
type Combination (Single a) (b, c) = (a, b, c)
combine (Single a) (b, c) = (a, b, c)
instance Combine (a,b) (c,d) where
type Combination (a,b) (c,d) = (a,b,c,d)
combine (a,b) (c,d) = (a,b,c,d)
-- Now we can write the generic instance for constructors with multiple
-- fields.
instance (Combine (NTuple a) (NTuple b), GTuple a, GTuple b) => GTuple (a :*: b) where
type NTuple (a :*: b) = Combination (NTuple a) (NTuple b)
gtoTuple (a :*: b) = combine (gtoTuple a) (gtoTuple b)
-- And finally the main function that triggers the tuple conversion.
toTuple :: (Generic a, GTuple (Rep a)) => a -> NTuple (Rep a)
toTuple = gtoTuple . from
-- Now we can test that our instances work like they should:
data Foo = Foo Int String Int deriving (Generic)
data Bar = Bar String String Int Int deriving (Generic)
fooTuple = toTuple $ Foo 1 "foo" 2
barTuple = toTuple $ Bar "bar" "asdf" 3 4
The above works but it requires a lot of work (and I couldn't quickly figure out
if it could be done without using UndecidableInstances).
Now what you really want to do is probably just skip the tuples and use generics
to convert directly to CSV. I'm assuming you are using csv-conduit and want to generate instances of the ToRecord type-class.
Here's an example of that
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics
import Data.ByteString (ByteString)
import Data.CSV.Conduit.Conversion
class GRecord g where
gToRecord :: g x -> [ByteString]
instance GRecord f => GRecord (M1 i c f) where
gToRecord = gToRecord . unM1
instance ToField k => GRecord (K1 i k) where
gToRecord (K1 x) = [toField x]
instance (GRecord a, GRecord b) => GRecord (a :*: b) where
gToRecord (a :*: b) = gToRecord a ++ gToRecord b
genericToRecord :: (Generic a, GRecord (Rep a)) => a -> Record
genericToRecord = record . gToRecord . from
And now you can easily make instances for your custom types.
data Foo = Foo Int String Int deriving (Generic)
data Bar = Bar String String Int Int deriving (Generic)
instance ToRecord Foo where
toRecord = genericToRecord
instance ToRecord Bar where
toRecord = genericToRecord
In response to your updated question: you might be interested in the tuple package (and especially Curry) which contains implementations for uncurryN and curryN for tuples up to 15 elements.
In some cases, you can use unsafeCoerce. The name of the function should be quite a clear warning to be very careful. Particularly, the behavior is dependent on the compiler and even compiler version.
data Bar = Bar Text Text
tupleToBar :: (Text, Text) -> Bar
tupleToBar = unsafeCoerce
The function _Ctor in generic-lens converts any record value to a tuple and vice versa with no template haskell.