{-# LANGUAGE AllowAmbiguousTypes, BlockArguments, DuplicateRecordFields, OverloadedLabels #-}
import Control.Monad.State (State, execState, modify)
import GHC.OverloadedLabels (IsLabel(..))
import GHC.Records (HasField(..))
setField :: HasField s a b => b -> a -> a
setField = error "wait for https://gitlab.haskell.org/ghc/ghc/-/issues/16232"
instance (HasField s a b, c ~ ()) => IsLabel s (State b () -> State a c) where
fromLabel inner = modify (setField @s =<< execState inner . getField @s)
newtype Setter a b = Setter { (.=) :: b -> State a () }
instance HasField s a b => IsLabel s (Setter a b) where
fromLabel = Setter (modify . setField @s)
(&~) :: a -> State a () -> a
(&~) = flip execState
data Country = Country {name :: String, company :: Company} deriving Show
data Company = Company {name :: String, boss :: Employee, car :: Car} deriving Show
data Employee = Employee {name :: String, age :: Integer, empCar :: Car} deriving Show
data Car = Car {name :: String} deriving Show
f :: Integer -> Country -> Country
f i r =
r &~ do
#company do
#boss do
#age .= i
#car do
#name .= "new"
#name .= "cmp"
#name .= "ccc"
The deluxe version (requires 9.6+) even allows you to write:
r &~ do
#company do
#"boss.age" .= i
#"car.name" .= "new"
#name .= "cmp"
#name .= "ccc"
Of course, there is the minor downside that neither actually works yet, but at least thereâs a plan for them to work at some point.
Iâm afraid the purpose of pointing to that video was lost on me. The guy drivelled on about Java something. If I wanted a decent record system I wouldnât be going to Java in the first place. So elm [I got this from the tutorial, not the talk] has records built over javascript records (same as purescript). elmers appear not to nest records, but I see no reason why they couldnât. Javanians do tend to nest records, but again I see no reason why they must.
Again, I didnât get this from the video, but talk of âdictionaryâ and âspineâ suggests a single indexible attribute. And the video seemed to navigate by a key. This is an even older (and also rejected) structure of database: âindexed-sequentialâ. Rejected because a single indexing path is too restrictive. The Relational Model approach is to store the âflatâ tuples separately from any consideration of paths to access it. One application might navigate from Country to Company to Employee, but another might navigate from Employee to Company. Either way round of nesting (as per o.p.) canât handle all the likely routes of navigation.
âThose who cannot remember the past are condemned to repeat it.â â George Santayana,
(OK, I donât suppose most round here are old enough to remember the âdatabase warsâ, but it might occur to you databases are pretty much as old as commercial IT; asking a question from âEmployee upâ rather than âCompany downâ pre-dates commercial IT â there were rolodex cards; possibly some people have thought about the challenges.)
infixl 4 &~
f :: Integer -> Country -> Country
f i r = r &~ #"company.boss.age" .= i
&~ #"company.car.name" .= "new car"
&~ #"company.name" .= "new company"
&~ #"name" .= "new country"
Looks nice! Instead of relying on OverloadedLabels and parsing the Symbols, an alternative to the deluxe version could repurpose OverloadedRecordDot in combination with two helper values with and the, to let you write something like
f :: Integer -> Country -> Country
f i r =
r &~ do
with.company do
the.boss.age .= i
the.car.name .= "new"
the.name .= "cmp"
the.name .= "ccc"
Similar, using lenses, which will work today - Lenses with OverloadedRecordDot With optics you can give every Optic a HasField fairly easily and avoid having the separate the thing, ironically bringing it back to how lens code looks (composition with .) at least for nested fields only.
Why not use a notation, similar to elm? It is a lot more human readable and is roughly as powerful as our current system. And it probably would still keep the door open for extensible/⌠Records.
Maybe I am alone on this but I dislike the reliance on lenses, arcane syntax and/or another use of do-notation. Why not a simple {a | b = c}, meaning the record a, where the field b has the value c.
(I know, there is a problem around Haskellâs records having a constructor opposed to elmâs, but that is probably a solvable issue)
In my opinion, once a typeclass like SetField exists, we should repurpose OverloadedRecordDot for setting, using techniques similar to the ones seen in this thread. I donât think overloading existing setting syntax, or adding new baked-in syntax, would be necessary.
OP said they were familiar with OverloadedRecordUpdate, but for everyone else, the simple syntax r { foo.bar = 1 } is already reserved and ready to use with an implementation of setField (which you can provide manually or wait for GHC to supply).
What Elm has that Haskell (98) doesnât is that it uses maps under the hood for record types and the fields are overloaded.
Elm has actually the same problem Iâm bringing up. And they donât have typeclasses or Template Elm. If they want to use elm-monocle they have to type the lens wiring by hand. The âofficial responseâ is that updating deeply nested records is an antipattern and all your data structures should be flat. Or hidden in modules with all the setter pipeline wiring hidden.
Yes I like elmâs notation. The difficulty introducing it into Haskell is backwards compatibility. Consider:
x = foo { a | b = c }
y = Bar { d | e = f }
For the first, the compiler seeing foo { ... } will think thatâs a record update to value foo. For the second, the compiler seeing Bar { ... } will think thatâs constructor Bar using record syntax â not Bar applied positionally to a single value, that happens to be a record update.
So the choice of notation will have to be module-wide and backwards-incompatible. All those Libraries (including Base/Prelude) will never change. So Haskellers will need to read both notations.
{-# LANGUAGE TemplateHaskell #-}
module Setter where
import Language.Haskell.TH
set :: [Name] -> Q Exp
set names = return $ LamE [VarP a, VarP r] (go names (VarE r))
where
a = mkName "a"
r = mkName "r"
go ns acc = case ns of
[n] -> RecUpdE acc [(n, VarE a)]
n : zs -> RecUpdE acc [(n, go zs (AppE (VarE n) acc))]
_ -> error "no fields?"
And the example.
Main.hs:
{-# LANGUAGE TemplateHaskell #-}
import Setter
data Country = Country { countryName :: String, countryCompany :: Company } deriving (Show)
data Company = Company { companyName :: String, companyBoss :: Employee, companyCar :: Car } deriving (Show)
data Employee = Employee { employeeName :: String, employeeAge :: Integer, employeeCar :: Car } deriving (Show)
data Car = Car { carName :: String } deriving (Show)
example :: Integer -> Country -> Country
example i = $(set ['countryCompany, 'companyBoss, 'employeeAge]) i
. $(set ['countryCompany, 'companyCar, 'carName]) "new"
. $(set ['countryCompany, 'companyName]) "cmp"
. $(set ['countryName]) "ccc"
main :: IO ()
main = do
let car1 = Car { carName = "car1" }
let car2 = Car { carName = "car2" }
let boss = Employee { employeeName = "Carl", employeeAge = 30, employeeCar = car2 }
let comp = Company { companyName = "Acme", companyBoss = boss, companyCar = car1 }
let ctry = Country { countryName = "Scotland", countryCompany = comp }
print ctry
print $ example 420 ctry
pollutes the namespace with redundancy on the record accessors with lens counterpart, introduces lens types when initially you just had the record types and the accessors
Pros of my silly script:
uses the basics, Haskell98 compatible
you drop it off on a file and thatâs it, it just works
only depends on template-haskell which comes with GHC out of the box, enable the extension and your script is good to go
doesnât need AllowAmbiguousTypes, FunctionalDependencies, UndecidableInstances or others
Cons of my silly script:
generates boilerplate which may or may not be optimized to anything sensible
you can only set one thing at a time which generates even more boilerplate
reducing all the boilerplate introduces quasiquotation and you might as well write setters with the full record notation or use lenses if youâre going to bother with a parser
{-# LANGUAGE DuplicateRecordFields, TemplateHaskell, DataKinds, TypeFamilies, UndecidableInstances, OverloadedLabels #-}
import Optics
import Optics.TH
data Country = Country { name :: String, company :: Company } deriving (Show)
data Company = Company { name :: String, boss :: Employee, car :: Car } deriving (Show)
data Employee = Employee { name :: String, age :: Integer, car :: Car } deriving (Show)
data Car = Car { name :: String } deriving (Show)
makeFieldLabelsNoPrefix ''Country
makeFieldLabelsNoPrefix ''Company
makeFieldLabelsNoPrefix ''Employee
makeFieldLabelsNoPrefix ''Car
example :: Integer -> Country -> Country
example i = set (#company % #boss % #age) i
. set (#company % #car % #name) "Batmobile"
. set (#company % #name) "Aperture"
. set (#name) "Canada"
main :: IO ()
main = do
let car1 = Car { name = "car1" }
let car2 = Car { name = "car2" }
let boss = Employee { name = "Carl", age = 30, car = car2 }
let comp = Company { name = "Acme", boss = boss, car = car1 }
let ctry = Country { name = "Scotland", company = comp }
print ctry
print $ example 420 ctry
Makes replacing lenses easy and also quite as handy. You can choose Generics, TH, symbol spaghetti or lens like interface.
For Template Haskell learning purposes I went and downloaded this and used Template Haskell to provide an overloading function to generate all the boilerplate for a record that wants to use OverloadedRecordUpdate.
Experimental.hs:
{-# LANGUAGE AllowAmbiguousTypes, FunctionalDependencies, TemplateHaskell #-}
module Experimental (
HasField (..),
getField,
setField,
overloadRecords
) where
import Language.Haskell.TH
class HasField x r a | x r -> a where
-- | Function to get and set a field in a record.
hasField :: r -> (a -> r, a)
getField :: forall x r a. (HasField x r a) => r -> a
getField = snd . hasField @x
setField :: forall x r a. (HasField x r a) => r -> a -> r
setField = fst . hasField @x
overloadRecords :: [Name] -> Q [Dec]
overloadRecords tNames = do
foldr (\tName qDecs -> do
nDecs <- overloadRecord tName
pDecs <- qDecs
return (pDecs ++ nDecs)) (return []) tNames
overloadRecord :: Name -> Q [Dec]
overloadRecord tName = do
tDec <- getTypeDec
dCons <- getDataCons tDec
foldr (\a b -> do
xd <- inst a (getCompleteType tDec) dCons
xp <- b
return (xd ++ xp)) (return []) (agroupFs (extractFs dCons) [])
where
getTypeDec = do
i <- reify tName
case i of
TyConI d -> return d
_ -> error $ "unsupported type " ++ show tName
getDataCons td = case td of
DataD _ _ _ _ cs _ -> return cs
_ -> error $ "no cons for " ++ show tName
getCompleteType td = case td of
DataD _ t ks _ _ _ -> mf (fmap kf ks) t
_ -> error $ "no kinds for " ++ show tName
where
kf (PlainTV n _) = n
kf (KindedTV n _ _) = n
mf ps t = case ps of
[x] -> appT (conT t) (varT x)
x : xs -> appT (mf xs t) (varT x)
_ -> conT t
extractFs rs = case rs of
r : xs -> z r ++ extractFs xs
_ -> []
where
z (RecC c fs) = fmap (\(n, _, t) -> (n, t, c)) fs
z _ = []
agroupFs xs acc = case xs of
[] -> acc
(n, t, c) : ys -> inc (\(n2, t2, c2) -> (n2, t2, c : c2)) (\(n2, _, _) -> n2 == n) (n, t, [c]) (agroupFs ys acc)
where
inc z h x zs = case span (not . h) zs of
(_, []) -> x : zs
(a, b : bs) -> a ++ (z b : bs)
inst (fieldName, fieldType, dataCons) fullT dCons =
[d|
instance HasField $(litT (strTyLit fieldStr)) $(fullT) $(return fieldType) where
hasField r = $(caseE [| r |] matches)
|]
where
fieldStr = reverse . takeWhile (/= '.') . reverse . show $ fieldName
o = "v"
matches = fmap (\dcn -> let vats = fmap varP (mt dCons dcn)
pats = conP dcn vats
body = normalB [| (\x -> $(vt dCons dcn [| x |]), $(varE (mkName o))) |]
in match pats body []) dataCons ++ [fin]
where
err = "No match in record selector " ++ fieldStr
fin = match wildP (normalB [| error $(litE (stringL err)) |]) []
mt rs consName = case rs of
(RecC c fs) : xs -> if consName == c then p fs 0 else mt xs consName
_ -> []
where
p ((n, _, _) : js) num = (if n == fieldName then mkName o else mkName (o ++ show num)) : p js (num + 1)
p _ _ = []
vt rs consName xq = case rs of
(RecC c fs) : xs -> if consName == c then p (prep fs) else vt xs consName xq
_ -> conE consName
where
prep = reverse . zip [0..] . fmap (\(n, _, _) -> n)
p [] = conE consName
p ((i, x) : xs) = appE (p xs) (if x == fieldName then xq else varE (mkName (o ++ show i)))
{-
instance "name" Country String where
hasField r = case r of
Country v v1 -> (\x -> Country x v1, v)
AlienCountry v v1 -> (\x -> Country x v1, v)
_ -> error "no match"
-}
Main.hs:
{-# LANGUAGE DuplicateRecordFields, OverloadedRecordDot, OverloadedRecordUpdate, RebindableSyntax #-}
{-# LANGUAGE DataKinds, TemplateHaskell #-}
import Prelude
import Experimental
data Country a = Country { name :: String, company :: Company } | AlienCountry { name :: String, poly :: a } deriving (Show)
data Company = Company { name :: String, boss :: Employee, car :: Car } deriving (Show)
data Employee = Employee { name :: String, age :: Integer, car :: Car } deriving (Show)
data Car = Car { name :: String } deriving (Show)
overloadRecords [''Country, ''Company, ''Employee, ''Car]
main :: IO ()
main = do
let car1 = Car { name = "car1" }
let car2 = Car { name = "car2" }
let boss = Employee { name = "Carl", age = 30, car = car2 }
let comp = Company { name = "Acme", boss = boss, car = car1 }
let ctry = Country { name = "Scotland", company = comp }
print (ctry :: Country String)
print $ ctry.company.boss.age
let uc = ctry { company.boss.age = 420, company.boss.car.name = "new car" }
print (uc :: Country String)
let alien = AlienCountry { name = "Canada", poly = Company { name = "Alien Corp", boss = boss, car = car2 }}
print alien
print $ alien.poly.name
let ac = alien { name = "Brazil", poly.boss.age = 999 }
print ac
Only to realize I was using the old proposal and not the new one and I canât just flip the types to finally see the âtypechecked onlyâ example work (because of ambiguous errors).
The good thing is that my example just works, like how original records do. Which is good⌠and bad. Good because it works, with the simple ergonomics that implies. Bad because thereâs no type checking that the member you are calling is effectively part of the value (e.g asking for the company of AlienCountry is valid in old Haskell, valid here, and gives a runtime error if you do so).
Now Iâm wondering how it would look like with optics.
With 