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