How can I lower a Haskell function to an embedded language in as typesafe a manner as possible. In particular, let's assume I have a value type like
data Type t where
Num :: Type Int
Bool :: Type Bool
data Ty = TNum | TBool deriving Eq
data Tagged t = Tagged (Type t) t deriving Typeable
data Dynamic = forall t . Typeable t => Dynamic (Tagged t) deriving Typeable
forget :: Typeable t => Tagged t -> Dynamic
forget = Dynamic
remember :: Typeable b => Dynamic -> Maybe b
remember (Dynamic c) = cast c
and I want to convert a function like (isSucc :: Int -> Int -> Bool) to product of its dynamic form and some type information, like this
data SplitFun = SF { dynamic :: [Dynamic] -> Dynamic
, inputTypes :: [Ty]
, outputType :: Ty
}
such that for some apply function
(\(a:b:_) -> isSucc a b) == apply (makeDynamicFn isSucc)
modulo some possible exceptions that could be thrown if the dynamic types actually don't match. Or, more explicitly, I'd like to find makeDynamicFn :: FunType -> SplitFun. Obviously that isn't a proper Haskell type and there's unlikely to be a way to pull the types from isSucc itself, so it might be something more like
anInt . anInt . retBool $ isSucc :: SplitFun
where anInt and retBool have printf-style types.
Is such a thing possible? Is there a way to simulate it?
To implement a function of type FunType -> SplitFun, we'll use standard type class machinery to deconstruct function types.
Now, implementing this function directly turns out to be fairly hard. To get inputTypes and outputType from the recursive case, you have to apply your function; but you can only apply the function inside the dynamic field, which gives you no way to fill the other fields. Instead, we'll split the task into two: one function will give us the Ty information, other will construct the [Dynamic] -> Dynamic function.
data Proxy a = Proxy
class Split r where
dynFun :: r -> [Dynamic] -> Dynamic
tyInfo :: Proxy r -> ([Ty], Ty)
split :: r -> SplitFun
split f = let (i, o) = tyInfo (Proxy :: Proxy r)
in SF (dynFun f) i o
Now, tyInfo doesn't actually need the function, we use Proxy just to pass the type information without needing to use undefined all over the place. Note that we need ScopedTypeVariables to be able to refer to the type variable r from instance declaration. Clever use of asTypeOf might also work.
We have two base cases: Bool and Int:
instance Split Int where
dynFun i _ = forget (Tagged Num i)
tyInfo _ = ([], TNum)
instance Split Bool where
dynFun b _ = forget (Tagged Bool b)
tyInfo _ = ([], TBool)
There are no input types and since we already have a value, we do not need to ask for more Dynamic values and we simply return Dynamic of that particular value.
Next, we have two recursive cases: Bool -> r and Int -> r
instance (Split r) => Split (Int -> r) where
dynFun f (d:ds) = case remember d :: Maybe (Tagged Int) of
Just (Tagged _ i) -> dynFun (f i) ds
Nothing -> error "dynFun: wrong dynamic type"
dynFun f [] = error "dynFun: not enough arguments"
tyInfo _ = case tyInfo (Proxy :: Proxy r) of
(i, o) -> (TNum:i, o)
instance (Split r) => Split (Bool -> r) where
dynFun f (d:ds) = case remember d :: Maybe (Tagged Bool) of
Just (Tagged _ b) -> dynFun (f b) ds
Nothing -> error "dynFun: wrong dynamic type"
dynFun f [] = error "dynFun: not enough arguments"
tyInfo _ = case tyInfo (Proxy :: Proxy r) of
(i, o) -> (TBool:i, o)
These two need FlexibleInstances. dynFun examines the first Dynamic argument and if it's okay, we can safely apply the function f to it and continue from there. We could also make dynFun :: r -> [Dynamic] -> Maybe Dynamic, but that's fairly trivial change.
Now, there's some duplication going on. We could introduce another class, such as:
class Concrete r where
getTy :: Proxy r -> Ty
getType :: Proxy r -> Type r
And then write:
instance (Typeable r, Concrete r) => Split r where
dynFun r _ = forget (Tagged (getType (Proxy :: Proxy r)) r)
tyInfo _ = ([], getTy (Proxy :: Proxy r))
instance (Typeable r, Concrete r, Split s) => Split (r -> s) where
dynFun f (d:ds) = case remember d :: Maybe (Tagged r) of
Just (Tagged _ v) -> dynFun (f v) ds
-- ...
tyInfo _ = case tyInfo (Proxy :: Proxy s) of
(i, o) -> (getTy (Proxy :: Proxy r):i, o)
But this needs both OverlappingInstances and UndecidableInstances.
Related
Which is the Curry-Howard correspondent of double negation of a; (a -> r) -> r or (a -> ⊥) -> ⊥, or both?
Both types can be encoded in Haskell as follows, where ⊥ is encoded as forall b. b.
p1 :: forall r. ((a -> r) -> r)
p2 :: (a -> (forall b. b)) -> (forall b. b)
Paper by Wadler 2003 as well as
implementation in Haskell seem to adopt the former, while some
other literature (e.g. this) seems to support the latter.
My current understanding is that the latter is correct. I have difficulty in understanding the former style, since you can create a value of type a from forall r. ((a -> r) -> r) using pure computation:
> let p1 = ($42) :: forall r. (Int -> r) -> r
> p1 id
42
which seems to contradict with intuitionistic logic that you cannot derive a from ￢￢a.
So, my question is: can p1 and p2 both be regarded as Curry-Howard correspondent of ￢￢a ? If so, how does the fact that we can construct p1 id :: a interact with the intuitionistic logic?
I have come up with clearer encoding of conversion to/from double negation, for convenience of discussion. Thanks to #user2407038 !
{-# LANGUAGE RankNTypes #-}
to_double_neg :: forall a. a -> (forall r. (a->r)->r)
to_double_neg x = ($x)
from_double_neg :: forall a. (forall r. (a->r)->r) -> a
from_double_neg x = x id
To construct a value of type T1 a = forall r . (a -> r) -> r is at least as demanding as construction of a value of type T2 a = (a -> Void) -> Void for, say, Void ~ forall a . a. This can be pretty easily seen because if we can construct a value of type T1 a then we automatically have a value at type T2 a by merely instantiating the forall with Void.
On the other hand, if we have a value of type T2 a we cannot go back. The following appears about right
dne :: forall a . ((a -> Void) -> Void) -> (forall r . (a -> r) -> r)
dne t2 = \f -> absurd (t2 (_ f)) -- we cannot fill _
but the hole _ :: (a -> r) -> (a -> Void) cannot be filled—we both "know" nothing about r in this context and we know we cannot construct a Void.
Here's another important difference: T1 a -> a is fairly trivial to encode, we instantiate the forall with a and then apply id
project :: T1 a -> a
project t1 = t1 id
But, on the other hand, we cannot do this for T2 a
projectX :: T2 a -> a
projectX t2 = absurd (t2 (_ :: a -> Void))
or, at least we cannot without cheating our intuitionistic logic.
So, together these ought to give us a hint as to which of T1 and T2 is genuine double negation and why each is used. To be clear, T2 is genuinely double negation---just like you expect---but T1 is easier to deal with... especially if you work with Haskell98 which lacks nullary data types and higher rank types. Without these, the only "valid" encoding of Void is
newtype Void = Void Void
absurd :: Void -> a
absurd (Void v) = absurd v
which might not be the best thing to introduce if you don't need it. So what ensures that we can use T1 instead? Well, as long as we only ever consider code which is not allowed to instantiate r with a specific type variable then we are, in effect, acting as though it is an abstract or existential type with no operations. This is sufficient for handling many arguments pertaining to double negation (or continuations) and so it might be simpler to just talk about the properties of forall r . (a -> r) -> r rather than (a -> Void) -> Void so long as you maintain a proper discipline which allows you to convert the former to the latter if genuinely needed.
You are correct that (a -> r) -> r is a correct encoding of double negation according to the Curry-Howard isomorphism. However, the type of your function does not fit that type! The following:
double_neg :: forall a r . ((a -> r) -> r)
double_neg = (($42) :: (Int -> r) -> r )
gives a type error:
Couldn't match type `a' with `Int'
`a' is a rigid type variable bound by
the type signature for double_neg :: (a -> r) -> r at test.hs:20:22
Expected type: (a -> r) -> r
Actual type: (Int -> r) -> r
Relevant bindings include
double_neg :: (a -> r) -> r (bound at test.hs:21:1)
More detail: It doesn't matter how you encode bottom. A short demo in agda can help show this. Assuming only one axiom - namely ex falso quodlibet, literally "from false anything follows".
record Double-Neg : Set₁ where
field
⊥ : Set
absurd : {A : Set} → ⊥ → A
¬_ : Set → Set
¬ A = A → ⊥
{-# NO_TERMINATION_CHECK #-}
double-neg : { P : Set } → ¬ (¬ P) → P
double-neg f = absurd r where r = f (λ _ → r)
Note you cannot write a valid definition of double-neg without turning off the termination checker (which is cheating!). If you try your definition again, you also get a type error:
data ⊤ : Set where t : ⊤
double-neg : { P : Set } → ¬ (¬ P) → P
double-neg {P} f = f t
gives
⊤ !=< (P → ⊥)
when checking that the expression t has type ¬ P
Here !=< means "is not a subtype of".
To summarize, the approach p2/T2 is more disciplined, but we cannot compute any practical value out of it. On the other hand p1/T1 allows to instantiate r, but the instantiation is necessary to perform runCont :: Cont r a -> (a -> r) -> r or runContT and get any result and side effect out of it.
However, we can emulate p2/T2 within Control.Monad.Cont , by instantiating r to Void, and by using only the side effect, as follows:
{-# LANGUAGE RankNTypes #-}
import Control.Monad.Cont
import Control.Monad.Trans (lift)
import Control.Monad.Writer
newtype Bottom = Bottom { unleash :: forall a. a}
type C = ContT Bottom
type M = C (Writer String)
data USD1G = USD1G deriving Show
say x = lift $ tell $ x ++ "\n"
runM :: M a -> String
runM m = execWriter $
runContT m (const $ return undefined) >> return ()
-- Are we sure that (undefined :: Bottom) above will never be used?
exmid :: M (Either USD1G (USD1G -> M Bottom))
exmid = callCC f
where
f k = return (Right (\x -> k (Left x)))
useTheWish :: Either USD1G (USD1G -> M Bottom) -> M ()
useTheWish e = case e of
Left money -> say $ "I got money:" ++ show money
Right method -> do
say "I will pay devil the money."
unobtainium <- method USD1G
say $ "I am now omnipotent! The answer to everything is:"
++ show (unleash unobtainium :: Integer)
theStory :: String
theStory = runM $ exmid >>= useTheWish
main :: IO ()
main = putStrLn theStory
{-
> runhaskell bottom-encoding-monad.hs
I will pay devil the money.
I got money:USD1G
-}
If we want to further get rid of the ugly undefined :: Bottom , I think I need to avoid re-invention and use the CPS libraries such as conduits and machines. An example using machines is as follows:
{-# LANGUAGE RankNTypes, ImpredicativeTypes, ScopedTypeVariables #-}
import Data.Machine
import Data.Void
import Unsafe.Coerce
type M k a = Plan k String a
type PT k m a = PlanT k String m a
data USD = USD1G deriving (Show)
type Contract k m = Either USD (USD -> PT k m Void)
callCC :: forall a m k. ((a -> PT k m Void) -> PT k m a) -> PT k m a
callCC f = PlanT $
\ kp ke kr kf ->
runPlanT (f (\x -> PlanT $ \_ _ _ _ -> unsafeCoerce $kp x))
kp ke kr kf
exmid :: PT k m (Contract k m)
exmid = callCC f
where
f k =
return $ Right (\x -> k (Left x))
planA :: Contract k m -> PT k m ()
planA e = case e of
Left money ->
yield $ "I got money: " ++ show money
Right method -> do
yield $ "I pay devil the money"
u <- method USD1G
yield $ "The answer to everything is :" ++ show (absurd u :: Integer)
helloMachine :: Monad m => SourceT m String
helloMachine = construct $ exmid >>= planA
main :: IO ()
main = do
xs <- runT helloMachine
print xs
Thanks to our conversation, now I have better understanding of the type signature of runPlanT .
I want to write the isShowable function as part of this code.
data MaybeShowable = forall a . Show a => Showable a | Opaque
f :: (Data d) => d -> String
f x = case isShowable x of
Showable s -> show s
Opaque -> "<<OPAQUE>>"
isShowable :: (Data d) => d -> MaybeShowable
isShowable = ???
Is this possible by using the Data instance? If not, what is the best way to do it?
Note: If there's no other option, I'm willing to settle for this a version that works only for type class instances visible through the imports to the module in which isShowable is defined.
I'm not sure what is your real intention is, but it looks like you'd like to embed Java idiom into Haskell.
As mentioned in other SO question what you are doing is going to turn into anti-pattern.
You have added a clarification:
If I would be willing to settle for "typeclass instances visible through the imports to the module in which isShowable is defined".
Why wouldn't you wrap your type in:
data MaybeShowable a where
Showable :: forall b. Show b => b -> MaybeShowable b
Opaque :: forall b. b -> MaybeShowable b
instance Show (MaybeShowable a) where
show (Showable x) = show x
show (Opaque x) = "<<OPAQUE>>"
And have your functions operate on MaybeShowable a, instead of plain a.
Yet this is ugly still. Isn't it be easier to operate directly on Show a => a, or a.
Other way is to capture Show a dictionary early enough, i.e. have data type:
data MaybeShowable a = Showable a String -- Or even Showable a (a -> String)
| Opaque a
instance Show (MaybeShowable a) where
show (Showable x s) = s
show (Opaque x) = "<<OPAQUE>>"
wrapShow :: Show a => a -> MaybeShowable a
wrapShow x = Showable x (show x) -- Showable x show
wrapOpaque :: a -> MaybeShowable a
wrapOpaque = Opaque
The variation of this approach is used in e.g. QuickCheck's forAll. That part is Haskell98. There the show x is closed over into closure, which maybe executed or not. Lazyness is the key point here!
You can ask using template haskell which instances are available:
module IsInstance where
import Language.Haskell.TH; import Data.Typeable
import Data.Generics; import Data.Monoid
-- $(isInst ''Show) :: Typeable a => a -> Bool
isInst :: Name -> ExpQ
isInst className = do
ClassI _ insts <- reify className
ClassI _ typeableInsts <- reify ''Typeable
let typeOfs = [ [| typeRep (Proxy :: Proxy $(return ty)) |]
| InstanceD _ (AppT _ ty) _ <- insts,
hasNoVarT ty,
or [ ty_ == ty | InstanceD _ (AppT _ ty_) _ <- typeableInsts ] ]
[| \ val -> typeOf val `elem` $(listE typeOfs) |]
hasNoVarT xs = getAll $ everything
(<>)
(mkQ mempty (\ x -> case x of
VarT {} -> All False
_ -> mempty))
xs
$(isInst ''Show) (1 :: Int) is true, but unfortunately
$(isInst ''Show) (1 :: Rational) is false, since here using == doesn't say that an instance for Show (Ratio a) can be used with type Rational = Ratio Integer. So a complete solution is going to have to know how instances are selected.
I have defined a simple algebraic (concrete) data type, MyType :
data MyTpe = MyBool Bool | MyInt Int
... and I am trying to find a way to "convert" arbitrary functions (a->b), where a and b are either Bool or Int, into the associated (MyType->MyType) functions.
This does the job, it converts (a->b) into Maybe (MyType->MyType) (see [1] below) :
import Data.Typeable
data MyTpe = MyBool Bool | MyInt Int deriving Show
liftMyType :: (Typeable a, Typeable b) => (a -> b) -> Maybe (MyTpe -> MyTpe)
liftMyType f = case castIntInt f of
Just g -> Just $ liftIntInt g
Nothing ->
case castIntBool f of
Just g -> Just $ liftIntBool g
Nothing ->
case castBoolInt f of
Just g -> Just $ liftBoolInt g
Nothing ->
case castBoolBool f of
Just g -> Just $ liftBoolBool g
Nothing -> Nothing
castIntInt :: (Typeable a, Typeable b) => (a -> b) -> Maybe (Int -> Int)
castIntInt f = cast f :: Maybe (Int -> Int)
castIntBool :: (Typeable a, Typeable b) => (a -> b) -> Maybe (Int -> Bool)
castIntBool f = cast f :: Maybe (Int -> Bool)
castBoolInt :: (Typeable a, Typeable b) => (a -> b) -> Maybe (Bool -> Int)
castBoolInt f = cast f :: Maybe (Bool -> Int)
castBoolBool :: (Typeable a, Typeable b) => (a -> b) -> Maybe (Bool -> Bool)
castBoolBool f = cast f :: Maybe (Bool -> Bool)
liftIntInt :: (Int -> Int) -> (MyTpe -> MyTpe)
liftIntInt f (MyInt x) = MyInt (f x)
liftIntBool :: (Int -> Bool) -> (MyTpe -> MyTpe)
liftIntBool f (MyInt x) = MyBool (f x)
liftBoolInt :: (Bool -> Int) -> (MyTpe -> MyTpe)
liftBoolInt f (MyBool x) = MyInt (f x)
liftBoolBool :: (Bool -> Bool) -> (MyTpe -> MyTpe)
liftBoolBool f (MyBool x) = MyBool (f x)
However that's quite ugly and does not scale well : what if I want to extend MyType that way?
data MyTpe = MyBool Bool | MyInt Int | MyString String
... Or what if I also want to convert (a1 -> a2 -> b), where a1,a2 and b are Bool or Int, into the associated (MyType->MyType->MyType) function?...
My question : is there a simple, more elegant and more Haskell-like way to handle this issue?
[1]: liftIntInt function and the like are not defined over all MyType elements (eg liftIntInt is not defined for (MyBool x) element). The code is just a reduced case example and in real life I handle this properly.
You're looking for a type
goal :: (a -> b) -> (MyType -> MyType)
for some "suitable" choices of a and b. These "suitable" choices are known statically as the definition of MyType is known statically.
What you're looking for is a typeclass. In particular, we'll want the MultiParamTypeClasses pragma
{-# LANGUAGE MultiParamTypeClasses #-}
class MapMyType a b where
liftMyType :: (a -> b) -> (MyType -> MyType)
so now the full type for liftMyType is
liftMyType :: MapMyType a b => (a -> b) -> (MyType -> MyType)
and we can use the typeclass machinery to store the various instantiations of liftMyType having it be usable only and exactly when a and b can be resolved to be types where liftMyType is inhabited.
instance MapMyType Int Int where liftMyType f (MyInt x) = MyInt (f x)
instance MapMyType Int Bool where liftMyType f (MyInt x) = MyBool (f x)
instance MapMyType Bool Int where liftMyType f (MyBool x) = MyInt (f x)
instance MapMyType Bool Bool where liftMyType f (MyBool x) = MyBool (f x)
-- (as a side note, this is a dangerous function to instantiate since it
-- has incomplete pattern matching on its `MyType` typed argument)
Now, it's worth mentioning that MultiParamTypeClasses often damages inference when used like this. In particular, if we're looking at a fragment of code liftMyType a b we have to be able to infer the type of a and b on their own (e.g., without help from hints being passed "down" from the call to liftMyType) otherwise we'll get an ambiguous instance compilation failure. Actually, what makes this especially bad, is that we'll get that compilation failure if either a or b cannot be directly inferred.
In many circumstances, you would want to control this issue using FunctionalDependencies allowing a little more inference to "flow" between the two parameters and making ambiguity errors less common.
But in this case, I'd consider it to be a code smell. While the code above works (with caveat to the commented note) it has the feeling of a fragile solution.
To answer your question: "is there a simple, more elegant and more Haskell-like way to handle this issue?" There is no elegant or Haskell-like way to solve this problem. Haskell is not a dynamically typed language, and while the designers have managed to fake dynamic typing, you really should avoid it. This question makes it seem like you are trying to fix bad design somewhere with dynamic typing.
You can, however, write a simplified version of your code which is also extensible, using generics:
{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics
import Data.Typeable
liftFun :: forall a b c . (Generic c, GLiftFun (Rep c), Typeable a, Typeable b)
=> (a -> b) -> c -> Maybe c
liftFun f x = do
a <- gGet (from x)
b <- gPut (f a)
return (to b)
class GLiftFun f where
gPut :: Typeable a => a -> Maybe (f q)
gGet :: Typeable a => f q -> Maybe a
instance Typeable a => GLiftFun (K1 i a) where
gPut = fmap K1 . cast
gGet = cast . unK1
instance GLiftFun f => GLiftFun (M1 i c f) where
gPut = fmap M1 . gPut
gGet = gGet . unM1
instance (GLiftFun f, GLiftFun g) => GLiftFun (f :+: g) where
gPut a | Just r <- gPut a = Just (L1 r)
| Just r <- gPut a = Just (R1 r)
| otherwise = Nothing
gGet (L1 a) = gGet a
gGet (R1 a) = gGet a
liftFun will work for any type which is a simple sum type, like Either or any type you define which is isomorphic to a series of nested Eithers. It probably has a sensible extension to product types as well. For example any of the following will work:
data MyType = MyBool Bool | MyInt Int deriving (Show, Generic)
data MyType2 = B2 Bool | I2 Int | S2 String deriving (Show, Generic)
type MyType3 = Either String Int
Here's how you could do it in a scalable way:
{-# LANGUAGE DeriveDataTypeable #-}
import Data.Typeable
data MyTpe = MyBool Bool | MyInt Int deriving (Show,Typeable)
d :: (Typeable a, Typeable b) => (a->b) -> Maybe (a -> MyTpe)
d f = case (cast f :: (Typeable a) => Maybe (a->Int)) of
Just f -> Just $ MyInt . f
_ -> case (cast f :: (Typeable a) => Maybe (a->Bool)) of
Just f -> Just $ MyBool . f
_ -> Nothing -- add more constructor matching here
e :: (Typeable a, Typeable b) => a -> Maybe (b->MyTpe) -> Maybe MyTpe
e x = (>>= \f -> fmap ($ x) (cast f :: (Typeable a => Maybe (a->MyTpe))))
liftMyType :: (Typeable a, Typeable b) => (a->b) -> MyTpe -> Maybe MyTpe
liftMyType f (MyInt x) = e x $ d f
liftMyType f (MyBool x) = e x $ d f
-- add more constructor matching here
...
> liftMyType ((+1) :: Int->Int) (MyInt 100)
> Just (MyInt 101)
You could even get the type you wanted - i.e. Maybe (MyTpe->MyTpe) - you don't need to pattern-match on the argument, just then you won't get a total function MyTpe -> MyTpe even if it is Just.
liftMyType = fmap h . d where
h g = case (cast g :: Maybe (Int->MyTpe)) of
Just g -> (\(MyInt x)) -> g x
_ -> case (cast g :: Maybe (Bool->MyTpe)) of
Just g -> (\(MyBool x)) -> g x
_ -> Nothing -- add more type matching here
...
> fmap ($ MyInt 100) $ liftMyType ((+1) :: Int->Int)
> Just (MyInt 101)
In Type-Safe Observable Sharing in Haskell Andy Gill shows how to recover sharing that existed on the Haskell level, in a DSL. His solution is implemented in the data-reify package. Can this approach be modified to work with GADTs? For example, given this GADT:
data Ast e where
IntLit :: Int -> Ast Int
Add :: Ast Int -> Ast Int -> Ast Int
BoolLit :: Bool -> Ast Bool
IfThenElse :: Ast Bool -> Ast e -> Ast e -> Ast e
I'd like to recover sharing by transforming the above AST to
type Name = Unique
data Ast2 e where
IntLit2 :: Int -> Ast2 Int
Add2 :: Ast2 Int -> Ast2 Int -> Ast2 Int
BoolLit2 :: Bool -> Ast2 Bool
IfThenElse2 :: Ast2 Bool -> Ast2 e -> Ast2 e -> Ast2 e
Var :: Name -> Ast2 e
by the way of a function
recoverSharing :: Ast -> (Map Name, Ast2 e1, Ast2 e2)
(I'm not sure about the type of recoverSharing.)
Note that I don't care about introducing new bindings via a let construct, but only in recovering the sharing that existed on the Haskell level. That's why I have recoverSharing return a Map.
If it can't be done as reusable package, can it at least be done for specific GADT?
Interesting puzzle! It turns out you can use data-reify with GADTs. What you need is a wrapper that hides the type in an existential. The type can later be retrieved by pattern matching on the Type data type.
data Type a where
Bool :: Type Bool
Int :: Type Int
data WrappedAst s where
Wrap :: Type e -> Ast2 e s -> WrappedAst s
instance MuRef (Ast e) where
type DeRef (Ast e) = WrappedAst
mapDeRef f e = Wrap (getType e) <$> mapDeRef' f e
where
mapDeRef' :: Applicative f => (forall b. (MuRef b, WrappedAst ~ DeRef b) => b -> f u) -> Ast e -> f (Ast2 e u)
mapDeRef' f (IntLit i) = pure $ IntLit2 i
mapDeRef' f (Add a b) = Add2 <$> (Var Int <$> f a) <*> (Var Int <$> f b)
mapDeRef' f (BoolLit b) = pure $ BoolLit2 b
mapDeRef' f (IfThenElse b t e) = IfThenElse2 <$> (Var Bool <$> f b) <*> (Var (getType t) <$> f t) <*> (Var (getType e) <$> f e)
getVar :: Map Name (WrappedAst Name) -> Type e -> Name -> Maybe (Ast2 e Name)
getVar m t n = case m ! n of Wrap t' e -> (\Refl -> e) <$> typeEq t t'
Here's the whole code: https://gist.github.com/3590197
Edit: I like the use of Typeable in the other answer. So I did a version of my code with Typeable too: https://gist.github.com/3593585. The code is significantly shorter. Type e -> is replaced by Typeable e =>, which also has a downside: we no longer know that the possible types are limited to Int and Bool, which means there has to be a Typeable e constraint in IfThenElse.
I will try show that this can be done for specific GADTs, using your GADT as an example.
I will use the Data.Reify package. This requires me to define a new data structure in which the recusive positions are replaced by a parameter.
data AstNode s where
IntLitN :: Int -> AstNode s
AddN :: s -> s -> AstNode s
BoolLitN :: Bool -> AstNode s
IfThenElseN :: TypeRep -> s -> s -> s -> AstNode s
Note that I remove a lot of type information that was available in the original GADT. For the first three constructors it is clear what the associated type was (Int, Int and Bool). For the last one I will remember the type using TypeRep (available in Data.Typeable). The instance for MuRef, required by the reify package, is shown below.
instance Typeable e => MuRef (Ast e) where
type DeRef (Ast e) = AstNode
mapDeRef f (IntLit a) = pure $ IntLitN a
mapDeRef f (Add a b) = AddN <$> f a <*> f b
mapDeRef f (BoolLit a) = pure $ BoolLitN a
mapDeRef f (IfThenElse a b c :: Ast e) =
IfThenElseN (typeOf (undefined::e)) <$> f a <*> f b <*> f c
Now we can use reifyGraph to recover sharing. However, a lot of type information was lost. Lets try to recover it. I altered your definition of Ast2 slightly:
data Ast2 e where
IntLit2 :: Int -> Ast2 Int
Add2 :: Unique -> Unique -> Ast2 Int
BoolLit2 :: Bool -> Ast2 Bool
IfThenElse2 :: Unique -> Unique -> Unique -> Ast2 e
The graph from the reify package looks like this (where e = AstNode):
data Graph e = Graph [(Unique, e Unique)] Unique
Lets make a new graph data structure where we can store Ast2 Int and Ast2 Bool separately (thus, where the type information has been recovered):
data Graph2 = Graph2 [(Unique, Ast2 Int)] [(Unique, Ast2 Bool)] Unique
deriving Show
Now we only need to find a function from Graph AstNode (the result of reifyGraph) to Graph2:
recoverTypes :: Graph AstNode -> Graph2
recoverTypes (Graph xs x) = Graph2 (catMaybes $ map (f toAst2Int) xs)
(catMaybes $ map (f toAst2Bool) xs) x where
f g (u,an) = do a2 <- g an
return (u,a2)
toAst2Int (IntLitN a) = Just $ IntLit2 a
toAst2Int (AddN a b) = Just $ Add2 a b
toAst2Int (IfThenElseN t a b c) | t == typeOf (undefined :: Int)
= Just $ IfThenElse2 a b c
toAst2Int _ = Nothing
toAst2Bool (BoolLitN a) = Just $ BoolLit2 a
toAst2Bool (IfThenElseN t a b c) | t == typeOf (undefined :: Bool)
= Just $ IfThenElse2 a b c
toAst2Bool _ = Nothing
Lets do an example:
expr = Add (IntLit 42) expr
test = do
graph <- reifyGraph expr
print graph
print $ recoverTypes graph
Prints:
let [(1,AddN 2 1),(2,IntLitN 42)] in 1
Graph2 [(1,Add2 2 1),(2,IntLit2 42)] [] 1
The first line shows us that reifyGraph has correctly recovered sharing. The second line shows us that only Ast2 Int types have been found (which is also correct).
This method is easily adaptable for other specific GADTs, but I don't see how it could be made entirely generic.
The complete code can be found at http://pastebin.com/FwQNMDbs .
I'm trying to construct a datatype that is essentially a binary tree whose: each node's left branch is a function that can act on the variable in each node's right branch. I'm new to Haskell, and I'm not sure I'm going about this the right way, but my current problem is that I can't figure out how to add my type to the Show typeclass. Here is my attempt:
{-# LANGUAGE ExistentialQuantification #-}
-- file: TS.hs
data TypeSentence a = forall b. Apply (TypeSentence (b->a)) (TypeSentence b)
| Expr a
instance (Show a) => (Show (TypeSentence a)) where
show (Expr x) = show x
show (Apply x y) = (show x) ++ " " ++ (show y)
instance (Show (TypeSentence b->a)) where
show (Expr x) = show "hello"
x = Expr 1
f = Expr (+1)
s = Apply f x
However, when I load this into ghci I get the following error:
TS.hs:9:24:
Could not deduce (Show (b -> a)) from the context ()
arising from a use of `show' at TS.hs:9:24-29
Possible fix:
add (Show (b -> a)) to the context of the constructor `Apply'
or add an instance declaration for (Show (b -> a))
In the first argument of `(++)', namely `(show x)'
In the expression: (show x) ++ " " ++ (show y)
In the definition of `show':
show (Apply x y) = (show x) ++ " " ++ (show y)
Failed, modules loaded: none.
Any ideas how I go about adding the Show (b->a) declaration?
Thanks.
There are a few problems with your code as written, so I'm going to go through them one by one.
You can't add a particularly informative instance for Show (a -> b). Consider how you'd have to write it:
instance Show (a -> b) where
show f = error "What goes here?"
Since f is a function, there's nothing you can do with it other than apply it to a value; and since a is a fully-polymorphic type, you can't create a value of type a to apply f to. So your only option is something like
instance Show (a -> b) where
show _ = "<function>"
As Daniel Fischer said in a comment, this is available in the Text.Show.Functions module. I wouldn't actually bother with this, though; I'd just write something like
instance Show a => Show (TypeSentence a) where
show (Apply _ x) = "Apply _ " ++ show x -- This still won't work; see below
show (Expr x) = "Expr " ++ show x
Since show can only return the one string for any function, just inline that directly.
Even then, though, you still can't write that Show instance. If you try to compile the instance above, you get the following error:
TS.hs:8:36:
Could not deduce (Show b) arising from a use of `show'
from the context (Show a)
bound by the instance declaration
at TS.hs:7:10-40
Possible fix:
add (Show b) to the context of
the data constructor `Apply'
or the instance declaration
In the second argument of `(++)', namely `show x'
In the expression: "Apply _ " ++ show x
In an equation for `show': show (Apply _ x) = "Apply _ " ++ show x
The problem is that, in your definition of TypeSentence, Apply hides a variable (bound as x in the definition of show) of TypeSentence parametrized by some arbitrary existentially-hidden type b. But there's no guarantee that b is showable, so show x won't type check, which is the error produced above: there's no instance for Show b, because b is arbitrary. So to get rid of that, the simplest approach would be
instance Show a => Show (TypeSentence a) where
show (Apply _ _) = "Apply _ _"
show (Expr x) = "Expr " ++ show x
And that's not particularly useful. So maybe there's not a good Show instance for TypeSentence. (And that's fine. Many useful types don't have Show instances.)
This one's unrelated to everything else. The instance Show (TypeSentence b -> a) declaration tries to declare an instance of Show for functions from TypeSentence b to a; if you reparenthesize that as instance Show (TypeSentence (b -> a)), you still need both the FlexibleInstances and OverlappingInstances extension to get that to compile. So that you should probably just axe.
Well, let's reason this through. Your proposed Show instance's show method will be called with some function f :: b -> a.
instance Show (b -> a) where
show f = ...
What can your show method do? Well, it must produce some String, but how will it do it?
Well, since the type of f is b -> a, the only thing you can do with f is apply it to something of type b. Yet show has no argument of type b, and your Show class doesn't have any constants of type b, so the only thing that this show method could do with f is apply it to undefined. Which may or may not produce an error, depending on whether f is strict or not—which you have no control over, and I'm sure you don't want show to error out on some arguments anyway.
But in any case, even if you did get a result from f undefined, this result it would have type a, and there really is nothing your definition can do with an a anyway, since you don't have any functions of type a -> whatever available. (And if you did have one, unless whatever was String, you'd still be in the same position.)
So there's nothing sensible you can do with f, and since you have no other arguments, this means that the only thing your method can do is return a value that doesn't depend on f or any other argument. Thus, your method's return value has to be a constant, or undefined. Since using undefined would be silly, the only sensible thing this show method can do is return a constant String:
instance Show (b -> a) where
show _ = "<function>"
As Daniel Fischer mentions in his comment to your question, this is already available in Text.Show.Functions.
But the lesson here is to take this as an example on how to reason through your question. This is one of the neat things about Haskell: you can often prove what a function can, can't or must do just by looking at the types. For example, if you have foo :: (a -> b) -> [a] -> [b], assuming foo is not silly enough doesn't use undefined gratuitously, you can infer that the bs in the [b] result are obtained by applying the a -> b type argument to elements of the [a] argument. There is no other way for foo to produce values of type b. (If you didn't guess already, the most natural function of that type is map :: (a -> b) -> [a] -> [b].)
I think the #Davorak 's comment is what you want.
https://stackoverflow.com/a/15846061/6289448
I just share it here. Pass test in ghc 8.6.5.
There is a partial solution that goes beyond just a fixed string for all functions using Data.Typeable.
{-# LANGUAGE ScopedTypeVariables #-}
import Data.Typeable
instance (Typeable a, Typeable b) => Show (a->b) where
show _ = show $ typeOf (undefined :: a -> b)
in ghci
> let test :: Int->Int; test x = x + x
> test
Int -> Int
Unfortunately without a type signature the type will go to it default.
> let test x = x + x
> test
Integer -> Integer
This solution works on multiple function arities because a -> b -> c is the same as a -> (b -> c) which you might as well write as a -> d where d = b -> c.
> let m10 a b c d e f g h i j = a * b * c * d * e * f * g * h* i * j
> m10
Integer -> Integer -> Integer -> Integer -> Integer -> Integer -> Integer
-> Integer -> Integer -> Integer -> Integer
This method does not work however when it is unknown if parameters of the function have the typeable class however so while map (+1) will work map will not.
> map (+1)
[Integer] -> [Integer]
> map
<interactive>:233:1:
...
After glancing at the internals of Data.Data and an experiment or two it seems like it could be refactored to be a little more generalized cover more functions.
If you dont like implemention above, just implement it by yourself!
(Let me know If there's a better way, please!)
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE ScopedTypeVariables #-}
newtype GenType a =
GenType
{ asTypeStr :: String
}
class GenTypeArbitrary a where
gtArbitrary :: a -> GenType a
instance GenTypeArbitrary String where
gtArbitrary :: String -> GenType String
gtArbitrary _ = GenType "String123"
instance GenTypeArbitrary Bool where
gtArbitrary :: Bool -> GenType Bool
gtArbitrary _ = GenType "Bool123"
instance GenTypeArbitrary Int where
gtArbitrary :: Int -> GenType Int
gtArbitrary _ = GenType "Int123"
instance (GenTypeArbitrary a, GenTypeArbitrary b) => GenTypeArbitrary (a -> b) where
gtArbitrary :: (GenTypeArbitrary a, GenTypeArbitrary b) => (a -> b) -> GenType (a -> b)
gtArbitrary _ = GenType $ aTypeStr' ++ " --> " ++ bTypeStr
where
aTypeStr = asTypeStr (gtArbitrary (undefined :: a))
aTypeStr' =
if "-->" `isInfixOf` aTypeStr
then "(" ++ aTypeStr ++ ")"
else aTypeStr
bTypeStr = asTypeStr (gtArbitrary (undefined :: b))
instance (GenTypeArbitrary a, GenTypeArbitrary b) => Show (a -> b) where
show f = asTypeStr $ gtArbitrary f
test1 :: Int -> String
test1 x = ""
test2 :: Int -> String -> Int -> Bool -> Bool
test2 _ _ _ _ = False
test3 :: Int -> ((String -> Int) -> Bool) -> Bool
test3 _ _ = False
test4 :: Int -> (Bool -> (String -> Int)) -> Bool
test4 _ _ = False
λ > show (test4)
"Int123 --> (Bool123 --> String123 --> Int123) --> Bool123"
it :: String
...
λ > show (test3)
"Int123 --> ((String123 --> Int123) --> Bool123) --> Bool123"
it :: String
If your function's domain is a finite set then you can print the value of your function at all the points. In Haskell you can do that with the typeclasses Ix and Bounded by using a function like:
rangeF :: (Ix a, Bounded a) => [a]
rangeF = range (minBound, maxBound)