record-dot-preprocessor 0.2.1 → 0.2.2
raw patch · 6 files changed
+51/−19 lines, 6 files
Files
- CHANGES.txt +2/−0
- README.md +6/−2
- examples/Both.hs +19/−8
- plugin/RecordDotPreprocessor.hs +22/−8
- preprocessor/Edit.hs +1/−0
- record-dot-preprocessor.cabal +1/−1
CHANGES.txt view
@@ -1,5 +1,7 @@ Changelog for record-dot-preprocessor +0.2.2, released 2019-12-08+ #26, make a {b=c} not desugar to setField 0.2.1, released 2019-11-02 #25, support promoted data kinds, e.g. 'Int #12, support more things around GADTs
README.md view
@@ -1,6 +1,6 @@ # record-dot-preprocessor [](https://hackage.haskell.org/package/record-dot-preprocessor) [](https://www.stackage.org/package/record-dot-preprocessor) [](https://travis-ci.org/ndmitchell/record-dot-preprocessor) -In almost every programming language `a.b` will get the `b` field from the `a` data type, and many different data types can have a `b` field. The reason this feature is ubiquitous is because it's _useful_. The `record-dot-preprocessor` brings this feature to Haskell. Some examples:+In almost every programming language `a.b` will get the `b` field from the `a` data type, and many different data types can have a `b` field. The reason this feature is ubiquitous is because it's _useful_. This feature has been [proposed for Haskell](https://github.com/ghc-proposals/ghc-proposals/pull/282) as `RecordDotSyntax`. The `record-dot-preprocessor` brings this feature to Haskell today. Some examples: ```haskell data Company = Company {name :: String, owner :: Person}@@ -31,7 +31,7 @@ Using the preprocessor or the GHC plugin you can write: * `expr.lbl` is equivalent to `getField @"lbl" expr` (the `.` cannot have whitespace on either side).-* `expr{lbl = val}` is equivalent to `setField @"lbl" expr val`.+* `expr{lbl = val}` is equivalent to `setField @"lbl" expr val` (the `{` cannot have whitespace before it). * `(.lbl)` is equivalent to `(\x -> x.lbl)` (the `.` cannot have whitespace after). Using the preprocessor, but _not_ the GHC plugin:@@ -52,3 +52,7 @@ ## How does this magic compare to other magic? Records in Haskell are well known to be [pretty lousy](https://www.yesodweb.com/blog/2011/09/limitations-of-haskell). There are [many proposals](https://wiki.haskell.org/Extensible_record) that aim to make Haskell records more powerful using dark arts taken from type systems and category theory. This preprocessor aims for simplicity - combining existing elements into a coherent story. The aim is to do no worse than Java, not achieve perfection.++## Any advice for using this magic?++The most important consideration is that all records used by `a.b` or `a{b=c}` syntax _must_ have `HasField` instances, which requires either running the preprocessor/plugin over the module defining them, or writing orphan instances by hand. To use records which don't have such instances use normal selector functions (e.g. `b a`) and insert a space before the `{` (e.g. `a {b=c}`).
examples/Both.hs view
@@ -4,9 +4,10 @@ {-# LANGUAGE PartialTypeSignatures, GADTs, StandaloneDeriving, DataKinds #-} -- also tests we put language extensions before imports import Control.Exception+import Data.Version main :: IO ()-main = test1 >> test2 >> test3 >> test4 >> putStrLn "All worked"+main = test1 >> test2 >> test3 >> test4 >> test5 >> putStrLn "All worked" (===) :: (Show a, Eq a) => a -> a -> IO () a === b = if a == b then return () else fail $ "Mismatch, " ++ show a ++ " /= " ++ show b@@ -43,8 +44,8 @@ (foo2.foo1)._2 === 2 -- test expr{lbl = val}- foo {foo1 = "a"} === Foo "a" 2- foo {foo1 = "a", foo1 = "b"} === foo{foo1 = "b"}+ foo{foo1 = "a"} === Foo "a" 2+ foo{foo1 = "a", foo1 = "b"} === foo{foo1 = "b"} null (foo{foo1 = []}.foo1) === True foo{foo1 = "a"}.foo1 === "a" let _foo2 = 8 in foo{_foo2} === Foo "test" 8@@ -142,11 +143,21 @@ f7 [AA 1, AA 2, AA 3] === [1, 2, 3] f8 [BB (AA 1) (AA 2), BB (AA 2) (AA 3), BB (AA 3) (AA 4)] === [1, 2, 3] where- f1 :: CC -> Int -> Int -> CC; f1 s t u = s {aa = t, bb = u}- f2 :: CC -> Int -> Int -> CC; f2 s t u = s {aa = t + u}- f3 :: AA -> AA; f3 s = s {xx = s.xx + 1}- f4 :: BB -> BB; f4 s = s {yy = s.yy, zz = s.zz{xx = 4}}- f5 :: BB -> BB; f5 s = s {yy = s.yy, zz = s.zz{xx = (\ x -> x * x) s.zz.xx}}+ f1 :: CC -> Int -> Int -> CC; f1 s t u = s{aa = t, bb = u}+ f2 :: CC -> Int -> Int -> CC; f2 s t u = s{aa = t + u}+ f3 :: AA -> AA; f3 s = s{xx = s.xx + 1}+ f4 :: BB -> BB; f4 s = s{yy = s.yy, zz = s.zz{xx = 4}}+ f5 :: BB -> BB; f5 s = s{yy = s.yy, zz = s.zz{xx = (\ x -> x * x) s.zz.xx}} f6 :: BB -> BB; f6 s = s{yy = s.yy{xx = s.yy.xx + 1}, zz = s.zz{xx = (\ x -> x * x) s.zz{xx = s.zz.xx}.xx}} f7 :: [AA] -> [Int]; f7 l = map (.xx) l f8 :: [BB] -> [Int]; f8 l = map (.yy.xx) l++-- ---------------------------------------------------------------------+-- Test we can still non-instance fields++test5 :: IO ()+test5 = do+ let v = makeVersion [1,2,3]+ versionBranch v === [1,2,3]+ -- the space before the { stops it from using record update+ showVersion (v {versionBranch=[1]}) === "1"
plugin/RecordDotPreprocessor.hs view
@@ -139,7 +139,7 @@ , (rhsApp, rhs) <- getAppLHS rhs , (rhsRec, rhs) <- getRec rhs , Just sel <- getSelector rhs- = onExp $ lhsOp $ rhsApp $ lhsApp $ rhsRec $ mkParen $ setL o $ mkVar var_getField `mkAppType` sel `mkApp` lhs+ = onExp $ setL o $ lhsOp $ rhsApp $ lhsApp $ rhsRec $ mkParen $ mkVar var_getField `mkAppType` sel `mkApp` lhs -- Turn (.foo.bar) into getField calls onExp (L o (SectionR _ mid@(isDot -> True) rhs))@@ -152,11 +152,16 @@ = setL o $ foldl1 (\x y -> noL $ OpApp noE x (mkVar var_dot) y) $ map (mkVar var_getField `mkAppType`) $ reverse sels -- Turn a{b=c, ...} into setField calls-onExp (L o upd@RecordUpd{rupd_expr,rupd_flds=L _ (HsRecField (fmap rdrNameAmbiguousFieldOcc -> lbl) arg pun):flds})- | let sel = mkSelector lbl- , let arg2 = if pun then noL $ HsVar noE lbl else arg- , let expr = mkParen $ mkVar var_setField `mkAppType` sel `mkApp` rupd_expr `mkApp` arg2 -- 'rupd_expr' never needs bracketing.- = onExp $ if null flds then expr else L o upd{rupd_expr=expr,rupd_flds=flds}+onExp (L o upd@RecordUpd{rupd_expr,rupd_flds=fld:flds})+ | adjacentBy 1 rupd_expr fld+ = onExp $ f rupd_expr $ fld:flds+ where+ f expr [] = expr+ f expr (L _ (HsRecField (fmap rdrNameAmbiguousFieldOcc -> lbl) arg pun) : flds)+ | let sel = mkSelector lbl+ , let arg2 = if pun then noL $ HsVar noE lbl else arg+ , let expr2 = mkParen $ mkVar var_setField `mkAppType` sel `mkApp` expr `mkApp` arg2 -- 'expr' never needs bracketing.+ = f expr2 flds onExp x = descend onExp x @@ -196,7 +201,8 @@ -- | Lens on: [r]{f1=x1}{f2=x2} getRec :: LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)-getRec (L l r@RecordUpd{}) = first (\c x -> L l r{rupd_expr=c x}) $ getRec $ rupd_expr r+-- important to copy the location back over, since we check the whitespace hasn't changed+getRec (L l r@RecordUpd{}) = first (\c x -> L l r{rupd_expr=setL (getLoc $ rupd_expr r) $ c x}) $ getRec $ rupd_expr r getRec x = (id, x) -- | Is it equal to: .@@ -215,4 +221,12 @@ -- | Are the end of a and the start of b next to each other, no white space adjacent :: Located a -> Located b -> Bool-adjacent (L a _) (L b _) = isGoodSrcSpan a && srcSpanEnd a == srcSpanStart b+adjacent = adjacentBy 0++-- | Are the end of a and the start of b next to each other, no white space+adjacentBy :: Int -> Located a -> Located b -> Bool+adjacentBy i (L (srcSpanEnd -> RealSrcLoc a) _) (L (srcSpanStart -> RealSrcLoc b) _) =+ srcLocFile a == srcLocFile b &&+ srcLocLine a == srcLocLine b &&+ srcLocCol a + i == srcLocCol b+adjacentBy _ _ _ = False
preprocessor/Edit.hs view
@@ -109,6 +109,7 @@ editLoop (e:Paren (L "{") inner end:xs) | not $ isCtor e , not $ isPL "::" e+ , getWhite e == "" , Just updates <- mapM f $ split (isPL ",") inner , let end2 = [Item end{lexeme=""} | whitespace end /= ""] = editLoop $ renderUpdate (Update e updates) : end2 ++ xs
record-dot-preprocessor.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.18 build-type: Simple name: record-dot-preprocessor-version: 0.2.1+version: 0.2.2 license: BSD3 x-license: BSD-3-Clause OR Apache-2.0 license-file: LICENSE