Is it possible to define constrained types in Haskell, i.e. I would like to be able to express,
Prelude> let legalCharacters = ' ':['A'..'Z']
Prelude> legalCharacters
" ABCDEFGHIJKLMNOPQRSTUVWXYZ"
as a type, if possible.
Can be done in modern GHC (>= 7.10, perhaps already 7.8).
{-# LANGUAGE KindSignatures, DataKinds, MonoLocalBinds #-}
import GHC.TypeLits
newtype LegalChar (legalSet :: Symbol)
= LegalChar {getLegalChar :: Char}
deriving (Show)
fromChar :: KnownSymbol legal => Char -> Maybe (LegalChar legal)
fromChar c
| c`elem`symbolVal r = Just r
| otherwise = Nothing
where r = LegalChar c
Then
*Main> fromChar 'a' :: Maybe (LegalChar "abc")
Just (LegalChar {getLegalChar = 'a'})
*Main> fromChar 'x' :: Maybe (LegalChar "abc")
Nothing
I think in GHC-8 you can even give legalSet the kind String and do away with the KnownSymbol constraint, not sure how that would work.
Related
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.
Is there a way to make haskell type this expression?
ls = [4, 3.2, True, "home"]
It's a challenge a friend gived to me, but no ideas come around, also didn't tell me if that is possible, so maybe I'm wasting precious time.
As joke, you can do like this:
{-# LANGUAGE OverloadedStrings #-}
import Data.String
instance Num Bool where
fromInteger 0 = False
fromInteger _ = True
instance Fractional Bool where
fromRational 0 = False
fromRational _ = True
instance IsString Bool where
fromString "" = False
fromString _ = True
ls = [4, 3.2, True, "home"]
But this doesn't have sense.
If the form of the expression is not fundamental, then as wrote in the comments, you can use the ExistentialType. But there are many variants to do that. From use Data.Dynamic to custom existential type.
For example, with Data.Dynamic:
import Data.Dynamic
ls = [toDyn (4 :: Int), toDyn (3.2 :: Double), toDyn True, toDyn "hello"]
With custom type:
{-# LANGUAGE ExistentialQuantification #-}
data Any = forall a. {- here can be restrictions on `a` => -} Any a
ls :: [Any]
ls = [Any (4 :: Int), Any (3.2 :: Double), Any True, Any "home"]
If type set are closed, you can just use ADT:
data Variant = I Int | D Double | B Bool | S String
ls :: [Variant]
ls = [I 4, D 3.2, B true, S "home"]
So, to select right solution need to know more about your issue.
If you just want to print everything in the list, you can use ExistentialQuantification to "hide" the fact that the types are anything beyond having a Show instance (or whatever instance you care about).
Here's a simple example (note the language extension - I know this works in GHC, not sure about other compilers):
{-# LANGUAGE ExistentialQuantification #-}
data Obj = forall a. (Show a) => Obj a
ls :: [Obj]
ls = [Obj 4, Obj 3.2, Obj True, Obj "home"]
printObj :: Obj -> IO ()
printObj (Obj x) = putStrLn (show x)
main = mapM printObj ls
Notice that your list isn't strictly the same as in your question, but Obj can take any type that has a Show instance.
I found something interesting that maybe is close enough, here
data Showable a = forall a. Show a => MkShowable a
pack :: Show a => a -> Showable
pack = MkShowable
hlist :: [Showable]
hlist = [ pack 3
, pack "house"
, pack True
, pack 'y'
, pack (Just Nothing) ]
res = map (\(MkShowable v) -> show v) hlist
In an attempt at learning how to work with dependent data types in haskell I encountered the following problem:
Suppose you have a function such as:
mean :: ((1 GHC.TypeLits.<=? n) ~ 'True, GHC.TypeLits.KnownNat n) => R n -> ℝ
defined in the hmatrix library, then how do you use this on a vector that has an existential type? E.g.:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
import Data.Proxy (Proxy (..))
import GHC.TypeLits
import Numeric.LinearAlgebra.Static
getUserInput =
let userInput = 3 -- pretend it's unknown at compile time
seed = 42
in existentialCrisis seed userInput
existentialCrisis seed userInput
| userInput <= 0 = 0
| otherwise =
case someNatVal userInput of
Nothing -> undefined -- let's ignore this case for now
Just (SomeNat (proxy :: Proxy n)) ->
let someVector = randomVector seed Gaussian :: R n
in mean someVector -- I know that 'n > 0' but the compiler doesn't
This gives the following error:
• Couldn't match type ‘1 <=? n’ with ‘'True’
arising from a use of ‘mean’
Makes sense indeed, but after some googling and fiddling around, I could not find out how to deal with this. How can I get hold of an n :: Nat, based on user input, such that it satisfies the 1 <= n constraint?. I believe it must be possible since the someNatVal function already succeeds in satisfying the KnownNat constraint based on the condition that the input is not negative.
It seems to me that this is a common thing when working with dependent types, and maybe the answer is obvious but I don't see it.
So my question:
How, in general, can I bring an existential type in scope satisfying the constraints required for some function?
My attempts:
To my surprise, even the following modification
let someVector = randomVector seed Gaussian :: R (n + 1)
gave a type error:
• Couldn't match type ‘1 <=? (n + 1)’ with ‘'True’
arising from a use of ‘mean’
Also, adding an extra instance to <=? to prove this equality does not work as <=? is closed.
I tried an approach combining GADTs with typeclasses as in this answer to a previous question of mine but could not make it work.
Thanks #danidiaz for pointing me in the right direction, the typelist-witnesses documentation provides a nearly direct answer to my question. Seems like I was using the wrong search terms when googling for a solution.
So here is a self contained compileable solution:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
import Data.Proxy (Proxy (..))
import Data.Type.Equality ((:~:)(Refl))
import GHC.TypeLits
import GHC.TypeLits.Compare
import Numeric.LinearAlgebra.Static
existentialCrisis :: Int -> Int -> IO (Double)
existentialCrisis seed userInput =
case someNatVal (fromIntegral userInput) of
Nothing -> print "someNatVal failed" >> return 0
Just (SomeNat (proxy :: Proxy n)) ->
case isLE (Proxy :: Proxy 1) proxy of
Nothing -> print "isLE failed" >> return 0
Just Refl ->
let someVector = randomVector seed Gaussian :: R n
in do
print userInput
-- I know that 'n > 0' and so does the compiler
return (mean someVector)
And it works with input only known at runtime:
λ: :l ExistentialCrisis.hs
λ: existentialCrisis 41 1
(0.2596687587224799 :: R 1)
0.2596687587224799
*Main
λ: existentialCrisis 41 0
"isLE failed"
0.0
*Main
λ: existentialCrisis 41 (-1)
"someNatVal failed"
0.0
It seems like typelist-witnesses does a lot unsafeCoerceing under the hood. But the interface is type-safe so it doesn't really matter that much for practical use cases.
EDIT:
If this question was of interest to you, might also find this post interesting: https://stackoverflow.com/a/41615278/2496293
I'd like to write a horribly non-parametric version of a function of type
pretty :: (Show a) => a -> Text
such that
pretty :: Text -> Text = id
pretty :: String -> Text = T.pack
pretty :: (Show a) => a -> Text = T.pack . show
So the idea is that anything that already has a Show instance can be turned into a "pretty" Text by just show-ing it, except for Text and String which we want to special-case.
The following code works:
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE DataKinds, ConstraintKinds #-}
module Pretty (pretty) where
import Data.Text (Text)
import qualified Data.Text as T
type family StringLike a :: Bool where
StringLike String = True
StringLike Text = True
StringLike a = False
class (b ~ StringLike a) => Pretty' a b where
pretty' :: a -> Text
instance Pretty' String True where
pretty' = T.pack
instance Pretty' Text True where
pretty' = id
instance (Show a, StringLike a ~ False) => Pretty' a False where
pretty' = T.pack . show
type Pretty a = (Pretty' a (StringLike a))
pretty :: (Pretty a) => a -> Text
pretty = pretty'
and it can be used without exporting anything except the pretty function.
However, I am not too happy about the type signature for pretty:
pretty :: (Pretty a) => a -> Text
I feel that since StringLike is a closed type family, there should be a way for GHC to figure out that if only (Show a) holds, (Pretty a) is already satisfied, since:
The following hold trivially just by substituting the results of applying StringLike:
(StringLike String ~ True, Pretty' String True)
(StringLike Text ~ True, Pretty' Text True)
For everything else, we also know the result of applying StringLike:
(Show a, StringLike a ~ False) => (Pretty' a (StringLike a))
Is there a way to convince GHC of this?
I feel that since StringLike is a closed type family, there should be a way for GHC to figure out that if only (Show a) holds, (Pretty a) is already satisfied
To do that would require type inspection, and would break parameteric polymorphism. Consider defining a type family
type family IsInt a :: Bool where
IsInt Int = True
IsInt a = False
class (b ~ IsInt a) => TestInt a b where
isInt :: a -> Bool
instance TestInt Int True where
isInt _ = True
instance (IsInt a ~ False) => TestInt a False where
isInt _ = False
Now by your argument, GHC should be able to satisfy TestInt a from (). In other words, we should be able to test for any given type whether it is equal to Int. This is clearly impossible.
Similarly, a Show a dictionary is equivalent to a function a -> ShowS. How would you be able to decide, given just that, whether the argument is StringLike?
Maybe I misunderstood your goal but this seems like a lot of work to get the type you want.
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, UndecidableInstances, IncoherentInstances #-}
module Prettied where
import Data.Text (Text, pack)
class Pretty a where pretty :: a -> Text
instance Pretty Text where pretty = id
instance Pretty String where pretty = pack
instance Show a => Pretty a where pretty = pack . show
While it may seem that pretty should have type Pretty a => a -> Text, due to IncoherentInstances it will actually have type Show a => a -> Text. This should probably be in its own module because enabling IncoherentInstances is one of those things that can break valid code.
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: