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
Related
Not sure if I'm phrasing the question correctly in the title but I'm trying to do something like this:
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
module Lib where
import Control.Lens
data Foo = Foo {_bar1 :: Int
,_bar2 :: String
,_bar3 :: [Rational]} deriving (Show, Eq)
makeFieldsNoPrefix ''Foo
aFoo :: Foo
aFoo = Foo 33 "Hm?" [1/6,1/7,1/8]
stringToLens :: (HasBar1 s a, Functor f, HasBar2 s a, HasBar3 s a) => String -> Maybe ((a -> f a) -> s -> f s)
stringToLens str = case str of
"bar1" -> Just bar1
"bar2" -> Just bar2
"bar3" -> Just bar3
_ -> Nothing
updateFoo :: (HasBar1 a1 a2, HasBar2 a1 a2, HasBar3 a1 a2, Read a2) => String -> String -> a1 -> Maybe a1
updateFoo lensStr valStr myFoo = case stringToLens lensStr of
Just aLens -> Just $ set aLens (read valStr) myFoo
Nothing -> Nothing
newFoo :: Maybe Foo
newFoo = updateFoo "bar1" 22 aFoo
{--
Couldn't match type ‘[Char]’ with ‘Int’
arising from a functional dependency between:
constraint ‘HasBar2 Foo Int’ arising from a use of ‘updateFoo’
instance ‘HasBar2 Foo String’
at /home/gnumonic/Haskell/Test/test/src/Lib.hs:14:1-24
• In the expression: updateFoo "bar1" 22 aFoo
In an equation for ‘newFoo’: newFoo = updateFoo "bar1" 22 aFoo
--}
(Ignore the use of read here, I do it the "right way" in the actual module I'm working on.)
That, obviously, doesn't work. I thought that making a typeclass along the lines of this might work:
class OfFoo s a where
ofFoo :: s -> a
instance OfFoo Foo Int where
ofFoo foo = foo ^. bar1
instance OfFoo Foo String where
ofFoo foo = foo ^. bar2
instance OfFoo Foo [Rational] where
ofFoo foo = foo ^. bar3
But there doesn't seem to be a way of adding that class to the constraint in such a way that the stringToLens function is actually usable, even though it typechecks fine until I try to use it. (Although it doesn't even typecheck if I use makeLenses instead of makeFields, and I'm not really sure why.)
E.g. (with the maybe removed for simplicity):
stringToLens :: (HasBar1 s a, Functor f, HasBar2 s a, HasBar3 s a, OfFoo s a) => String -> (a -> f a) -> s -> f s
stringToLens str = case str of
"bar1" -> bar1
"bar2" -> bar2
"bar3" -> bar3
That typechecks but is pretty much useless, since any attempt to apply the function throws the functional dependency error.
I also tried using the Reified newtypes from Control.Lens.Reify, but that didn't fix the functional dependency issue.
What I can't figure out is that if I modify the updateFoo like so:
updateFoo2 :: Read a => ASetter Foo Foo a a -> String -> Foo -> Foo
updateFoo2 aLens val myFoo = set aLens (read val) myFoo
Then this works:
testFunc :: Foo
testFunc = updateFoo2 bar1 "22" aFoo
But this throws the functional dependency error at myLens1 whenever it's used (although the definition typechecks):
testFunc' :: Foo
testFunc' = updateFoo2 (stringToLens "bar1") 22 aFoo -- Error on (stringToLens "bar1")
myLens1 :: (HasBar1 s a, Functor f, HasBar2 s a, HasBar3 s a, OfFoo s a) => (a -> f a) -> s -> f s
myLens1 = stringToLens "bar1" -- typechecks
testFunc2 :: Foo
testFunc2 = updateFoo2 myLens1 "22" aFoo -- Error on myLens1
So I can define a stringToLens function, but it's pretty much useless...
Unfortunately I wrote a bunch of code on the assumption that something like this could be made to work. I'm writing a packet generator, and if I can get this to work then I have a pretty convenient way of quickly adding support for new protocols. (The rest of my code extensively uses lenses for a variety of purposes.) I can think of a few workarounds but they're all extremely verbose and require either a lot of template Haskell (to generate a copy of every function for each new protocol data type) or a lot of boilerplate (i.e. creating dummy types to signal the correct type for read in the updateFoo functions).
Is there any way to do what I'm trying to do here with lenses, or is it just impossible without something like impredicative types? If not, is there a better workaround the the one's I'm seeing?
At this point my best guess is that there's just not enough information for the compiler to infer the type of the value string without having a fully evaluated lens.
But it seems like something along these lines should be possible, since by the time the output of stringToLens is passed to updateFoo, it will have a definite (and correct) type. So I'm stumped.
Implementing stringToLens would require something like dependent types, because the type of the resulting Lens depends on an argument's value: the field name. Haskell doesn't have full dependent types, although they can be emulated with more or less difficulty.
In updateFoo, you take as parameter both the field name (lensStr) and the "serialized" form of the field's value (valStr), and return an update function for some datatype. Can we have that without getting dependent-ish?
Imagine that, for a certain type Foo, you had something like a Map FieldName (String -> Maybe (Foo -> Foo)). For each field name, you would have a function that parsed the field's value and, if successful, returned an update function for Foo. No dependent types would be required, as the parsing of each field's value would be hidden behind functions with a uniform signature.
How to build such map-of-parsers-returning-updaters for a given type? You could build it manually, or it could be derived with the help of some generics wizardry.
Here's a possible implementation based on the red-black-record library (although it would be better to base it on the more established generics-sop). Some preliminary imports:
{-# LANGUAGE DeriveGeneric, FlexibleContexts, FlexibleInstances, #-}
{-# LANGUAGE TypeApplications, TypeFamilies, TypeOperators, ScopedTypeVariables #-}
import qualified Data.Map.Strict as Map
import Data.Map.Strict
import Data.Monoid (Endo (..))
import Data.Proxy
import Data.RBR
( (:.:) (Comp),
And,
Case (..),
FromRecord (fromRecord),
I (..),
IsRecordType,
K (..),
KeyValueConstraints,
KeysValuesAll,
Maplike,
Record,
ToRecord (toRecord),
collapse'_Record,
cpure'_Record,
injections_Record,
liftA2_Record,
unI,
)
import GHC.Generics (Generic)
import GHC.TypeLits
The implementation itself:
type FieldName = String
type TextInput = String
makeUpdaters ::
forall r c.
( IsRecordType r c, -- Is r convertible to the rep used by red-black-record?
Maplike c, -- Required for certain applicative-like operations over the rep.
KeysValuesAll (KeyValueConstraints KnownSymbol Read) c -- Are all fields readable?
) =>
Proxy r ->
Map FieldName (TextInput -> Maybe (r -> r))
makeUpdaters _ =
let parserForField :: forall v. Read v
=> FieldName -> ((,) FieldName :.: (->) TextInput :.: Maybe) v
parserForField fieldName = Comp (fieldName, Comp read)
parserRecord = cpure'_Record (Proxy #Read) parserForField
injectParseResult ::
forall c a.
Case I (Endo (Record I c)) a -> -- injection into the record
((,) FieldName :.: (->) TextInput :.: Maybe) a -> -- parsing function
(FieldName, Case I (Maybe (Endo (Record I c))) TextInput)
injectParseResult (Case makeUpdater) (Comp (fieldName, Comp readFunc)) =
( fieldName,
( Case $ \textInput ->
let parsedFieldValue = readFunc . unI $ textInput
in case parsedFieldValue of
Just x -> Just $ makeUpdater . pure $ x
Nothing -> Nothing ) )
collapsed :: [(FieldName, Case I (Maybe (Endo (Record I c))) TextInput)]
collapsed = collapse'_Record $
liftA2_Record
(\injection parser -> K [injectParseResult injection parser])
injections_Record
parserRecord
toFunction :: Case I (Maybe (Endo (Record I c))) TextInput
-> TextInput -> Maybe (r -> r)
toFunction (Case f) textInput = case f $ I textInput of
Just (Endo endo) -> Just $ fromRecord . endo . toRecord
Nothing -> Nothing
in toFunction <$> Map.fromList collapsed
A type in which to test it:
data Person = Person {name :: String, age :: Int} deriving (Generic, Show)
-- let updaters = makeUpdaters (Proxy #Person)
--
instance ToRecord Person
instance FromRecord Person
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 am using makeFields from lens to generate fields overloaded for various structures. I would like to use these fields at one with multiple structures while having to state which field I want to use only once. It would look like this:
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
import Control.Lens
data A = A
{ _aX :: String
, _aY :: String
}
makeFields ''A
data B = B
{ _bX :: String -> Char
, _bY :: String -> Bool
}
makeFields ''B
-- x can get _aX from an A and _bX from a B
a :: A
a = undefined
b :: B
b = undefined
q :: (Getter A String) AND (Getter B (String -> a)) -> a
q lens = (b^.lens) (a^.lens)
Which type should I give q? I tried letting GHC infer the types, but that failed.
To decide what is to be done, we need to know what the types of your (makeField-generated) fields are:
GHCi> :t x
x :: (HasX s a, Functor f) => (a -> f a) -> s -> f s
So the abstraction covering all your x-bearing types (the abstraction I was whining about before noticing you were using makeFields) is a multi-parameter type class HasX, and similarly for the other fields. That gives us enough to use x with different types in a single implementation:
-- Additional extension required: FlexibleContexts
-- Note that GHC is able to infer this type.
qx :: (HasX t (a -> b), HasX s a) => t -> s -> b
qx t s = (t ^. x) (s ^. x)
GHCi> import Data.Maybe
GHCi> let testA = A "foo" "bar"
GHCi> let testB = B (fromMaybe 'ø' . listToMaybe) null
GHCi> qx testB testA
'f'
That, however, is not quite what you asked for. You wanted something like:
q xOrY b a = (b^.xOrY) (a^.xOrY)
Achieving that, however, requires abstracting over the classes HasX, HasY, etc. Doing so is, in fact, somewhat feasible thanks to the ConstraintKinds extension, as demonstrated in Could we abstract over type classes? Here it goes:
-- Additional extensions required: ConstraintKinds, ScopedTypeVariables
-- Additional import required: Data.Proxy
-- GHC cannot infer this type.
q :: forall h s t a b. (h t (a -> b), h s a) => Proxy a -> Proxy h
-> (forall u c. h u c => Getting c u c) -> t -> s -> b
q _ _ l t s =
(t ^. (l :: Getting (a -> b) t (a -> b))) (s ^. (l :: Getting a s a))
GHCi> q (Proxy :: Proxy String) (Proxy :: Proxy HasX) x testB testA
'f'
The first proxy, which determines the intermediate type, is necessary unless you give up this bit of generality and replace a by String. Additionally, you have to specify the field twice, both by passing the getter as an argument and through the second proxy. I am not at all convinced that this second solution is worth the trouble -- the extra boilerplate of having to define qx, qy, etc. looks quite a bit less painful than all the circuitousness involved here. Still, if any of you who are reading this would like to suggest an improvement, I'm all ears.
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.
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