record-dot-preprocessor 0.2.2 → 0.2.3
raw patch · 9 files changed
+78/−33 lines, 9 filesdep ~ghc
Dependency ranges changed: ghc
Files
- CHANGES.txt +2/−0
- LICENSE +1/−1
- examples/Both.hs +17/−6
- examples/Preprocessor.hs +1/−1
- plugin/Compat.hs +49/−15
- plugin/RecordDotPreprocessor.hs +2/−4
- preprocessor/Edit.hs +1/−1
- record-dot-preprocessor.cabal +3/−3
- test/PluginExample.hs +2/−2
CHANGES.txt view
@@ -1,5 +1,7 @@ Changelog for record-dot-preprocessor +0.2.3, released 2020-04-01+ Support GHC 8.10 0.2.2, released 2019-12-08 #26, make a {b=c} not desugar to setField 0.2.1, released 2019-11-02
LICENSE view
@@ -1,4 +1,4 @@-Copyright Neil Mitchell 2018-2019.+Copyright Neil Mitchell 2018-2020. Licensed under either of:
examples/Both.hs view
@@ -5,18 +5,19 @@ import Control.Exception import Data.Version+import Data.Proxy main :: IO ()-main = test1 >> test2 >> test3 >> test4 >> test5 >> putStrLn "All worked"+main = test1 >> test2 >> test3 >> test4 >> test5 >> test6 >> putStrLn "All worked" (===) :: (Show a, Eq a) => a -> a -> IO ()-a === b = if a == b then return () else fail $ "Mismatch, " ++ show a ++ " /= " ++ show b+a === b = if a == b then pure () else fail $ "Mismatch, " ++ show a ++ " /= " ++ show b fails :: a -> IO () fails val = do res <- try $ evaluate val case res of- Left e -> let _ = e :: SomeException in return ()+ Left e -> let _ = e :: SomeException in pure () Right _ -> fail "Expected an exception" @@ -60,9 +61,6 @@ fails (Nonhuman "x").job -type Type = '[Int]-- --------------------------------------------------------------------- -- DEAL WITH INFIX APPLICATIONS AND ASSOCIATIVITY @@ -161,3 +159,16 @@ versionBranch v === [1,2,3] -- the space before the { stops it from using record update showVersion (v {versionBranch=[1]}) === "1"++-- ---------------------------------------------------------------------+-- Deal with type promotion++type Type = '[Int]++typeProxy :: Proxy Type+typeProxy = Proxy++test6 :: IO ()+test6 = do+ _ <- evaluate typeProxy+ return ()
examples/Preprocessor.hs view
@@ -12,7 +12,7 @@ (===) :: (Show a, Eq a) => a -> a -> IO ()-a === b = if a == b then return () else fail $ "Mismatch, " ++ show a ++ " /= " ++ show b+a === b = if a == b then pure () else fail $ "Mismatch, " ++ show a ++ " /= " ++ show b -- can you deal with multiple alternatives
plugin/Compat.hs view
@@ -4,9 +4,13 @@ -- | Module containing the plugin. module Compat(module Compat) where -import qualified GHC-import HsSyn-import SrcLoc+import GHC+import BasicTypes+#if __GLASGOW_HASKELL__ < 810+import HsSyn as Compat+#else+import GHC.Hs as Compat+#endif --------------------------------------------------------------------- -- UTILITIES@@ -14,9 +18,13 @@ noL :: e -> GenLocated SrcSpan e noL = noLoc -noE :: GHC.NoExt-noE = GHC.NoExt-+#if __GLASGOW_HASKELL__ < 810+noE :: NoExt+noE = NoExt+#else+noE :: NoExtField+noE = noExtField+#endif --------------------------------------------------------------------- -- COMMON SIGNATURES@@ -24,27 +32,53 @@ mkAppType :: LHsExpr GhcPs -> LHsType GhcPs -> LHsExpr GhcPs mkTypeAnn :: LHsExpr GhcPs -> LHsType GhcPs -> LHsExpr GhcPs - #if __GLASGOW_HASKELL__ < 807 ---------------------------------------------------------------------- -- GHC 8.6- mkAppType expr typ = noL $ HsAppType (HsWC noE typ) expr mkTypeAnn expr typ = noL $ ExprWithTySig (HsWC noE (HsIB noE typ)) expr -compat_m_pats :: [Pat GhcPs] -> [LPat GhcPs]-compat_m_pats = map noL- #else ------------------------------------------------------------------------- GHC HEAD-+-- GHC 8.8+ mkAppType expr typ = noL $ HsAppType noE expr (HsWC noE typ) mkTypeAnn expr typ = noL $ ExprWithTySig noE expr (HsWC noE (HsIB noE typ)) +#endif+++#if __GLASGOW_HASKELL__ < 807++-- GHC 8.6+compat_m_pats :: [Pat GhcPs] -> [LPat GhcPs]+compat_m_pats = map noL++#elif __GLASGOW_HASKELL__ < 809++-- GHC 8.8 compat_m_pats :: [Pat GhcPs] -> [Pat GhcPs] compat_m_pats = id++#else++-- 8.10+compat_m_pats :: [Pat GhcPs] -> [LPat GhcPs]+compat_m_pats = map noL++#endif+++qualifiedImplicitImport :: ModuleName -> LImportDecl GhcPs++#if __GLASGOW_HASKELL__ < 809++-- GHC 8.8+qualifiedImplicitImport x = noL $ ImportDecl noE NoSourceText (noL x) Nothing False False+ True {- qualified -} True {- implicit -} Nothing Nothing++#else++qualifiedImplicitImport x = noL $ ImportDecl noE NoSourceText (noL x) Nothing False False+ QualifiedPost {- qualified -} True {- implicit -} Nothing Nothing #endif
plugin/RecordDotPreprocessor.hs view
@@ -11,7 +11,6 @@ import Bag import qualified GHC import qualified GhcPlugins as GHC-import HsSyn import SrcLoc import TcEvidence @@ -22,7 +21,7 @@ -- | GHC plugin. plugin :: GHC.Plugin plugin = GHC.defaultPlugin- { GHC.parsedResultAction = \_cliOptions _modSummary x -> return x{GHC.hpm_module = onModule <$> GHC.hpm_module x}+ { GHC.parsedResultAction = \_cliOptions _modSummary x -> pure x{GHC.hpm_module = onModule <$> GHC.hpm_module x} , GHC.pluginRecompile = GHC.purePlugin } @@ -51,8 +50,7 @@ onImports :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]-onImports = (:) $ noL $ GHC.ImportDecl GHC.NoExt GHC.NoSourceText (noL mod_records)- Nothing False False True {- qualified -} True {- implicit -} Nothing Nothing+onImports = (:) $ qualifiedImplicitImport mod_records {-
preprocessor/Edit.hs view
@@ -182,7 +182,7 @@ -- | Find all the records and parse them parseRecords :: [PL] -> [Record]-parseRecords = mapMaybe whole . drop 1 . split (isPL "data" ||^ isPL "newtype")+parseRecords = mapMaybe whole . drop1 . split (isPL "data" ||^ isPL "newtype") where whole :: [PL] -> Maybe Record whole xs
record-dot-preprocessor.cabal view
@@ -1,14 +1,14 @@ cabal-version: >= 1.18 build-type: Simple name: record-dot-preprocessor-version: 0.2.2+version: 0.2.3 license: BSD3 x-license: BSD-3-Clause OR Apache-2.0 license-file: LICENSE category: Development author: Neil Mitchell <ndmitchell@gmail.com> maintainer: Neil Mitchell <ndmitchell@gmail.com>-copyright: Neil Mitchell 2018-2019+copyright: Neil Mitchell 2018-2020 synopsis: Preprocessor to allow record.field syntax description: 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.@@ -19,7 +19,7 @@ extra-doc-files: README.md CHANGES.txt-tested-with: GHC==8.8.1, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2+tested-with: GHC==8.10.1, GHC==8.8.3, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2 extra-source-files: examples/Both.hs examples/Preprocessor.hs
test/PluginExample.hs view
@@ -4,14 +4,14 @@ module PluginExample where main :: IO ()-main = return ()+main = pure () #elif mingw32_HOST_OS module PluginExample where import RecordDotPreprocessor() -- To check the plugin compiles main :: IO ()-main = return ()+main = pure () #else