I have a system in haskell that uses Data.Dynamic and Type.Reflection to perform inference and calculations. I would like to be able to print the results.
Printing is easy when the type is supplied e.g
foo :: Dynamic -> String
foo dyn = case tyConName . someTypeRepTyCon . dynTypeRep $ dyn of
"Int" -> show $ fromDyn dyn (0 :: Int)
"Bool" -> show $ fromDyn dyn True
_ -> "no chance"
But if I want to be able to print tuples, I would have to add a new line for each e.g (Int, Bool), (Bool, Int), (Char, Int, Banana) ....
With the addition of more primitives and larger tuples this quickly becomes impractical.
Is there an algorithmic way to generate strings for this dynamic data, specifically for tuples and lists.
I like the main idea of the other answer, but it seems to get where it's going in a fairly roundabout way. Here's how I would style the same idea:
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE GADTs #-}
import Type.Reflection
import Data.Dynamic
showDyn :: Dynamic -> String
showDyn (Dynamic (App (App (eqTypeRep (typeRep #(,)) -> Just HRefl) ta) tb) (va, vb))
= concat [ "DynamicPair("
, showDyn (Dynamic ta va)
, ","
, showDyn (Dynamic tb vb)
, ")"
]
showDyn (Dynamic (eqTypeRep (typeRep #Integer) -> Just HRefl) n) = show n
showDyn (Dynamic tr _) = show tr
That first pattern match is quite a mouthful, but after playing with a few different ways of formatting it I'm convinced that there just is no way to make that look good. You can try it in ghci:
> showDyn (toDyn ((3,4), (True, "hi")))
"DynamicPair(DynamicPair(3,4),DynamicPair(Bool,[Char]))"
I could only manage to obtain this horrible solution.
{-# LANGUAGE GADTs, ScopedTypeVariables, TypeApplications #-}
{-# OPTIONS -Wall #-}
import Type.Reflection
import Data.Dynamic
Here we define the TyCon for (,) and Int. (I'm pretty sure there must be an easier way.)
pairTyCon :: TyCon
pairTyCon = someTypeRepTyCon (someTypeRep [('a','b')])
intTyCon :: TyCon
intTyCon = someTypeRepTyCon (someTypeRep [42 :: Int])
Then we dissect the Dynamic type. First we check if it is an Int.
showDynamic :: Dynamic -> String
showDynamic x = case x of
Dynamic tr#(Con k) v | k == intTyCon ->
case eqTypeRep tr (typeRep # Int) of
Just HRefl -> show (v :: Int)
_ -> error "It really should be an int"
-- to be continued
The above is ugly, since we first pattern match against the TyCon using == instead of pattern matching, which prevents the type refinement of v into an Int. So, we still have to resort to eqTypeRep to perform a second check which we already know has to succeed.
I think it could be made pretty by checking eqTypeRep in advance, for instance. Or fromDyn. It does not matter.
What matters is that the pair case below is even more messy, and can not be made pretty in the same way, as far as I can see.
-- continuing from above
Dynamic tr#(App (App t0#(Con k :: TypeRep p)
(t1 :: TypeRep a1))
(t2 :: TypeRep a2)) v | k == pairTyCon ->
withTypeable t0 $
withTypeable t1 $
withTypeable t2 $
case ( eqTypeRep tr (typeRep #(p a1 a2))
, eqTypeRep (typeRep #p) (typeRep #(,))) of
(Just HRefl, Just HRefl) ->
"DynamicPair("
++ showDynamic (Dynamic t1 (fst v))
++ ", "
++ showDynamic (Dynamic t2 (snd v))
++ ")"
_ -> error "It really should be a pair!"
_ -> "Dynamic: not an int, not a pair"
Above we match the TypeRep so that it represents something of type p a1 a2. We require that the representation of p to be pairTyCon.
As before this does not trigger type refinement, since it is done with == instead of pattern matching. We need to perform another explicit match to force p ~ (,) and another for the final refinement v :: (a1,a2). Sigh.
Finally, we can take fst v and snd v, turn them into Dynamic once again, and pair them. Effectively, we turned the original x :: Dynamic into something like (fst x, snd x) where both components are Dynamic. Now we can recurse.
I would really like to avoid the errors, but I can not see how to do that at the moment.
The redeeming part is that the approach is very general, and can be easily adapted to other type constructors.
Related
StackOverflow!
For reasons that would like to remain between me and God, I'm currently playing around with promoting runtime naturals to the type level. I've been following this approach with GHC.TypeLits, which has worked out fine so far.
However, in one instance, I have an additional constraint of 1 <= n, i.e. my promoted natural not to be just any natural, but at least 1. This is also from GHC.TypeLits And I am unsure if/how it is possible to extract and make that information known.
Here's a minimal non-working example:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
import Data.Maybe
import Data.Proxy
import GHC.TypeLits
import Numeric.Natural
data AnyNat (n :: Nat) where
AN :: AnyNat n
data AtLeast1Nat (n :: Nat) where
AL1N :: AtLeast1Nat n
promote0 :: Natural -> AnyNat n
promote0 k = case sn of
SomeNat (_ :: Proxy p) -> AN
where
sn = (fromJust . someNatVal . toInteger) k
promote1 :: (KnownNat n, 1 <= n) => Natural -> AtLeast1Nat n
promote1 k = case sn of
SomeNat (_ :: Proxy p) -> AL1N
where
sn = (fromJust . someNatVal . toInteger) k
main :: IO ()
main = do nat_in <- getLine
let nat = read nat_in :: Natural
let p0 = promote0 nat
let p1 = promote1 nat
putStrLn "Last statement must be an expression"
This produces this error (full error here, but this is the relevant part):
* Couldn't match type `1 <=? n0' with 'True
arising from a use of `promote1'
The type variable `n0' is ambiguous
Honestly, this isn't too surprising and I (think I) do understand why this happens. The Natural that we give in could be any of them, so why would we be able to derive that 1 <= n? That's why it works fine for promote0 and not promote1.
My question is hence, is there any way to also check (and propagate to type-level) this information so I can use it as intended, or am I using the wrong approach here?
You're using the wrong approach.
As discussed in the comments, promote0 (and similarly promote1) isn't doing what you're hoping. The problem is that the AN on the right-hand-side of the case has type AnyNat n for some n entirely unrelated to the term sn. You could have written:
promote0 k = case 2+2 of 4 -> AN
and gotten much the same effect. Note the critical difference between your code and the other Stack Overflow answer you link: in that answer, the type variable n in the case scrutinee is used to type something (via ScopedTypeVariables) in the case branch. You bind a type variable p in your scrutinee but then don't use it for anything.
If we consider your actual problem, suppose we want to write something like this:
import qualified Data.Vector.Sized as V
main = do
n <- readLn :: IO Int
let Just v = V.fromList (replicate n 1)
v2 = v V.++ v
print $ v2
This won't type check. It gives an error on V.fromList about the lack of a KnownNat constraint. The issue is that v has been assigned a type S.Vector k Int for some k :: Nat. But V.fromList performs a runtime check that the length of the input list (the run time value n) is equal to the type-level k. To do this, k must be converted to a runtime integer which requires KnownNat k.
The general solution, as you've guessed, is to construct a SomeNat that basically contains a KnownNat n => n that's unknown at compile time. However, you don't want to try to promote it to a known type-level Nat (i.e., you don't want promote0). You want to leave it as-is and case match on it at the point you need its type-level value. That type-level value will be available within the case but unavailable outside the case, so no types that depend on n can "escape" the case statement.
So, for example, you can write:
import qualified Data.Vector.Sized as V
import Data.Proxy
import GHC.TypeNats
main = do
n <- readLn :: IO Int
-- keep `sn` as the type-level representation of the runtime `n`
let sn = someNatVal (fromIntegral n)
-- scrutinize it when you need its value at type level
case sn of
-- bind the contained Nat to the type variable `n`
SomeNat (Proxy :: Proxy n) -> do
-- now it's available at the type level
let v = V.replicate #n 1 -- using type-level "n"
v2 = v V.++ v
print v2
but you can't write:
main :: IO ()
main = do
n <- readLn :: IO Int
let sn = someNatVal (fromIntegral n)
let v2 = case sn of
SomeNat (Proxy :: Proxy n) ->
let v = V.replicate #n 1
in v V.++ v
print v2
You'll get an error that a type variable is escaping its scope. (If you want to let sized vectors leak outside the case, you need to make use of V.SomeSized or something similar.)
As for the main part of your question about handling a 1 <= n constraint, dealing with inequalities for type-level naturals is a major headache. I think you'll need to post a minimal example of exactly how you want to use this constraint in the context of a sized vector imlementation, in order to get a decent answer.
Suppose I have a function f :: String -> String and want to match arguments of the form
_ ++ "bar"
where _ is an unspecified string that I would like to return. In other words, I want to match arguments like foobar and bazbar and return foo and baz respectively.
Using ViewPatterns this is possible as follows:
{-# LANGUAGE ViewPatterns #-}
f :: String -> String
f x#(reverse . take 3 $ reverse -> "bar") = take (n-3) x
where n = length x
...but this is far from ideal. Mainly because things will get hairy very quickly if I decide that I want to combine two or more such patterns.
Ideally, I want something to be able to write something like this:
f (x:"bar") = x
but unfortunately this is not valid Haskell.
Is there an adequate solution in ViewPatterns or another extension?
On built-in String, this is a very bad idea, since your pattern match turns out to be quite expensive. On other string types, like Text or ByteString, you can use pattern guards:
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.Text as T
f :: Text -> Text
f x | Just x' <- T.stripSuffix "bar" x = ...
Or with ViewPatterns (of which I am less fond):
{-# LANGUAGE OverloadedStrings, ViewPatterns #-}
import qualified Data.Text as T
f :: Text -> Text
f (T.stripSuffix "bar" -> Just x') = ...
stripSuffix :: (Eq a) => [a] -> [a] -> Maybe [a]
stripSuffix needle = go <*> drop (length needle)
where
go xs [] = if xs == needle then Just [] else Nothing
go (x:xs) (_:ys) = (x:) <$> go xs ys
f (stripSuffix "bar" -> Just pref) = pref
I haven't tested it too much but this is a simple solution that doesn't bring in extra machinery of regexs / parsers.
Don't do it with pattern matching. Pattern matches are typically cheap and match the structure of the input data. This is a very expensive pattern written as if it were very cheap to compute. If you want to do this, write it as a guard clause, where you can make it clear exactly what's happening.
This is almost possible with TemplateHaskell - someone more experienced with it could improve on this answer.
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
(+++) :: Q Pat -> String -> Q Pat
x +++ y = [p| ((\string -> splitAt (length string - length y) string) -> (x, $literal_pattern)) |]
where literal_pattern = returnQ (LitP (StringL y))
This is usable in the pattern position, and you can pass in a pattern as the first argument using TemplateHaskell's quasiquoting:
f $([p|x|] +++ "bar") = x
Rather annoyingly, I can't find any explanation of how you can pass a pattern to a TemplateHaskell splice any more succintly than this.
In the following code
module Main where
import Control.Monad.State
import Control.Applicative
type Code = String
toSth :: Read a => State [Code] a
toSth = state $ \(c:cs) -> ((read c), cs)
codes = ["12", "True", ""]
data Tick = Tick {n :: Int, bid :: Bool} deriving (Show)
res = runState (pure Tick <*> toSth <*> toSth) codes
main = print res
I get the correct results
(Tick {n = 12, bid = True},[""])
But my problem is with the repetition of
pure Tick <*> toSth <*> toSth
I.e., if the record has 100 fields, then I have to write <*> toSth 100 times, which does not look Haskell.
Is there a way to foldl on <*>? I know the standard foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b won't work here, because the accumulator type changes in each iteration.
Thanks a lot!
This can be done with some advanced generics libraries, like generics-sop.
Generics libraries translate datatypes from and to some kind of "uniform" representation. The libraries also provide functions to create or modify such representation. We can work over the representation and afterwards transform back into the original datatype.
{-# language DeriveGeneric, TypeApplications #-}
import qualified GHC.Generics
import Generics.SOP (Generic,to,SOP(SOP),NS(Z),hsequence,hcpure)
import Data.Proxy
data Tick = Tick {n :: Int, bid :: Bool} deriving (Show,GHC.Generics.Generic)
instance Generic Tick -- this Generic is from generics-sop
res :: (Tick, [Code])
res =
let tickAction :: State [Code] Tick
tickAction = to . SOP . Z <$> hsequence (hcpure (Proxy #Read) toSth)
in runState tickAction codes
hcpure creates an n-ary product out of an effectful function (here toSth) that knows how to create every member of the product. We have to pass a Proxy with the constraint to convince the compiler. The result is a product where each component is wrapped in State.
hsequence is like sequenceA but for n-ary products having different types for each component. The result is similar: the Applicative is "pulled outwards".
SOP and Z are constructors that wrap the product and let us call to to get a value of the original Tick type.
res could be given this more general signature to work over any single-constructor record that is an instance of Generics.SOP.Generic:
{-# language DataKinds #-}
res :: (Generic r, Generics.SOP.Code r ~ '[ xs ], Generics.SOP.All Read xs) => (r,[Code])
res =
let tickAction = to . SOP . Z <$> hsequence (hcpure (Proxy #Read) toSth)
in runState tickAction codes
I'm trying to define a function that detects whether the type of an input satisfies a given constraint:
satisfies :: (c a => a -> b) -> a -> Maybe b
-- or the more general
claim :: (c => a) -> Maybe a
So the desired behaviour would be:
>>> :t satisfies #Show show
satisfies #Show show :: a -> Maybe String
>>> satisfies #Show show (0 :: Int)
Just "0"
>>> satisfies #Show show (id :: Int -> Int)
Nothing
The goal is to make it easy to define fully polymorphic functions that take
advantage of specializations when possible:
showAny :: a -> String
showAny (satisfies #Show show -> Just str) = str
showAny (satisfies #Typeable showType -> Just str) = "_ :: " ++ str
showAny _ = "_"
As the easiest thing I could try, my first attempt tried using -fdefer-to-runtime
{-# OPTIONS_GHC -fdefer-type-errors -Wno-deferred-type-errors #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RankNTypes #-}
module Claim where
import System.IO.Unsafe (unsafePerformIO)
import System.IO.Error (catchIOError)
satisfies :: (c a => a -> b) -> a -> Maybe b
satisfies f a = unsafePerformIO $
(return . Just $! f a) `catchIOError` \_ -> return Nothing
This failed because -fdefer-type-errors doesn't defer the checking to
runtime, or allow further checking to be done in the context which it is
actually used (as I had hoped), but instead at compile time replaces found
type errors with the equivalent of error "MESSAGE".
Now I'm out of ideas. Is implementing satisfies even possible?
You can't dispatch on instance availability at runtime. Remember, a constraint is translated by the compiler into a type class dictionary - a record of functions that is passed around explicitly and accessed explicitly at runtime. The "fat arrow" => is represented at runtime by a "thin arrow" ->, so the elaborator needs to know at compile time which dictionary to pass around.
That is, the following crude example:
class Show a where
show :: a -> String
instance Show String where
show = id
showTwice :: Show a => a -> String
showTwice x = show x ++ show x
main = putStrLn $ showTwice "foo"
generates Core code which looks approximately like:
data Show_ a = Show_ { show :: a -> String }
showString_ :: Show_ String
showString_ = Show_ { show = id }
showTwice :: Show_ a -> a -> String
showTwice show_ x = show show_ x ++ show show_ x
main = putStrLn $ showTwice showString_ "foo"
When generating code for main, the compiler needs to know where to find showString_.
You can imagine a system wherein you can look up a type class dictionary at runtime with some sort of introspection mechanism, but this would produce weird behaviour from a language design perspective. The problem is orphan instances. If I write a function which attempts to look up a given instance in module A, and define such an instance in an unrelated module B, then the behaviour of that function when called from some client module C depends on whether B was imported by some other part of the program. Pretty strange!
A more usual way of doing "fully polymorphic functions that take advantage of specializations when possible" would be to put the function in question into a type class itself and give it a default implementation (perhaps with a default signature if the default implementation depends on some superclass). Your showAny would then look like this:
{-# LANGUAGE DefaultSignatures #-}
import Data.Typeable
class ShowAny a where
showAny :: a -> String
default showAny :: Typeable a => a -> String
showAny x = "_ :: " ++ show (typeOf x)
You'd need to implement ShowAny for all of the types with which you want to use showAny, but that's usually a single line of code,
instance (Typeable a, Typeable b) => ShowAny (a -> b)
and you can specialise an implementation for a given type just by overriding showAny.
instance ShowAny String where
showAny = id
You see this approach quite frequently in libraries which do generic programming. aeson, for example, can use GHC.Generics to serialise a given type to and from JSON (all you have to do is derive Generic and write two lines instance ToJSON MyType; instance FromJSON MyType), but you can also write your own instances of ToJSON and FromJSON if the generic code isn't fast enough or you need to customise the output.
An alternate workaround to the accepted answer is to pass the dictionaries around manually.
That is, given:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
module Claim where
data Proof c where QED :: c => Proof c
type Claim c = Maybe (Proof c)
type c ? a = Maybe (Proof (c a))
One can write:
showAny :: (Show? a, Typeable? a) -> a -> String
showAny (Just QED, _) a = show a
showAny (_, Just QED) a = "_ :: " ++ showType a
showAny _ _ = "_"
Which works accepably well:
>>> showAny (Nothing, Just QED) (id :: Int -> Int)
"_ :: Int -> Int"
>>> showAny (Just QED, Just QED) (0 :: Int)
"0"
>>> showAny (Nothing, Nothing) undefined
"_"
Suppose I have
data Foo = A String Int | B Int
I want to take an xs :: [Foo] and sort it such that all the As are at the beginning, sorted by their strings, but with the ints in the order they appeared in the list, and then have all the Bs at the end, in the same order they appeared.
In particular, I want to create a new list containg the first A of each string and the first B.
I did this by defining a function taking Foos to (Int, String)s and using sortBy and groupBy.
Is there a cleaner way to do this? Preferably one that generalizes to at least 10 constructors.
Typeable, maybe? Something else that's nicer?
EDIT: This is used for processing a list of Foos that is used elsewhere. There is already an Ord instance which is the normal ordering.
You can use
sortBy (comparing foo)
where foo is a function that extracts the interesting parts into something comparable (e.g. Ints).
In the example, since you want the As sorted by their Strings, a mapping to Int with the desired properties would be too complicated, so we use a compound target type.
foo (A s _) = (0,s)
foo (B _) = (1,"")
would be a possible helper. This is more or less equivalent to Tikhon Jelvis' suggestion, but it leaves space for the natural Ord instance.
To make it easier to build comparison function for ADTs with large number of constructors, you can map values to their constructor index with SYB:
{-# LANGUAGE DeriveDataTypeable #-}
import Data.Generics
data Foo = A String Int | B Int deriving (Show, Eq, Typeable, Data)
cIndex :: Data a => a -> Int
cIndex = constrIndex . toConstr
Example:
*Main Data.Generics> cIndex $ A "foo" 42
1
*Main Data.Generics> cIndex $ B 0
2
Edit:After re-reading your question, I think the best option is to make Foo an instance of Ord. I do not think there is any way to do this automatically that will act the way you want (just using deriving will create different behavior).
Once Foo is an instance of Ord, you can just use sort from Data.List.
In your exact example, you can do something like this:
data Foo = A String Int | B Int deriving (Eq)
instance Ord Foo where
(A _ _) <= (B _) = True
(A s _) <= (A s' _) = s <= s'
(B _) <= (B _) = True
When something is an instance of Ord, it means the data type has some ordering. Once we know how to order something, we can use a bunch of existing functions (like sort) on it and it will behave how you want. Anything in Ord has to be part of Eq, which is what the deriving (Eq) bit does automatically.
You can also derive Ord. However, the behavior will not be exactly what you want--it will order by all of the fields if it has to (e.g. it will put As with the same string in order by their integers).
Further edit: I was thinking about it some more and realized my solution is probably semantically wrong.
An Ord instance is a statement about your whole data type. For example, I'm saying that Bs are always equal with each other when the derived Eq instance says otherwise.
If the data your representing always behaves like this (that is, Bs are all equal and As with the same string are all equal) then an Ord instance makes sense. Otherwise, you should not actually do this.
However, you can do something almost exactly like this: write your own special compare function (Foo -> Foo -> Ordering) that encapsulates exactly what you want to do then use sortBy. This properly codifies that your particular sorting is special rather than the natural ordering of the data type.
You could use some template haskell to fill in the missing transitive cases. The mkTransitiveLt creates the transitive closure of the given cases (if you order them least to greatest). This gives you a working less-than, which can be turned into a function that returns an Ordering.
{-# LANGUAGE TemplateHaskell #-}
import MkTransitiveLt
import Data.List (sortBy)
data Foo = A String Int | B Int | C | D | E deriving(Show)
cmp a b = $(mkTransitiveLt [|
case (a, b) of
(A _ _, B _) -> True
(B _, C) -> True
(C, D) -> True
(D, E) -> True
(A s _, A s' _) -> s < s'
otherwise -> False|])
lt2Ord f a b =
case (f a b, f b a) of
(True, _) -> LT
(_, True) -> GT
otherwise -> EQ
main = print $ sortBy (lt2Ord cmp) [A "Z" 1, A "A" 1, B 1, A "A" 0, C]
Generates:
[A "A" 1,A "A" 0,A "Z" 1,B 1,C]
mkTransitiveLt must be defined in a separate module:
module MkTransitiveLt (mkTransitiveLt)
where
import Language.Haskell.TH
mkTransitiveLt :: ExpQ -> ExpQ
mkTransitiveLt eq = do
CaseE e ms <- eq
return . CaseE e . reverse . foldl go [] $ ms
where
go ms m#(Match (TupP [a, b]) body decls) = (m:ms) ++
[Match (TupP [x, b]) body decls | Match (TupP [x, y]) _ _ <- ms, y == a]
go ms m = m:ms