I have the following GADT:
{-# LANGUAGE GADTs #-}
data LogProtocol a where
Message :: String -> LogProtocol String
StartRun :: forall rc. (Show rc, Eq rc, Titled rc, ToJSON rc, FromJSON rc)
=> rc -> LogProtocol rc
... and many more...
toJSON is straight forward and not shown.
fromJSON implementation is based on:
This SO Question and
This Blog Post - pattern 2
and is as follows:
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
-- tag type is used in to/ from JSON to reduce the use of magic strings
data LPTag = MessageT |
StartRunT |
... and many more...
deriving (Show, Eq, Enum)
tagList :: Enum a => [a]
tagList = enumFrom $ toEnum 0
$(deriveJSON defaultOptions ''LPTag)
-- a wrapper to hide the a type param in the GADT
data Some (t :: k -> *) where
Some :: t x -> Some t
instance FromJSON (Some LogProtocol) where
parseJSON :: Value -> Parser (Some LogProtocol)
parseJSON v#(Object o) =
let
tag :: Maybe LPTag
tag = do
t <- (HML.lookup "type" o)
parseMaybe parseJSON t
failMessage :: [Char]
failMessage = toS $ "Could not parse LogProtocol no type field or type field value is not a member of specified in: "
<> (show(tagList :: [LPTag]))
<> show v
in
maybe
(fail failMessage )
(
\case
MessageT -> Some <$> (Message <$> o .: "txt")
StartRunT -> Some <$> (StartRun <$> o .: "runConfig")
)
tag
parseJSON wrng = typeMismatch "LogProtocol" wrng
The case for '''Message''' is fine. The problem I am having are errors such as:
* No instance for (Titled x2) arising from a use of `StartRun'
* In the first argument of `(<$>)', namely `StartRun'
In the second argument of `(<$>)', namely
`(StartRun <$> o .: "runConfig")'
In the expression: Some <$> (StartRun <$> o .: "runConfig")
Anywhere I have my own type class constraints (such as Titled)
in the data constructor the compiler says "No".
Is there a way to resolve this?
Existential types are an antipattern, especially if you need to do deserialization. StartRun should contain a concrete type instead. Deserialization requires a concrete type anyway, hence you might as well specialize StartRun to it.
Related
I was just working through Chris Done's ADT with default example gist available here and ran into a problem: my ADT, with fields defined by higher kinded type families, is not working with a deriving show instance. GHC is telling me I need to derive a Show instance for a Type Family, but I'm not sure how to do. Here's what I have, so far, any comments would be helpful.
In the following example (using ghc 8.8.1), the objective is to define an instance of Show for ShowMe, using derive if possible.
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE ConstraintKinds #-}
data Tag = A | B deriving (Show)
type family TF (p :: Tag) a where
TF 'A a = ()
TF 'B a = a
data ShowMe p = ShowMe
{ a :: !(TF p String)
, b :: String
}
main = connect showMeDefaults { a = "some string" }
where
connect :: ShowMe B -> IO ()
connect _ = pure ()
showMeDefaults :: ShowMe A
showMeDefaults = ShowMe { a = (), b = "asdf" }
-- This works to define Show
{-
instance Show (ShowMe p) where
show _ = "hello"
-}
-- This instance is the line that causes an error
deriving instance Show (ShowMe p)
Subsequently, I'm getting an error that I'm not familiar with from GHC:
show_tf.hs:35:1: error:
• No instance for (Show (TF p String))
arising from a use of ‘showsPrec’
• In the first argument of ‘(.)’, namely ‘(showsPrec 0 b1)’
In the second argument of ‘(.)’, namely
‘((.)
(showsPrec 0 b1)
((.)
GHC.Show.showCommaSpace
((.)
(showString "b = ") ((.) (showsPrec 0 b2) (showString "}")))))’
In the second argument of ‘(.)’, namely
‘((.)
(showString "a = ")
((.)
(showsPrec 0 b1)
((.)
GHC.Show.showCommaSpace
((.)
(showString "b = ") ((.) (showsPrec 0 b2) (showString "}"))))))’
When typechecking the code for ‘showsPrec’
in a derived instance for ‘Show (ShowMe p)’:
To see the code I am typechecking, use -ddump-deriv
|
35 | deriving instance Show (ShowMe p)
If we recompile, using the ghc -ddump-deriv, the following is returned:
[1 of 1] Compiling Main ( show_tf.hs, show_tf.o )
==================== Derived instances ====================
Derived class instances:
instance GHC.Show.Show Main.Tag where
GHC.Show.showsPrec _ Main.A = GHC.Show.showString "A"
GHC.Show.showsPrec _ Main.B = GHC.Show.showString "B"
Derived type family instances:
==================== Filling in method body ====================
GHC.Show.Show [Main.Tag]
GHC.Show.show = GHC.Show.$dmshow #(Main.Tag)
==================== Filling in method body ====================
GHC.Show.Show [Main.Tag]
GHC.Show.showList = GHC.Show.$dmshowList #(Main.Tag)
Linking show_tf ...
Conceptually, I think what I should be able to derive a Show instance for TF, but when I do that, I get the following:
show_tf.hs:36:31: error:
• Illegal type synonym family application ‘TF 'A a’ in instance:
Show (TF 'A a)
• In the stand-alone deriving instance for
‘(Show a) => Show (TF 'A a)’
|
36 | deriving instance (Show a) => Show (TF 'A a)
This error also appears if I just try to define the Show instance myself for TF 'A a. I've searched "Illegal type synonym", and haven't come up up with a way around this.
You need to add
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
and then suggest the wanted context to GHC:
deriving instance Show (TF p String) => Show (ShowMe p)
GHC won't add that context automatically since it can be surprising to the programmer.
I am trying to figure out how to do generic deriving modeled after deriveJSON. I defined a simple type using record style data constructor as below:
data T = C1 { aInt::Int, aString::String} deriving (Show,Generic)
What I will like to do is to define a generic derivable function that takes the data constructors above, and outputs a builder using the record names and the functions - just a toy code - we want to make ABuilder generic so we can use it for any data type with record syntax (like deriveJSON in Aeson):
{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics
data T = C1 { aInt::Int, aString::String} deriving (Show,Generic)
-- Some kind of builder output - String here is a stand-in for the
-- builder
class ABuilder a where
f :: a -> String
-- Need to get the record field name, and record field function
-- for each argument, and build string - for anything that is not
-- a string, we need to add show function - we assume "Show" instance
-- exists
instance ABuilder T where
f x = ("aInt:" ++ (show . aInt $ x)) ++ "," ++ ("aString:" ++ (aString $ x))
What I can't figure out is how to get the record name, and the function. Here is my attempt in ghci 7.10.3. I could get the data type name, but can't figure out how to get record names and functions out of it.
$ ghci Test.hs
GHCi, version 7.10.3: http://www.haskell.org/ghc/ :? for help
[1 of 1] Compiling Main ( Test.hs, interpreted )
Ok, modules loaded: Main.
*Main> datatypeName . from $ (C1 {aInt=1,aString="a"})
"T"
*Main> :t from (C1 {aInt=1,aString="a"})
from (C1 {aInt=1,aString="a"})
:: D1
Main.D1T
(C1
Main.C1_0T
(S1 Main.S1_0_0T (Rec0 Int) :*: S1 Main.S1_0_1T (Rec0 String)))
x
*Main>
I will appreciate pointers on how to get the record name and the function in Generics. If TemplateHaskell is better approach for defining Generic instance of ABuilder, I will appreciate hearing why. I am hoping to stick to Generics for solving this at compile-time if the solution is simple. I have noticed that Aeson uses TemplateHaskell for deriveJSON part. That is why my question about TemplateHaskell above to see if there is something I am missing here (I am using ghc 7.10.3 and don't need backward compatibility with older versions).
Here's something I just whipped up that should get this if you hand it the innards of a specific constructor:
{-# LANGUAGE DeriveGeneric, TypeOperators, FlexibleContexts, FlexibleInstances #-}
import GHC.Generics
data T = C1 { aInt::Int, aString::String} deriving (Show,Generic)
class AllSelNames x where
allSelNames :: x -> [String]
instance (AllSelNames (a p), AllSelNames (b p)) => AllSelNames ((a :*: b) p) where
allSelNames (x :*: y) = allSelNames x ++ allSelNames y
instance Selector s => AllSelNames (M1 S s f a) where
allSelNames x = [selName x]
From the repl we see
*Main> let x = unM1 . unM1 $ from (C1 {aInt=1,aString="a"})
*Main> allSelNames x
["aInt","aString"]
I'm writing FFI to pdflib. Pdflib C API has lots of functions that return and/or take various handles (document, page, image, font) as plain Integer (not pointer).
In order to ensure i do not accidentally pass the wrong param to a function i create a bunch of newtypes in the form of:
newtype PdiDoc = PdiDoc Int
newtype PdiPage = PdiPage Int
newtype PdfImage = PdfImage Int
newtype PdfFont = PdfFont Int
Now i need to provide a marshaller for those types.
image2c (PdfImage i) = fromIntegral i
font2c (PdfFont f) = fromIntegral f
pdipage2c (PdiPage i) = fromIntegral i
As you see the marshallers are exactly the same, just for different types.
So my question is, is there some kind of type magic, SYB vodoo trick that i can use to have just one function to marshall all those types, or do i have to write same functions again and again for different newtypes ?
EDIT: I accepted Don's answer, because it solved my problem.
I switched on
GeneralizedNewtypeDeriving
added
deriving (Eq, Ord, Num, Enum, Real, Integral)
to each of my newtypes, and now i can use standard fromIntegral to marshall all of them.
Nathan Howell's answer is also correct one, i upvoted it. But unfortunately his solution would mean giving up on FFI preprocessors like c2hs i am using.
GHC's FFI extensions allow using newtypes that wrap FFI primitives. You could change the imported function signatures to use the newtypes and (hopefully) avoid having to unwrap them manually.
{-# LANGUAGE ForeignFunctionInterface #-}
module Main where
newtype Foo = Foo Int
foreign import ccall someCall :: Foo -> IO Foo
main :: IO ()
main = do
Foo x <- someCall (Foo 1)
print x
Alternatively, the new GHC Generics functionality (available since 7.2.1) allows generic unpacking and repacking of newtypes:
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TypeFamilies #-}
module Main where
import GHC.Generics
-- use a regular newtype
newtype Foo1 = Foo1 Int deriving (Generic, Show)
-- or with record syntax
newtype Foo2 = Foo2{foo2 :: Int} deriving (Generic, Show)
unpack :: (Generic a, Rep a ~ D1 dc (C1 cc (S1 sc (K1 R kc)))) => a -> kc
unpack = unK1 . unM1 . unM1 . unM1 . from
pack :: (Generic a, Rep a ~ D1 dc (C1 cc (S1 sc (K1 R kc)))) => kc -> a
pack = to . M1 . M1 . M1 . K1
-- the C import uses Ints
foreign import ccall "someCall" c'someCall :: Int -> IO Int
-- and the typed wrapper packs/unpacks to FFI primitives
someCall :: Foo1 -> IO Foo2
someCall = fmap pack . c'someCall . unpack
main :: IO ()
main = do
Foo2 x <- someCall (Foo1 1)
print x
You can derive 'Num' for your types using GeneralizedNewtypeDeriving, this helps you a bit with literals and operators.
For the marshalling, I'd use a FFI preprocess, such as hsc2hs, which can automate the wrapping and unwrapping of newtypes.
An example from RWH:
I'd like a variant of show (let's call it label) that acts just like show, except that it doesn't wrap Strings in " " or Chars in ' '. Examples:
> label 5
"5"
> label "hello"
"hello"
> label 'c'
"c"
I tried implementing this manually, but I ran into some walls. Here is what I tried:
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
module Label where
class (Show a) => Label a where
label :: a -> String
instance Label [Char] where
label str = str
instance Label Char where
label c = [c]
-- Default case
instance Show a => Label a where
label x = show x
However, because the default case's class overlaps instance Label [Char] and instance Label Char, those types don't work with the label function.
Is there a library function that provides this functionality? If not, is there a workaround to get the above code to work?
The code above isn't going to work because instances are chosen only based on the "head", that is, the part after the class name. The "context", the stuff before the => such as `Show a' is only examined afterwards. The context can eliminate an instance and produce a compiler error, but not cause the compiler to pick a different instance. Because of this behavior, overlapping instances are a potential ambiguity.
There are compiler extensions that can let you write more complicated instances, but I suspect you're probably best off just writing individual instances of your Label class. What purpose do you have in mind for this? Depending on what you're trying to accomplish, there might be something more special-purpose already out there.
Your example code is pretty simple, though--if you want, simply adding the OverlappingInstances extension should make it work with no further modifications. Using OverlappingInstances causes GHC to tolerate some ambiguity, so long as there's an obvious "most specific" instance. In your code, the two instances with concrete types are as specific as it gets, so there shouldn't be any problems.
Might as well add TypeSynonymInstances while you're at it, for better readability:
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Label where
class (Show a) => Label a where
label :: a -> String
instance Label String where label x = x
instance Label Char where label x = [x]
instance (Show a) => Label a where label = show
There's an OverlappingInstances language extension which will make this work.
Is there a library function that provides this functionality?
Yes. There's a fairly new library that provides helpful functions, such as toS, which can be used similarly to show. (see docs)
It can be installed with cabal under the string-conv package like so: cabal install string-conv
Reference:
Hackage
Not really what you want, since it adds an extra constraint to the type (Typeable)
but this is how you could do it generically:
Data.Generics> (show `extQ` (id :: String -> String) `extQ` ((:[]) :: Char -> String)) 1
"1"
Data.Generics> (show `extQ` (id :: String -> String) `extQ` ((:[]) :: Char -> String)) "hello"
"hello"
Data.Generics> (show `extQ` (id :: String -> String) `extQ` ((:[]) :: Char -> String)) 'c'
"c"
Data.Generics> (show `extQ` (id :: String -> String) `extQ` ((:[]) :: Char -> String)) ['f','l']
"fl"
Data.Generics> :t (show `extQ` (id :: String -> String) `extQ` ((:[]) :: Char -> String))
(show `extQ` (id :: String -> String) `extQ` ((:[]) :: Char -> String))
:: (Show a, Typeable a) => a -> String
Is there a way to "lift" a class instance in Haskell easily?
I've been frequently needing to create, e.g., Num instances for some classes that are just "lifting" the Num structure through the type constructor like this:
data SomeType a = SomeCons a
instance (Num a)=>Num SomeCons a where
(SomeCons x) + (SomeCons y) = SomeCons (x+y)
negate (SomeCons x) = SomeCons (negate x)
-- similarly for other functions.
Is there a way to avoid this boilerplate and "lift" this Num structure automatically? I usually have to do this with Show and other classes also when I was trying to learn existencials and the compiler wouldn't let me use deriving(Show).
The generalized newtype deriving extension is what you want here:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Main where
newtype SomeType a = SomeCons a deriving (Num, Show, Eq)
main = do
let a = SomeCons 2
b = SomeCons 3
print $ a + b
Output:
*Main> main
SomeCons 5
GHC implements what you want : Extensions to the deriving mecanism.
These modifications are often shown for future standard language extension (As seen on haskell' wiki)
To Enable this extension, you must use the following pragma
{-# GeneralizedNewtypeDeriving #-}
and then use a deriving on your newtype declaration, as usual
data SomeType a = SomeCons a deriving (Num)
GeneralizedNewtypeDeriving