-
-
Save s9gf4ult/f75b77a92cbc1677887a0547bf564e4e to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module A | |
makeEtherHasLens :: Name -> DecsQ | |
makeEtherHasLens name = do | |
TyConI dec <- reify name | |
fields <- case dec of | |
DataD _ctx _name _tvars _kind [dataCon] _derive -> case dataCon of | |
RecC _conName fs -> return $ (\(n, _bang, ty) -> (n, ty)) <$> fs | |
_ -> fail $ show name ++ ": hust have prefix constructor with named fields" | |
_ -> fail $ show name ++ ": must be one constructor record with named fields" | |
genHasLens (VarT name) fields | |
genHasLens | |
:: Type | |
-- ^ Struct type | |
-> [(Name, Type)] | |
-- ^ Fields of struct | |
-> DecsQ | |
genHasLens outer fields = fmap mconcat $ for fields $ \(nm, typ) -> do | |
let | |
setLens = do | |
s <- newName "s" | |
a <- newName "a" | |
let upd = RecUpdE (VarE s) [(nm, VarE a)] | |
[e| ( \ $(varP s) $(varP a) -> $(pure upd) ) |] | |
[d|instance E.HasLens $(pure typ) $(pure outer) $(pure typ) where | |
lensOf = lens $(varE nm) $(setLens)|] | |
module B | |
import A | |
data Rec = Rec | |
{ _rInt :: Int | |
, _rString :: String | |
} | |
makeEtherHasLens ''Rec |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
|
40 | makeEtherHasLens ''Rec
| ^^^^^^^^^^^^^^^^^^^^^^
Progress 1/2