Given the code below which looks up type-specific information in Data.HashMap for a type, is it possible to define a new function getMapVal2 as documented in the comments, to build the TypeKey argument given the type?
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
import Data.Monoid ((<>))
import Data.Proxy (Proxy(Proxy))
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import qualified Data.HashMap.Strict as Map (HashMap, empty, insert, lookup)
import Data.Dynamic
import GHC.Generics
import Data.Maybe (fromJust, isNothing, maybe)
type family TypeKey (a :: *) :: Symbol where
TypeKey Int = "int"
TypeKey T = "trec"
data T = T { aInt :: Int} deriving (Show, Generic, Typeable)
extract ::(s ~ TypeKey a, Typeable a, KnownSymbol s) => Maybe Dynamic -> Maybe a
extract dyn = if (isNothing dyn) then Nothing else fromDynamic . fromJust $ dyn
getMapVal :: (s ~ TypeKey a, Typeable a, KnownSymbol s) => Map.HashMap String Dynamic -> String -> Maybe a
getMapVal m k = extract $ Map.lookup k m
{-- How do we get the TypeKey lookup for type a?
getMapVal2 :: (s ~ TypeKey a, Typeable a, KnownSymbol s) => Map.HashMap String Dynamic -> a -> Maybe a
getMapVal2 m ty = extract $ Map.lookup (symbolVal (Proxy :: Proxy (TypeKey ???))) m
--}
main = do
let map = Map.insert (symbolVal (Proxy :: Proxy (TypeKey T))) (toDyn $ T {aInt=5}) Map.empty -- we insert some value in hashmap for type T - it is of same type
val = getMapVal map (symbolVal (Proxy :: Proxy (TypeKey T))) :: Maybe T -- now let us retrieve the value in map for Type T. We pass the SymbolVal ourselves
--val = getMapVal2 map (T {aInt = 2}) -- now we want to lookup map value given something of a type T. Need getMapVal2 to build symbolval given the input type
print $ maybe "" show val -- prints value stored in Hashmap for type T which is: T {aInt=5}
This is just a toy code to test passing type specific configuration at run-time via Data.HashMap to a polymorphic function that acts on types of a typeclass.
Use the ScopedTypeVariables extension. This allows you to refer to forall-bound type variables in the body of the definition in which they are bound.
{-# LANGUAGE ScopedTypeVariables #-}
getMapVal2 :: forall a s. (s ~ TypeKey a, Typeable a, KnownSymbol s) => Map.HashMap String Dynamic -> a -> Maybe a
getMapVal2 m ty = extract $ Map.lookup (symbolVal (Proxy :: Proxy (TypeKey a))) m
Related
I'm using GHC 9.2.2 and playing with OverloadedRecordDot and generic-lens. As an experiment, I want to use the overloaded dot as a "frontend" to the generic-lens functionality (including type-changing update).
I have these auxiliary definitions:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedRecordDot #-}
import Control.Lens ( (&), (.~), Lens )
import Data.Generics.Product.Fields qualified as G
import GHC.Records (HasField (..))
import GHC.TypeLits (Symbol)
import GHC.Generics (Generic)
-- Basically a 'Control.Lens.Reified.ReifiedLens'.
newtype Lensy s t a b = Lensy (Lens s t a b)
pry :: Lensy s t a b -> Lens s t a b
pry (Lensy l) = l
-- Just a dummy starting point for applying the overloaded dot.
data The s t = The
the :: s -> t -> The s t -- the parameters are just to guide type inference
the s t = The
-- This GHC.Records.HasField instance produces lenses, not values.
-- It piggybacks on Data.Generics.Product.Fields.HasField.
instance G.HasField (field :: Symbol) s t a b
=> HasField field (The s t) (Lensy s t a b) where
getField _ = Lensy (G.field #field)
And this example datatype taken from Data.Generics.Product.Fields:
data Human a
= Human
{ name :: String
, address :: String
, other :: a
}
| HumanNoAddress
{ name :: String
, other :: a
}
deriving (Generic, Show)
human :: Human Bool
human = Human { name = "Tunyasz", address = "London", other = False }
Putting my helpers to work, this compiles (don't mind the awful verbosity):
human' :: Human Int
human' = human & pry (the human human').other .~ (42 :: Int)
Passing undefineds as arguments to the the also compiles:
human' :: Human Int
human' = human & pry (the undefined undefined).other .~ (42 :: Int)
Ok, they seem to be unnecessary. Let's get rid of those parameters to the, then:
-- Just a dummy starting point for applying the overloaded dot.
data The s t = The
the :: The s t
the = The
human' :: Human Int
human' = human & pry the.other .~ (42 :: Int)
Alas, this doesn't compile:
* Ambiguous type variables `s0', `t0',
`a0' arising from selecting the field `other'
prevents the constraint `(HasField
"other"
(The s0 t0)
(Lensy (Human Bool) (Human Int) a0 Int))' from being solved.
How to make the parameterless version of the compile?
Unwitting kind polymorphism strikes again.
ghci> :t the
the :: forall {k1} {k2} (s :: k1) (t :: k2). The s t
It was sufficient to add a kind signature to The:
{-# LANGUAGE KindSignatures #-}
import Data.Kind ( Type )
type The :: Type -> Type -> Type
data The s t = The
And the signature of the becomes:
ghci> :t the
the :: forall s t. The s t
My aim is to write function that takes some polymorphic values and list with typereps representing concrete types. It returns new list with the same values but already casted to concrete types specified via typereps.
Let we have such list of values: ["one", "two"] with -XOverloadedStrings enabled.
Respectively, type of each one is IsString a => a.
List of typereps we could get in such way:
import Data.Typeable (Proxy(..), typeRep)
import Data.Text (Text)
[typeRep (Proxy :: Proxy String), typeRep (Proxy :: Proxy ByteString)]
Is there any way to get "one" of type String and "two" of type ByteString?
P.S. To prevent error according to list containing values of different types, we may wrap every value in Dynamic., as in the example below(pseudocode):
{-# LANGUAGE ParallelListComp #-}
import Data.Dynamic (toDyn)
[ toDyn (val :: type') | val <- vals | type' <- concreteTypes ]
It could be done using Template Haskell, but it will be too ugly.
I can't really imagine your purpose, but the code will probably look something like this. I'm using the new Type.Reflection interface because I'm more familiar with it than with the classic Data.Typeable, but that should work for this too.
import Type.Reflection
types :: [SomeTypeRep]
types = [SomeTypeRep (typeRep #String), SomeTypeRep (typeRep #Text)]
strings :: [String]
strings = ["one", "two"]
converted :: [Dynamic]
converted = fromJust $ zipWithM convert types strings
convert :: SomeTypeRep -> String -> Maybe Dynamic
convert (SomeTypeRep rep) s
| Just HRefl <- eqTypeRep rep (typeRep #String) = Just $ toDynamic s
| Just HRefl <- eqTypeRep rep (typeRep #Text) = Just $ toDynamic (fromString s)
| otherwise = Nothing
Hold my beer.
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE OverloadedStrings #-}
import Data.ByteString (ByteString)
import Data.String
import Data.Text (Text)
data Forall c where Forall :: (forall a. c a => a) -> Forall c
data Exists c where Exists :: c a => a -> Exists c
data Evidence c where Evidence :: c a => proxy a -> Evidence c
instance c ~ IsString => IsString (Forall c) where
fromString s = Forall (fromString s)
asProxyType :: proxy a -> a -> a
asProxyType = const id
downcast :: Evidence c -> Forall c -> Exists c
downcast (Evidence proxy) (Forall v) = Exists (asProxyType proxy v)
polymorphicStrings :: c ~ IsString => [Forall c]
polymorphicStrings = ["one", "two"]
types :: c ~ IsString => [Evidence c]
types = [Evidence ([] :: [ByteString]), Evidence ([] :: [Text])]
monomorphicStrings :: c ~ IsString => [Exists c]
monomorphicStrings = zipWith downcast types polymorphicStrings
To connect with the question as asked: Exists Typeable is isomorphic to Dynamic. You might need to generalize Forall, Exists :: Constraint -> * to Forall, Exists :: [Constraint] -> * to comfortably support both IsString and Typeable at once, which is a bit of type-level hacking but nothing too strenuous. Type families can give you an Elem :: Constraint -> [Constraint] -> Bool which can be used to replace c ~ IsString everywhere above.
I have an extensible Vinyl / Composite record (similar to HList, Frames...), and I would like to generate the tuples of keys/values, such as
tuplify '[String :-> Whatevs, ...] :: [(String, String)]
This is surprisingly hard. original gist.
Solution Gist, thanks to Alec below
type FA = "a" :-> String
type FB = "b" :-> Int
type AB = '[FA, FB]
ab :: Rec Identity AB
ab = "A" :*: 1 :*: RNil
tuplify :: (Show a) => Rec Identity '[a] -> [(String, String)]
tuplify = recordToList . rmap undefined -- ??????
-- tuplify ab = [("a", "A"), ("b", "1")]
If you care to try out what I've done so far, check out that gist, and it has well-thought-out examples and the errors I see:
Here is the hardware for refying in Composite (reifyDicts):
And the same for Vinyl (reifyConstraints):
AFAICT, the problem is that in something like rmap:
rmap :: (forall x. f x -> g x) -> Rec f rs -> Rec g rs
The mapped fn is defined forall x, but my tuplify is constrained, and I think the reification should move the constraint into the type (that's what Dicts are for), but, alas, no luck so far.
I can't get composite related stuff to install on my global Stack setup but the following should still work (I just copy-pasted relevant definitions). That said, I think a simple type-class based dispatch based on type is simpler here (since the constraints are non-trivial). With all of the right extensions enabled [1], you just need:
class Tuplify a where
tuplify :: a -> [(String, String)]
instance Tuplify (Rec Identity '[]) where
tuplify RNil = []
instance (Show t, KnownSymbol s, Tuplify (Rec Identity rs)) =>
Tuplify (Rec Identity (s :-> t ': rs)) where
tuplify (v :*: rs) = (symbolVal (Proxy :: Proxy s), show v) : tuplify rs
Then, in GHCi:
ghci> tuplify ab
[("a","\"A\""),("b","1")]
If you really want to try the reifying constraint approach, you'll have to start by declaring a type class and instance for the particular constraint you want:
class ShowField a where
showField :: a -> (String, String)
instance (KnownSymbol s, Show a) => ShowField (Identity (s :-> a)) where
showField (Identity (Val v)) = (symbolVal (Proxy :: Proxy s), show v)
Then it becomes more straightforward to use reifyConstraints and rmap:
tuplify' :: RecAll Identity rs ShowField => Rec Identity rs -> [(String, String)]
tuplify' xs = recordToList
. rmap (\(Vinyl.Compose (Dict x)) -> Vinyl.Const $ showField x)
$ reifyConstraint (Proxy :: Proxy ShowField) xs
I imagine something similar is possible with reifyDicts, although I wish there was a variant of it defined using ValuesAllHave instead of just AllHave (then we could bypass declaring a ShowField typeclass and do everything in just a function).
[1] extensions needed for first example
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
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 want to use string literal as Traversal, but I am a bit lost in types.
Is it possible to create this instance?
import Control.Lens
import Data.Aeson
import Data.Aeson.Lens
import Data.String
import Data.Default
{- Having:
key' :: AsValue t => Text -> Traversal' t (Maybe Value)
_JSON :: (ToJSON a, FromJSON a) => Traversal' t a
-}
instance (AsValue t, FromJSON v, ToJSON v, Default v) => IsString (Traversal' t v) where
fromString k = key' (fromString k) . non (toJSON def) . _JSON
To achieve something like this inside State monad:
"some-key" .= (3 :: Int)
Problem with universally quantified type instances. Thanks!
I couldn't get your code to compile, but that shouldn't matter. I assume that you have a function of type
fromStringTraversal :: (AsValue t, FromJSON v, ToJSON v, Default v)
=> String -> Traversal' t v
fromStringTraversal = undefined
Then to write your instance, simply inline the definition of Traversal' into the instance head. This works because any type variables in an instance are universally quantified over implicitly anyways.
{-# LANGUAGE RankNTypes, FlexibleInstances, GADTs #-}
instance (a ~ a', b ~ b', AsValue b, Default a, FromJSON a, ToJSON a, Applicative f)
=> IsString ((a -> f a') -> b -> f b') where
fromString = fromStringTraversal
The a ~ a', b ~ b' constraints could be moved from the context to the instance head, but this way gives better type inference. Then
{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction #-}
-- Infered type:
-- test :: (AsValue s, MonadState s m) => m ()
test = "some-key" .= (3 :: Int)