packages feed

evoke 0.2022.5.19 → 0.2022.8.26

raw patch · 18 files changed

+1002/−935 lines, 18 filesdep ~basedep ~ghcdep ~lens

Dependency ranges changed: base, ghc, lens, swagger2, text

Files

README.markdown view
@@ -103,7 +103,7 @@  ## Installation -Currently Evoke only supports GHC 8.10. It is possible to support a wider range+Currently Evoke only supports GHC 9.2. It is possible to support a wider range of versions, but I haven't put in the legwork necessary to make that possible. Please let me know if you'd like to use Evoke with a different version of GHC.
evoke.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.10  name: evoke-version: 0.2022.5.19+version: 0.2022.8.26 synopsis: A GHC plugin to derive instances. description: Evoke is a GHC plugin to derive instances. @@ -18,9 +18,9 @@  library   build-depends:-    base >= 4.15.0 && < 4.16-    , ghc >= 9.0.1 && < 9.1-    , text >= 1.2.3 && < 1.3 || >= 2.0 && < 2.1+    base >= 4.16 && < 4.17+    , ghc >= 9.2.1 && < 9.3+    , text >= 1.2 && < 1.3 || >= 2.0 && < 2.1   default-language: Haskell2010   exposed-modules:     Evoke@@ -44,6 +44,7 @@     -Wno-implicit-prelude     -Wno-missing-deriving-strategies     -Wno-missing-exported-signatures+    -Wno-missing-kind-signatures     -Wno-missing-safe-haskell-mode     -Wno-prepositive-qualified-module     -Wno-safe@@ -51,17 +52,17 @@   hs-source-dirs: source/library   other-modules: Paths_evoke -test-suite test+test-suite evoke-test-suite   build-depends:     base     , aeson >= 2.0.3 && < 2.1     , evoke     , HUnit >= 1.6.2 && < 1.7     , insert-ordered-containers >= 0.2.5 && < 0.3-    , lens >= 5.1 && < 5.2+    , lens >= 5.1.1 && < 5.2     , QuickCheck >= 2.14.2 && < 2.15-    , swagger2 >= 2.8.2 && < 2.9-    , text >= 1.2.5 && < 1.3+    , swagger2 >= 2.8.4 && < 2.9+    , text   default-language: Haskell2010   ghc-options: -rtsopts -threaded   hs-source-dirs: source/test-suite
source/library/Evoke.hs view
@@ -1,6 +1,7 @@ module Evoke-  ( plugin-  ) where+  ( plugin,+  )+where  import qualified Control.Monad as Monad import qualified Control.Monad.IO.Class as IO@@ -38,12 +39,13 @@ -- >   } deriving ToJSON via "Evoke" -- -- The GHC user's guide has more detail about compiler plugins in general:--- <https://downloads.haskell.org/~ghc/8.10.4/docs/html/users_guide/extending_ghc.html#compiler-plugins>.+-- <https://downloads.haskell.org/ghc/9.2.4/docs/html/users_guide/extending_ghc.html#compiler-plugins>. plugin :: Ghc.Plugin-plugin = Ghc.defaultPlugin-  { Ghc.parsedResultAction = parsedResultAction-  , Ghc.pluginRecompile = Ghc.purePlugin-  }+plugin =+  Ghc.defaultPlugin+    { Ghc.parsedResultAction = parsedResultAction,+      Ghc.pluginRecompile = Ghc.purePlugin+    }  -- | This is the main entry point for the plugin. It receives the command line -- options, module summary, and parsed module from GHC. Ultimately it produces@@ -51,15 +53,14 @@ -- -- From a high level, this function parses the command line options to build a -- config, then hands things off to the next function ('handleLHsModule').-parsedResultAction-  :: [Ghc.CommandLineOption]-  -> Ghc.ModSummary-  -> Ghc.HsParsedModule-  -> Ghc.Hsc Ghc.HsParsedModule+parsedResultAction ::+  [Ghc.CommandLineOption] ->+  Ghc.ModSummary ->+  Ghc.HsParsedModule ->+  Ghc.Hsc Ghc.HsParsedModule parsedResultAction commandLineOptions modSummary hsParsedModule = do-  let-    lHsModule1 = Ghc.hpm_module hsParsedModule-    srcSpan = Ghc.getLoc lHsModule1+  let lHsModule1 = Ghc.hpm_module hsParsedModule+      srcSpan = Ghc.getLoc lHsModule1   flags <- Options.parse Flag.options commandLineOptions srcSpan   let config = Config.fromFlags flags   Monad.when (Config.help config)@@ -68,12 +69,13 @@     . fmap Ghc.text     . lines     $ Console.usageInfo ("Evoke version " <> version) Flag.options-  Monad.when (Config.version config) . Hsc.throwError srcSpan $ Ghc.text-    version+  Monad.when (Config.version config) . Hsc.throwError srcSpan $+    Ghc.text+      version    let moduleName = Ghc.moduleName $ Ghc.ms_mod modSummary   lHsModule2 <- handleLHsModule config moduleName lHsModule1-  pure hsParsedModule { Ghc.hpm_module = lHsModule2 }+  pure hsParsedModule {Ghc.hpm_module = lHsModule2}  -- | This package's version number as a string. version :: String@@ -88,11 +90,11 @@ -- -- All of these functions are plumbing. If you want to skip to the interesting -- part, go to 'handleLHsSigType'.-handleLHsModule-  :: Config.Config-  -> Ghc.ModuleName-  -> LHsModule-  -> Ghc.Hsc LHsModule+handleLHsModule ::+  Config.Config ->+  Ghc.ModuleName ->+  LHsModule ->+  Ghc.Hsc LHsModule handleLHsModule config moduleName lHsModule = do   hsModule <- handleHsModule config moduleName $ Ghc.unLoc lHsModule   pure $ Ghc.mapLoc (const hsModule) lHsModule@@ -102,176 +104,187 @@ type LHsModule = Ghc.Located Ghc.HsModule  -- | See 'handleLHsModule' and 'handleLHsSigType'.-handleHsModule-  :: Config.Config-  -> Ghc.ModuleName-  -> Ghc.HsModule-  -> Ghc.Hsc Ghc.HsModule+handleHsModule ::+  Config.Config ->+  Ghc.ModuleName ->+  Ghc.HsModule ->+  Ghc.Hsc Ghc.HsModule handleHsModule config moduleName hsModule = do-  (lImportDecls, lHsDecls) <- handleLHsDecls config moduleName-    $ Ghc.hsmodDecls hsModule-  pure hsModule-    { Ghc.hsmodImports = Ghc.hsmodImports hsModule <> lImportDecls-    , Ghc.hsmodDecls = lHsDecls-    }+  (lImportDecls, lHsDecls) <-+    handleLHsDecls config moduleName $+      Ghc.hsmodDecls hsModule+  pure+    hsModule+      { Ghc.hsmodImports = Ghc.hsmodImports hsModule <> lImportDecls,+        Ghc.hsmodDecls = lHsDecls+      }  -- | See 'handleLHsModule' and 'handleLHsSigType'.-handleLHsDecls-  :: Config.Config-  -> Ghc.ModuleName-  -> [Ghc.LHsDecl Ghc.GhcPs]-  -> Ghc.Hsc ([Ghc.LImportDecl Ghc.GhcPs], [Ghc.LHsDecl Ghc.GhcPs])+handleLHsDecls ::+  Config.Config ->+  Ghc.ModuleName ->+  [Ghc.LHsDecl Ghc.GhcPs] ->+  Ghc.Hsc ([Ghc.LImportDecl Ghc.GhcPs], [Ghc.LHsDecl Ghc.GhcPs]) handleLHsDecls config moduleName lHsDecls = do   tuples <- mapM (handleLHsDecl config moduleName) lHsDecls   pure . Bifunctor.bimap mconcat mconcat $ unzip tuples  -- | See 'handleLHsModule' and 'handleLHsSigType'.-handleLHsDecl-  :: Config.Config-  -> Ghc.ModuleName-  -> Ghc.LHsDecl Ghc.GhcPs-  -> Ghc.Hsc ([Ghc.LImportDecl Ghc.GhcPs], [Ghc.LHsDecl Ghc.GhcPs])+handleLHsDecl ::+  Config.Config ->+  Ghc.ModuleName ->+  Ghc.LHsDecl Ghc.GhcPs ->+  Ghc.Hsc ([Ghc.LImportDecl Ghc.GhcPs], [Ghc.LHsDecl Ghc.GhcPs]) handleLHsDecl config moduleName lHsDecl = case Ghc.unLoc lHsDecl of   Ghc.TyClD xTyClD tyClDecl1 -> do-    (tyClDecl2, (lImportDecls, lHsDecls)) <- handleTyClDecl-      config-      moduleName-      tyClDecl1+    (tyClDecl2, (lImportDecls, lHsDecls)) <-+      handleTyClDecl+        config+        moduleName+        tyClDecl1     pure-      ( lImportDecls-      , Ghc.mapLoc (const $ Ghc.TyClD xTyClD tyClDecl2) lHsDecl : lHsDecls+      ( lImportDecls,+        Ghc.mapLoc (const $ Ghc.TyClD xTyClD tyClDecl2) lHsDecl : lHsDecls       )   _ -> pure ([], [lHsDecl])  -- | See 'handleLHsModule' and 'handleLHsSigType'.-handleTyClDecl-  :: Config.Config-  -> Ghc.ModuleName-  -> Ghc.TyClDecl Ghc.GhcPs-  -> Ghc.Hsc-       ( Ghc.TyClDecl Ghc.GhcPs-       , ([Ghc.LImportDecl Ghc.GhcPs], [Ghc.LHsDecl Ghc.GhcPs])-       )+handleTyClDecl ::+  Config.Config ->+  Ghc.ModuleName ->+  Ghc.TyClDecl Ghc.GhcPs ->+  Ghc.Hsc+    ( Ghc.TyClDecl Ghc.GhcPs,+      ([Ghc.LImportDecl Ghc.GhcPs], [Ghc.LHsDecl Ghc.GhcPs])+    ) handleTyClDecl config moduleName tyClDecl = case tyClDecl of   Ghc.DataDecl tcdDExt tcdLName tcdTyVars tcdFixity tcdDataDefn -> do-    (hsDataDefn, (lImportDecls, lHsDecls)) <- handleHsDataDefn-      config-      moduleName-      tcdLName-      tcdTyVars-      tcdDataDefn+    (hsDataDefn, (lImportDecls, lHsDecls)) <-+      handleHsDataDefn+        config+        moduleName+        tcdLName+        tcdTyVars+        tcdDataDefn     pure-      ( Ghc.DataDecl tcdDExt tcdLName tcdTyVars tcdFixity hsDataDefn-      , (lImportDecls, lHsDecls)+      ( Ghc.DataDecl tcdDExt tcdLName tcdTyVars tcdFixity hsDataDefn,+        (lImportDecls, lHsDecls)       )   _ -> pure (tyClDecl, ([], []))  -- | See 'handleLHsModule' and 'handleLHsSigType'.-handleHsDataDefn-  :: Config.Config-  -> Ghc.ModuleName-  -> Ghc.LIdP Ghc.GhcPs-  -> Ghc.LHsQTyVars Ghc.GhcPs-  -> Ghc.HsDataDefn Ghc.GhcPs-  -> Ghc.Hsc-       ( Ghc.HsDataDefn Ghc.GhcPs-       , ([Ghc.LImportDecl Ghc.GhcPs], [Ghc.LHsDecl Ghc.GhcPs])-       )+handleHsDataDefn ::+  Config.Config ->+  Ghc.ModuleName ->+  Ghc.LIdP Ghc.GhcPs ->+  Ghc.LHsQTyVars Ghc.GhcPs ->+  Ghc.HsDataDefn Ghc.GhcPs ->+  Ghc.Hsc+    ( Ghc.HsDataDefn Ghc.GhcPs,+      ([Ghc.LImportDecl Ghc.GhcPs], [Ghc.LHsDecl Ghc.GhcPs])+    ) handleHsDataDefn config moduleName lIdP lHsQTyVars hsDataDefn =   case hsDataDefn of-    Ghc.HsDataDefn dd_ext dd_ND dd_ctxt dd_cType dd_kindSig dd_cons dd_derivs-      -> do-        (hsDeriving, (lImportDecls, lHsDecls)) <- handleHsDeriving-          config-          moduleName-          lIdP-          lHsQTyVars-          dd_cons-          dd_derivs+    Ghc.HsDataDefn dd_ext dd_ND dd_ctxt dd_cType dd_kindSig dd_cons dd_derivs ->+      do+        (hsDeriving, (lImportDecls, lHsDecls)) <-+          handleHsDeriving+            config+            moduleName+            lIdP+            lHsQTyVars+            dd_cons+            dd_derivs         pure           ( Ghc.HsDataDefn-            dd_ext-            dd_ND-            dd_ctxt-            dd_cType-            dd_kindSig-            dd_cons-            hsDeriving-          , (lImportDecls, lHsDecls)+              dd_ext+              dd_ND+              dd_ctxt+              dd_cType+              dd_kindSig+              dd_cons+              hsDeriving,+            (lImportDecls, lHsDecls)           )  -- | See 'handleLHsModule' and 'handleLHsSigType'.-handleHsDeriving-  :: Config.Config-  -> Ghc.ModuleName-  -> Ghc.LIdP Ghc.GhcPs-  -> Ghc.LHsQTyVars Ghc.GhcPs-  -> [Ghc.LConDecl Ghc.GhcPs]-  -> Ghc.HsDeriving Ghc.GhcPs-  -> Ghc.Hsc-       ( Ghc.HsDeriving Ghc.GhcPs-       , ( [Ghc.LImportDecl Ghc.GhcPs]-         , [Ghc.LHsDecl Ghc.GhcPs]-         )-       )+handleHsDeriving ::+  Config.Config ->+  Ghc.ModuleName ->+  Ghc.LIdP Ghc.GhcPs ->+  Ghc.LHsQTyVars Ghc.GhcPs ->+  [Ghc.LConDecl Ghc.GhcPs] ->+  Ghc.HsDeriving Ghc.GhcPs ->+  Ghc.Hsc+    ( Ghc.HsDeriving Ghc.GhcPs,+      ( [Ghc.LImportDecl Ghc.GhcPs],+        [Ghc.LHsDecl Ghc.GhcPs]+      )+    ) handleHsDeriving config moduleName lIdP lHsQTyVars lConDecls hsDeriving = do   (lHsDerivingClauses, (lImportDecls, lHsDecls)) <--    handleLHsDerivingClauses config moduleName lIdP lHsQTyVars lConDecls-      $ Ghc.unLoc hsDeriving+    handleLHsDerivingClauses config moduleName lIdP lHsQTyVars lConDecls hsDeriving   pure-    ( Ghc.mapLoc (const lHsDerivingClauses) hsDeriving-    , (lImportDecls, lHsDecls)+    ( lHsDerivingClauses,+      (lImportDecls, lHsDecls)     )  -- | See 'handleLHsModule' and 'handleLHsSigType'.-handleLHsDerivingClauses-  :: Config.Config-  -> Ghc.ModuleName-  -> Ghc.LIdP Ghc.GhcPs-  -> Ghc.LHsQTyVars Ghc.GhcPs-  -> [Ghc.LConDecl Ghc.GhcPs]-  -> [Ghc.LHsDerivingClause Ghc.GhcPs]-  -> Ghc.Hsc-       ( [Ghc.LHsDerivingClause Ghc.GhcPs]-       , ( [Ghc.LImportDecl Ghc.GhcPs]-         , [Ghc.LHsDecl Ghc.GhcPs]-         )-       )-handleLHsDerivingClauses config moduleName lIdP lHsQTyVars lConDecls lHsDerivingClauses-  = do-    tuples <- mapM-      (handleLHsDerivingClause config moduleName lIdP lHsQTyVars lConDecls)-      lHsDerivingClauses+handleLHsDerivingClauses ::+  Config.Config ->+  Ghc.ModuleName ->+  Ghc.LIdP Ghc.GhcPs ->+  Ghc.LHsQTyVars Ghc.GhcPs ->+  [Ghc.LConDecl Ghc.GhcPs] ->+  [Ghc.LHsDerivingClause Ghc.GhcPs] ->+  Ghc.Hsc+    ( [Ghc.LHsDerivingClause Ghc.GhcPs],+      ( [Ghc.LImportDecl Ghc.GhcPs],+        [Ghc.LHsDecl Ghc.GhcPs]+      )+    )+handleLHsDerivingClauses config moduleName lIdP lHsQTyVars lConDecls lHsDerivingClauses =+  do+    tuples <-+      mapM+        (handleLHsDerivingClause config moduleName lIdP lHsQTyVars lConDecls)+        lHsDerivingClauses     pure       . Bifunctor.bimap-          Maybe.catMaybes-          (Bifunctor.bimap mconcat mconcat . unzip)+        Maybe.catMaybes+        (Bifunctor.bimap mconcat mconcat . unzip)       $ unzip tuples  -- | See 'handleLHsModule' and 'handleLHsSigType'.-handleLHsDerivingClause-  :: Config.Config-  -> Ghc.ModuleName-  -> Ghc.LIdP Ghc.GhcPs-  -> Ghc.LHsQTyVars Ghc.GhcPs-  -> [Ghc.LConDecl Ghc.GhcPs]-  -> Ghc.LHsDerivingClause Ghc.GhcPs-  -> Ghc.Hsc-       ( Maybe (Ghc.LHsDerivingClause Ghc.GhcPs)-       , ( [Ghc.LImportDecl Ghc.GhcPs]-         , [Ghc.LHsDecl Ghc.GhcPs]-         )-       )-handleLHsDerivingClause config moduleName lIdP lHsQTyVars lConDecls lHsDerivingClause-  = case Ghc.unLoc lHsDerivingClause of+handleLHsDerivingClause ::+  Config.Config ->+  Ghc.ModuleName ->+  Ghc.LIdP Ghc.GhcPs ->+  Ghc.LHsQTyVars Ghc.GhcPs ->+  [Ghc.LConDecl Ghc.GhcPs] ->+  Ghc.LHsDerivingClause Ghc.GhcPs ->+  Ghc.Hsc+    ( Maybe (Ghc.LHsDerivingClause Ghc.GhcPs),+      ( [Ghc.LImportDecl Ghc.GhcPs],+        [Ghc.LHsDecl Ghc.GhcPs]+      )+    )+handleLHsDerivingClause config moduleName lIdP lHsQTyVars lConDecls lHsDerivingClause =+  case Ghc.unLoc lHsDerivingClause of     Ghc.HsDerivingClause _ deriv_clause_strategy deriv_clause_tys       | Just options <- parseDerivingStrategy deriv_clause_strategy -> do-        (lImportDecls, lHsDecls) <--          handleLHsSigTypes config moduleName lIdP lHsQTyVars lConDecls options-            $ Ghc.unLoc deriv_clause_tys-        pure (Nothing, (lImportDecls, lHsDecls))+          (lImportDecls, lHsDecls) <-+            handleLHsSigTypes config moduleName lIdP lHsQTyVars lConDecls options+              . toLHsSigTypes+              $ Ghc.unLoc deriv_clause_tys+          pure (Nothing, (lImportDecls, lHsDecls))     _ -> pure (Just lHsDerivingClause, ([], [])) +toLHsSigTypes :: Ghc.DerivClauseTys Ghc.GhcPs -> [Ghc.LHsSigType Ghc.GhcPs]+toLHsSigTypes derivClauseTys = case derivClauseTys of+  Ghc.DctSingle _ lHsSigType -> [lHsSigType]+  Ghc.DctMulti _ lHsSigTypes -> lHsSigTypes+ -- | This plugin only fires on specific deriving strategies. In particular it -- looks for clauses like this: --@@ -279,15 +292,15 @@ -- -- This function is responsible for analyzing a deriving strategy to determine -- if the plugin should fire or not.-parseDerivingStrategy-  :: Maybe (Ghc.LDerivStrategy Ghc.GhcPs) -> Maybe [String]+parseDerivingStrategy ::+  Maybe (Ghc.LDerivStrategy Ghc.GhcPs) -> Maybe [String] parseDerivingStrategy mLDerivStrategy = do   lDerivStrategy <- mLDerivStrategy   lHsSigType <- case Ghc.unLoc lDerivStrategy of-    Ghc.ViaStrategy x -> Just x+    Ghc.ViaStrategy (Ghc.XViaStrategyPs _ x) -> Just $ Ghc.unLoc x     _ -> Nothing   lHsType <- case lHsSigType of-    Ghc.HsIB _ x -> Just x+    Ghc.HsSig _ _ x -> Just x   hsTyLit <- case Ghc.unLoc lHsType of     Ghc.HsTyLit _ x -> Just x     _ -> Nothing@@ -299,23 +312,24 @@     _ -> Nothing  -- | See 'handleLHsModule' and 'handleLHsSigType'.-handleLHsSigTypes-  :: Config.Config-  -> Ghc.ModuleName-  -> Ghc.LIdP Ghc.GhcPs-  -> Ghc.LHsQTyVars Ghc.GhcPs-  -> [Ghc.LConDecl Ghc.GhcPs]-  -> [String]-  -> [Ghc.LHsSigType Ghc.GhcPs]-  -> Ghc.Hsc-       ( [Ghc.LImportDecl Ghc.GhcPs]-       , [Ghc.LHsDecl Ghc.GhcPs]-       )-handleLHsSigTypes config moduleName lIdP lHsQTyVars lConDecls options lHsSigTypes-  = do-    tuples <- mapM-      (handleLHsSigType config moduleName lIdP lHsQTyVars lConDecls options)-      lHsSigTypes+handleLHsSigTypes ::+  Config.Config ->+  Ghc.ModuleName ->+  Ghc.LIdP Ghc.GhcPs ->+  Ghc.LHsQTyVars Ghc.GhcPs ->+  [Ghc.LConDecl Ghc.GhcPs] ->+  [String] ->+  [Ghc.LHsSigType Ghc.GhcPs] ->+  Ghc.Hsc+    ( [Ghc.LImportDecl Ghc.GhcPs],+      [Ghc.LHsDecl Ghc.GhcPs]+    )+handleLHsSigTypes config moduleName lIdP lHsQTyVars lConDecls options lHsSigTypes =+  do+    tuples <-+      mapM+        (handleLHsSigType config moduleName lIdP lHsQTyVars lConDecls options)+        lHsSigTypes     pure . Bifunctor.bimap mconcat mconcat $ unzip tuples  -- | This is the main workhorse of the plugin. By the time things get here,@@ -324,23 +338,21 @@ -- If we don't know how to generate an instance for the requested class, an -- error will be thrown. If the user requested verbose output, the generated -- instance will be printed.-handleLHsSigType-  :: Config.Config-  -> Ghc.ModuleName-  -> Ghc.LIdP Ghc.GhcPs-  -> Ghc.LHsQTyVars Ghc.GhcPs-  -> [Ghc.LConDecl Ghc.GhcPs]-  -> [String]-  -> Ghc.LHsSigType Ghc.GhcPs-  -> Ghc.Hsc-       ( [Ghc.LImportDecl Ghc.GhcPs]-       , [Ghc.LHsDecl Ghc.GhcPs]-       )-handleLHsSigType config moduleName lIdP lHsQTyVars lConDecls options lHsSigType-  = do-    let-      srcSpan = case lHsSigType of-        Ghc.HsIB _ x -> Ghc.getLoc x+handleLHsSigType ::+  Config.Config ->+  Ghc.ModuleName ->+  Ghc.LIdP Ghc.GhcPs ->+  Ghc.LHsQTyVars Ghc.GhcPs ->+  [Ghc.LConDecl Ghc.GhcPs] ->+  [String] ->+  Ghc.LHsSigType Ghc.GhcPs ->+  Ghc.Hsc+    ( [Ghc.LImportDecl Ghc.GhcPs],+      [Ghc.LHsDecl Ghc.GhcPs]+    )+handleLHsSigType config moduleName lIdP lHsQTyVars lConDecls options lHsSigType =+  do+    let srcSpan = Ghc.locA $ Ghc.getLoc lHsSigType     (lImportDecls, lHsDecls) <- case getGenerator lHsSigType of       Just generate ->         generate moduleName lIdP lHsQTyVars lConDecls options srcSpan@@ -348,11 +360,10 @@      verbose <- isVerbose config     Monad.when verbose $ do-      dynFlags <- Ghc.getDynFlags       IO.liftIO $ do         putStrLn $ replicate 80 '-'-        mapM_ (putStrLn . Ghc.showSDocDump dynFlags . Ghc.ppr) lImportDecls-        mapM_ (putStrLn . Ghc.showSDocDump dynFlags . Ghc.ppr) lHsDecls+        mapM_ (putStrLn . Ghc.showSDocDump Ghc.defaultSDocContext . Ghc.ppr) lImportDecls+        mapM_ (putStrLn . Ghc.showSDocDump Ghc.defaultSDocContext . Ghc.ppr) lHsDecls      pure (lImportDecls, lHsDecls) @@ -368,17 +379,17 @@  generators :: [(String, Common.Generator)] generators =-  [ ("Arbitrary", Arbitrary.generate)-  , ("FromJSON", FromJSON.generate)-  , ("ToJSON", ToJSON.generate)-  , ("ToSchema", ToSchema.generate)+  [ ("Arbitrary", Arbitrary.generate),+    ("FromJSON", FromJSON.generate),+    ("ToJSON", ToJSON.generate),+    ("ToSchema", ToSchema.generate)   ]  -- | Extracts the class name out of a type signature. getClassName :: Ghc.LHsSigType Ghc.GhcPs -> Maybe String getClassName lHsSigType = do-  lHsType <- case lHsSigType of-    Ghc.HsIB _ x -> Just x+  lHsType <- case Ghc.unLoc lHsSigType of+    Ghc.HsSig _ _ x -> Just x   lIdP <- case Ghc.unLoc lHsType of     Ghc.HsTyVar _ _ x -> Just x     _ -> Nothing
source/library/Evoke/Constant/Module.hs view
@@ -1,15 +1,16 @@ module Evoke.Constant.Module-  ( controlApplicative-  , controlLens-  , dataAeson-  , dataHashMapStrictInsOrd-  , dataMaybe-  , dataMonoid-  , dataProxy-  , dataString-  , dataSwagger-  , testQuickCheck-  ) where+  ( controlApplicative,+    controlLens,+    dataAeson,+    dataHashMapStrictInsOrd,+    dataMaybe,+    dataMonoid,+    dataProxy,+    dataString,+    dataSwagger,+    testQuickCheck,+  )+where  import qualified GHC.Unit.Module as Ghc
source/library/Evoke/Generator/Arbitrary.hs view
@@ -1,6 +1,7 @@ module Evoke.Generator.Arbitrary-  ( generate-  ) where+  ( generate,+  )+where  import qualified Data.List as List import qualified Evoke.Constant.Module as Module@@ -21,62 +22,64 @@     _ -> Hsc.throwError srcSpan $ Ghc.text "requires exactly one constructor"   fields <-     mapM (fromField srcSpan)-    . List.sortOn Field.name-    . concatMap Constructor.fields-    $ Type.constructors type_+      . List.sortOn Field.name+      . concatMap Constructor.fields+      $ Type.constructors type_    applicative <- Common.makeRandomModule Module.controlApplicative   quickCheck <- Common.makeRandomModule Module.testQuickCheck-  let-    lImportDecls = Hs.importDecls-      srcSpan-      [ (Module.controlApplicative, applicative)-      , (Module.testQuickCheck, quickCheck)-      ]+  let lImportDecls =+        Hs.importDecls+          srcSpan+          [ (Module.controlApplicative, applicative),+            (Module.testQuickCheck, quickCheck)+          ] -    bindStmts = fmap-      (\(_, var) ->-        Hs.bindStmt srcSpan (Hs.varPat srcSpan var)-          . Hs.qualVar srcSpan quickCheck-          $ Ghc.mkVarOcc "arbitrary"-      )-      fields+      bindStmts =+        fmap+          ( \(_, var) ->+              Hs.bindStmt srcSpan (Hs.varPat srcSpan var)+                . Hs.qualVar srcSpan quickCheck+                $ Ghc.mkVarOcc "arbitrary"+          )+          fields -    lastStmt =-      Hs.lastStmt srcSpan-        . Hs.app srcSpan (Hs.qualVar srcSpan applicative $ Ghc.mkVarOcc "pure")-        . Hs.recordCon srcSpan (Ghc.L srcSpan $ Constructor.name constructor)-        . Hs.recFields-        $ fmap-            (\(field, var) ->-              Hs.recField+      lastStmt =+        Hs.lastStmt srcSpan+          . Hs.app srcSpan (Hs.qualVar srcSpan applicative $ Ghc.mkVarOcc "pure")+          . Hs.recordCon srcSpan (Ghc.reLocA . Ghc.L srcSpan $ Constructor.name constructor)+          . Hs.recFields+          $ fmap+            ( \(field, var) ->+                Hs.recField                   srcSpan                   (Hs.fieldOcc srcSpan . Hs.unqual srcSpan $ Field.name field)-                $ Hs.var srcSpan var+                  $ Hs.var srcSpan var             )             fields -    lHsBind =-      Common.makeLHsBind srcSpan (Ghc.mkVarOcc "arbitrary") []-        . Hs.doExpr srcSpan-        $ bindStmts-        <> [lastStmt]+      lHsBind =+        Common.makeLHsBind srcSpan (Ghc.mkVarOcc "arbitrary") []+          . Hs.doExpr srcSpan+          $ bindStmts+            <> [lastStmt] -    lHsDecl = Common.makeInstanceDeclaration-      srcSpan-      type_-      quickCheck-      (Ghc.mkClsOcc "Arbitrary")-      [lHsBind]+      lHsDecl =+        Common.makeInstanceDeclaration+          srcSpan+          type_+          quickCheck+          (Ghc.mkClsOcc "Arbitrary")+          [lHsBind]    pure (lImportDecls, [lHsDecl]) -fromField-  :: Ghc.SrcSpan -> Field.Field -> Ghc.Hsc (Field.Field, Ghc.LIdP Ghc.GhcPs)+fromField ::+  Ghc.SrcSpan -> Field.Field -> Ghc.Hsc (Field.Field, Ghc.LIdP Ghc.GhcPs) fromField srcSpan field = do   var <-     Common.makeRandomVariable srcSpan-    . (<> "_")-    . Ghc.occNameString-    $ Field.name field+      . (<> "_")+      . Ghc.occNameString+      $ Field.name field   pure (field, var)
source/library/Evoke/Generator/Common.hs view
@@ -1,14 +1,14 @@ module Evoke.Generator.Common-  ( Generator-  , applyAll-  , fieldNameOptions-  , makeInstanceDeclaration-  , makeLHsBind-  , makeRandomModule-  , makeRandomVariable-  ) where+  ( Generator,+    applyAll,+    fieldNameOptions,+    makeInstanceDeclaration,+    makeLHsBind,+    makeRandomModule,+    makeRandomVariable,+  )+where -import qualified GHC.Data.Bag as Ghc import qualified Control.Monad.IO.Class as IO import qualified Data.Char as Char import qualified Data.IORef as IORef@@ -20,32 +20,34 @@ import qualified Evoke.Type.Constructor as Constructor import qualified Evoke.Type.Field as Field import qualified Evoke.Type.Type as Type+import qualified GHC.Data.Bag as Ghc import qualified GHC.Hs as Ghc import qualified GHC.Plugins as Ghc+import qualified GHC.Types.Fixity as Ghc import qualified System.Console.GetOpt as Console import qualified System.IO.Unsafe as Unsafe import qualified Text.Printf as Printf -type Generator-  = Ghc.ModuleName-  -> Ghc.LIdP Ghc.GhcPs-  -> Ghc.LHsQTyVars Ghc.GhcPs-  -> [Ghc.LConDecl Ghc.GhcPs]-  -> [String]-  -> Ghc.SrcSpan-  -> Ghc.Hsc-       ([Ghc.LImportDecl Ghc.GhcPs], [Ghc.LHsDecl Ghc.GhcPs])+type Generator =+  Ghc.ModuleName ->+  Ghc.LIdP Ghc.GhcPs ->+  Ghc.LHsQTyVars Ghc.GhcPs ->+  [Ghc.LConDecl Ghc.GhcPs] ->+  [String] ->+  Ghc.SrcSpan ->+  Ghc.Hsc+    ([Ghc.LImportDecl Ghc.GhcPs], [Ghc.LHsDecl Ghc.GhcPs]) -fieldNameOptions-  :: Ghc.SrcSpan -> [Console.OptDescr (String -> Ghc.Hsc String)]+fieldNameOptions ::+  Ghc.SrcSpan -> [Console.OptDescr (String -> Ghc.Hsc String)] fieldNameOptions srcSpan =-  [ Console.Option [] ["kebab"] (Console.NoArg $ pure . kebab) ""-  , Console.Option [] ["camel"] (Console.NoArg $ pure . lower) ""-  , Console.Option [] ["snake"] (Console.NoArg $ pure . snake) ""-  , Console.Option [] ["prefix", "strip"] (Console.ReqArg (stripPrefix srcSpan) "PREFIX" ) ""-  , Console.Option [] ["suffix"] (Console.ReqArg (stripSuffix srcSpan) "SUFFIX" ) ""-  , Console.Option [] ["title"] (Console.NoArg $ pure . upper) ""-  , Console.Option [] ["rename"] (Console.ReqArg (rename srcSpan) "OLD:NEW") ""+  [ Console.Option [] ["kebab"] (Console.NoArg $ pure . kebab) "",+    Console.Option [] ["camel"] (Console.NoArg $ pure . lower) "",+    Console.Option [] ["snake"] (Console.NoArg $ pure . snake) "",+    Console.Option [] ["prefix", "strip"] (Console.ReqArg (stripPrefix srcSpan) "PREFIX") "",+    Console.Option [] ["suffix"] (Console.ReqArg (stripSuffix srcSpan) "SUFFIX") "",+    Console.Option [] ["title"] (Console.NoArg $ pure . upper) "",+    Console.Option [] ["rename"] (Console.ReqArg (rename srcSpan) "OLD:NEW") ""   ]  stripPrefix :: Ghc.SrcSpan -> String -> String -> Ghc.Hsc String@@ -54,8 +56,8 @@     Hsc.throwError srcSpan       . Ghc.text       $ show prefix-      <> " is not a prefix of "-      <> show s1+        <> " is not a prefix of "+        <> show s1   Just s2 -> pure s2  stripSuffix :: Ghc.SrcSpan -> String -> String -> Ghc.Hsc String@@ -64,17 +66,19 @@     Hsc.throwError srcSpan       . Ghc.text       $ show suffix-      <> " is not a suffix of "-      <> show s1+        <> " is not a suffix of "+        <> show s1   Just s2 -> pure $ Text.unpack s2  rename :: Ghc.SrcSpan -> String -> String -> Ghc.Hsc String rename loc arg str =   case Text.splitOn (Text.singleton ':') $ Text.pack arg of-    [old, new] | not (Text.null old || Text.null new) ->-      pure $ if Text.pack str == old-        then Text.unpack new-        else str+    [old, new]+      | not (Text.null old || Text.null new) ->+          pure $+            if Text.pack str == old+              then Text.unpack new+              else str     _ -> Hsc.throwError loc . Ghc.text $ show arg <> " is invalid"  -- | Applies all the monadic functions in order beginning with some starting@@ -115,112 +119,122 @@  camelTo :: Char -> String -> String camelTo char =-  let-    go wasUpper string = case string of-      "" -> ""-      first : rest -> if Char.isUpper first-        then if wasUpper-          then Char.toLower first : go True rest-          else char : Char.toLower first : go True rest-        else first : go False rest-  in go True+  let go wasUpper string = case string of+        "" -> ""+        first : rest ->+          if Char.isUpper first+            then+              if wasUpper+                then Char.toLower first : go True rest+                else char : Char.toLower first : go True rest+            else first : go False rest+   in go True -makeLHsType-  :: Ghc.SrcSpan-  -> Ghc.ModuleName-  -> Ghc.OccName-  -> Type.Type-  -> Ghc.LHsType Ghc.GhcPs+makeLHsType ::+  Ghc.SrcSpan ->+  Ghc.ModuleName ->+  Ghc.OccName ->+  Type.Type ->+  Ghc.LHsType Ghc.GhcPs makeLHsType srcSpan moduleName className =-  Ghc.L srcSpan+  Ghc.reLocA+    . Ghc.L srcSpan     . Ghc.HsAppTy-        Ghc.noExtField-        (Ghc.L srcSpan-        . Ghc.HsTyVar Ghc.noExtField Ghc.NotPromoted-        . Ghc.L srcSpan-        $ Ghc.Qual moduleName className-        )+      Ghc.noExtField+      ( Ghc.reLocA+          . Ghc.L srcSpan+          . Ghc.HsTyVar Ghc.noAnn Ghc.NotPromoted+          . Ghc.reLocA+          . Ghc.L srcSpan+          $ Ghc.Qual moduleName className+      )     . toLHsType srcSpan  toLHsType :: Ghc.SrcSpan -> Type.Type -> Ghc.LHsType Ghc.GhcPs toLHsType srcSpan type_ =-  let-    ext :: Ghc.NoExtField-    ext = Ghc.noExtField+  let ext :: Ghc.NoExtField+      ext = Ghc.noExtField -    loc :: a -> Ghc.Located a-    loc = Ghc.L srcSpan+      loc :: a -> Ghc.LocatedAn b a+      loc = Ghc.reLocA . Ghc.L srcSpan -    initial :: Ghc.LHsType Ghc.GhcPs-    initial = loc . Ghc.HsTyVar ext Ghc.NotPromoted . loc $ Type.name type_+      initial :: Ghc.LHsType Ghc.GhcPs+      initial = loc . Ghc.HsTyVar Ghc.noAnn Ghc.NotPromoted . loc $ Type.name type_ -    combine-      :: Ghc.LHsType Ghc.GhcPs -> Ghc.IdP Ghc.GhcPs -> Ghc.LHsType Ghc.GhcPs-    combine x =-      loc . Ghc.HsAppTy ext x . loc . Ghc.HsTyVar ext Ghc.NotPromoted . loc+      combine ::+        Ghc.LHsType Ghc.GhcPs -> Ghc.IdP Ghc.GhcPs -> Ghc.LHsType Ghc.GhcPs+      combine x =+        loc . Ghc.HsAppTy ext x . loc . Ghc.HsTyVar Ghc.noAnn Ghc.NotPromoted . loc -    bare :: Ghc.LHsType Ghc.GhcPs-    bare = List.foldl' combine initial $ Type.variables type_-  in case Type.variables type_ of-    [] -> bare-    _ -> loc $ Ghc.HsParTy ext bare+      bare :: Ghc.LHsType Ghc.GhcPs+      bare = List.foldl' combine initial $ Type.variables type_+   in case Type.variables type_ of+        [] -> bare+        _ -> loc $ Ghc.HsParTy Ghc.noAnn bare -makeHsContext-  :: Ghc.SrcSpan-  -> Ghc.ModuleName-  -> Ghc.OccName-  -> Type.Type-  -> [Ghc.LHsType Ghc.GhcPs]+makeHsContext ::+  Ghc.SrcSpan ->+  Ghc.ModuleName ->+  Ghc.OccName ->+  Type.Type ->+  [Ghc.LHsType Ghc.GhcPs] makeHsContext srcSpan moduleName className =   fmap-      (Ghc.L srcSpan-      . Ghc.HsAppTy+    ( Ghc.reLocA+        . Ghc.L srcSpan+        . Ghc.HsAppTy           Ghc.noExtField-          (Ghc.L srcSpan-          . Ghc.HsTyVar Ghc.noExtField Ghc.NotPromoted-          . Ghc.L srcSpan-          $ Ghc.Qual moduleName className+          ( Ghc.reLocA+              . Ghc.L srcSpan+              . Ghc.HsTyVar Ghc.noAnn Ghc.NotPromoted+              . Ghc.reLocA+              . Ghc.L srcSpan+              $ Ghc.Qual moduleName className           )-      . Ghc.L srcSpan-      . Ghc.HsTyVar Ghc.noExtField Ghc.NotPromoted-      . Ghc.L srcSpan-      . Ghc.Unqual-      )+        . Ghc.reLocA+        . Ghc.L srcSpan+        . Ghc.HsTyVar Ghc.noAnn Ghc.NotPromoted+        . Ghc.reLocA+        . Ghc.L srcSpan+        . Ghc.Unqual+    )     . List.nub     . Maybe.mapMaybe-        (\field -> case Field.type_ field of+      ( \field -> case Field.type_ field of           Ghc.HsTyVar _ _ lRdrName -> case Ghc.unLoc lRdrName of             Ghc.Unqual occName | Ghc.isTvOcc occName -> Just occName             _ -> Nothing           _ -> Nothing-        )+      )     . concatMap Constructor.fields     . Type.constructors -makeHsImplicitBndrs-  :: Ghc.SrcSpan-  -> Type.Type-  -> Ghc.ModuleName-  -> Ghc.OccName-  -> Ghc.HsImplicitBndrs Ghc.GhcPs (Ghc.LHsType Ghc.GhcPs)+makeHsImplicitBndrs ::+  Ghc.SrcSpan ->+  Type.Type ->+  Ghc.ModuleName ->+  Ghc.OccName ->+  Ghc.LHsSigType Ghc.GhcPs makeHsImplicitBndrs srcSpan type_ moduleName className =-  let-    withoutContext = makeLHsType srcSpan moduleName className type_-    context = makeHsContext srcSpan moduleName className type_-    withContext = if null context-      then withoutContext-      else Ghc.L srcSpan-        $ Ghc.HsQualTy Ghc.noExtField (Ghc.L srcSpan context) withoutContext-  in Ghc.HsIB Ghc.noExtField withContext+  let withoutContext = makeLHsType srcSpan moduleName className type_+      context = makeHsContext srcSpan moduleName className type_+      withContext =+        if null context+          then withoutContext+          else+            Ghc.reLocA . Ghc.L srcSpan $+              Ghc.HsQualTy Ghc.noExtField (Just . Ghc.reLocA $ Ghc.L srcSpan context) withoutContext+   in Ghc.reLocA . Ghc.L srcSpan $ Ghc.HsSig Ghc.noExtField Ghc.mkHsOuterImplicit withContext  -- | Makes a random variable name using the given prefix. makeRandomVariable :: Ghc.SrcSpan -> String -> Ghc.Hsc (Ghc.LIdP Ghc.GhcPs) makeRandomVariable srcSpan prefix = do   n <- bumpCounter-  pure . Ghc.L srcSpan . Ghc.Unqual . Ghc.mkVarOcc $ Printf.printf-    "%s%d"-    prefix-    n+  pure . Ghc.reLocA . Ghc.L srcSpan . Ghc.Unqual . Ghc.mkVarOcc $+    Printf.printf+      "%s%d"+      prefix+      n  -- | Makes a random module name. This will convert any periods to underscores -- and add a unique suffix.@@ -230,10 +244,11 @@ makeRandomModule :: Ghc.ModuleName -> Ghc.Hsc Ghc.ModuleName makeRandomModule moduleName = do   n <- bumpCounter-  pure . Ghc.mkModuleName $ Printf.printf-    "%s_%d"-    (underscoreAll moduleName)-    n+  pure . Ghc.mkModuleName $+    Printf.printf+      "%s_%d"+      (underscoreAll moduleName)+      n  underscoreAll :: Ghc.ModuleName -> String underscoreAll = fmap underscoreOne . Ghc.moduleNameString@@ -243,83 +258,84 @@   '.' -> '_'   _ -> c -makeInstanceDeclaration-  :: Ghc.SrcSpan-  -> Type.Type-  -> Ghc.ModuleName-  -> Ghc.OccName-  -> [Ghc.LHsBind Ghc.GhcPs]-  -> Ghc.LHsDecl Ghc.GhcPs+makeInstanceDeclaration ::+  Ghc.SrcSpan ->+  Type.Type ->+  Ghc.ModuleName ->+  Ghc.OccName ->+  [Ghc.LHsBind Ghc.GhcPs] ->+  Ghc.LHsDecl Ghc.GhcPs makeInstanceDeclaration srcSpan type_ moduleName occName lHsBinds =   let hsImplicitBndrs = makeHsImplicitBndrs srcSpan type_ moduleName occName-  in makeLHsDecl srcSpan hsImplicitBndrs lHsBinds+   in makeLHsDecl srcSpan hsImplicitBndrs lHsBinds -makeLHsDecl-  :: Ghc.SrcSpan-  -> Ghc.HsImplicitBndrs Ghc.GhcPs (Ghc.LHsType Ghc.GhcPs)-  -> [Ghc.LHsBind Ghc.GhcPs]-  -> Ghc.LHsDecl Ghc.GhcPs+makeLHsDecl ::+  Ghc.SrcSpan ->+  Ghc.LHsSigType Ghc.GhcPs ->+  [Ghc.LHsBind Ghc.GhcPs] ->+  Ghc.LHsDecl Ghc.GhcPs makeLHsDecl srcSpan hsImplicitBndrs lHsBinds =-  Ghc.L srcSpan+  Ghc.reLocA+    . Ghc.L srcSpan     . Ghc.InstD Ghc.noExtField     . Ghc.ClsInstD Ghc.noExtField     $ Ghc.ClsInstDecl-        Ghc.noExtField-        hsImplicitBndrs-        (Ghc.listToBag lHsBinds)-        []-        []-        []-        Nothing+      (Ghc.noAnn, Ghc.NoAnnSortKey)+      hsImplicitBndrs+      (Ghc.listToBag lHsBinds)+      []+      []+      []+      Nothing -makeLHsBind-  :: Ghc.SrcSpan-  -> Ghc.OccName-  -> [Ghc.LPat Ghc.GhcPs]-  -> Ghc.LHsExpr Ghc.GhcPs-  -> Ghc.LHsBind Ghc.GhcPs+makeLHsBind ::+  Ghc.SrcSpan ->+  Ghc.OccName ->+  [Ghc.LPat Ghc.GhcPs] ->+  Ghc.LHsExpr Ghc.GhcPs ->+  Ghc.LHsBind Ghc.GhcPs makeLHsBind srcSpan occName pats =   Hs.funBind srcSpan occName . makeMatchGroup srcSpan occName pats -makeMatchGroup-  :: Ghc.SrcSpan-  -> Ghc.OccName-  -> [Ghc.LPat Ghc.GhcPs]-  -> Ghc.LHsExpr Ghc.GhcPs-  -> Ghc.MatchGroup Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)-makeMatchGroup srcSpan occName lPats hsExpr = Ghc.MG-  Ghc.noExtField-  (Ghc.L srcSpan [Ghc.L srcSpan $ makeMatch srcSpan occName lPats hsExpr])-  Ghc.Generated+makeMatchGroup ::+  Ghc.SrcSpan ->+  Ghc.OccName ->+  [Ghc.LPat Ghc.GhcPs] ->+  Ghc.LHsExpr Ghc.GhcPs ->+  Ghc.MatchGroup Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)+makeMatchGroup srcSpan occName lPats hsExpr =+  Ghc.MG+    Ghc.noExtField+    (Ghc.reLocA $ Ghc.L srcSpan [Ghc.reLocA . Ghc.L srcSpan $ makeMatch srcSpan occName lPats hsExpr])+    Ghc.Generated -makeMatch-  :: Ghc.SrcSpan-  -> Ghc.OccName-  -> [Ghc.LPat Ghc.GhcPs]-  -> Ghc.LHsExpr Ghc.GhcPs-  -> Ghc.Match Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)+makeMatch ::+  Ghc.SrcSpan ->+  Ghc.OccName ->+  [Ghc.LPat Ghc.GhcPs] ->+  Ghc.LHsExpr Ghc.GhcPs ->+  Ghc.Match Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs) makeMatch srcSpan occName lPats =   Ghc.Match-      Ghc.noExtField-      (Ghc.FunRhs-        (Ghc.L srcSpan $ Ghc.Unqual occName)+    Ghc.noAnn+    ( Ghc.FunRhs+        (Ghc.reLocA . Ghc.L srcSpan $ Ghc.Unqual occName)         Ghc.Prefix         Ghc.NoSrcStrict-      )-      lPats+    )+    lPats     . makeGRHSs srcSpan -makeGRHSs-  :: Ghc.SrcSpan-  -> Ghc.LHsExpr Ghc.GhcPs-  -> Ghc.GRHSs Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)+makeGRHSs ::+  Ghc.SrcSpan ->+  Ghc.LHsExpr Ghc.GhcPs ->+  Ghc.GRHSs Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs) makeGRHSs srcSpan hsExpr =-  Ghc.GRHSs Ghc.noExtField [Hs.grhs srcSpan hsExpr]-    . Ghc.L srcSpan-    $ Ghc.EmptyLocalBinds Ghc.noExtField+  Ghc.GRHSs Ghc.emptyComments [Hs.grhs srcSpan hsExpr] $+    Ghc.EmptyLocalBinds Ghc.noExtField  bumpCounter :: IO.MonadIO m => m Word-bumpCounter = IO.liftIO . IORef.atomicModifyIORef' counterRef $ \ n -> (n + 1, n)+bumpCounter = IO.liftIO . IORef.atomicModifyIORef' counterRef $ \n -> (n + 1, n)  counterRef :: IORef.IORef Word counterRef = Unsafe.unsafePerformIO $ IORef.newIORef 0
source/library/Evoke/Generator/FromJSON.hs view
@@ -1,6 +1,7 @@ module Evoke.Generator.FromJSON-  ( generate-  ) where+  ( generate,+  )+where  import qualified Data.List as List import qualified Evoke.Constant.Module as Module@@ -26,95 +27,99 @@    fields <-     mapM (fromField srcSpan modifyFieldName)-    . List.sortOn Field.name-    . concatMap Constructor.fields-    $ Type.constructors type_+      . List.sortOn Field.name+      . concatMap Constructor.fields+      $ Type.constructors type_    applicative <- Common.makeRandomModule Module.controlApplicative   aeson <- Common.makeRandomModule Module.dataAeson   string <- Common.makeRandomModule Module.dataString   object <- Common.makeRandomVariable srcSpan "object_"-  let-    lImportDecls = Hs.importDecls-      srcSpan-      [ (Module.controlApplicative, applicative)-      , (Module.dataAeson, aeson)-      , (Module.dataString, string)-      ]+  let lImportDecls =+        Hs.importDecls+          srcSpan+          [ (Module.controlApplicative, applicative),+            (Module.dataAeson, aeson),+            (Module.dataString, string)+          ] -    bindStmts = fmap-      (\(field, (name, var)) ->-        Hs.bindStmt srcSpan (Hs.varPat srcSpan var)-          . Hs.opApp-              srcSpan-              (Hs.var srcSpan object)-              (Hs.qualVar srcSpan aeson-              . Ghc.mkVarOcc-              $ if Field.isOptional field then ".:?" else ".:"-              )-          . Hs.app srcSpan (Hs.qualVar srcSpan string $ Ghc.mkVarOcc "fromString")-          . Hs.lit srcSpan-          $ Hs.string name-      )-      fields+      bindStmts =+        fmap+          ( \(field, (name, var)) ->+              Hs.bindStmt srcSpan (Hs.varPat srcSpan var)+                . Hs.opApp+                  srcSpan+                  (Hs.var srcSpan object)+                  ( Hs.qualVar srcSpan aeson+                      . Ghc.mkVarOcc+                      $ if Field.isOptional field then ".:?" else ".:"+                  )+                . Hs.app srcSpan (Hs.qualVar srcSpan string $ Ghc.mkVarOcc "fromString")+                . Hs.lit srcSpan+                $ Hs.string name+          )+          fields -    lastStmt =-      Hs.lastStmt srcSpan-        . Hs.app srcSpan (Hs.qualVar srcSpan applicative $ Ghc.mkVarOcc "pure")-        . Hs.recordCon srcSpan (Ghc.L srcSpan $ Constructor.name constructor)-        . Hs.recFields-        $ fmap-            (\(field, (_, var)) ->-              Hs.recField+      lastStmt =+        Hs.lastStmt srcSpan+          . Hs.app srcSpan (Hs.qualVar srcSpan applicative $ Ghc.mkVarOcc "pure")+          . Hs.recordCon srcSpan (Ghc.reLocA . Ghc.L srcSpan $ Constructor.name constructor)+          . Hs.recFields+          $ fmap+            ( \(field, (_, var)) ->+                Hs.recField                   srcSpan                   (Hs.fieldOcc srcSpan . Hs.unqual srcSpan $ Field.name field)-                $ Hs.var srcSpan var+                  $ Hs.var srcSpan var             )             fields -    lHsBind =-      Common.makeLHsBind srcSpan (Ghc.mkVarOcc "parseJSON") []-        . Hs.app+      lHsBind =+        Common.makeLHsBind srcSpan (Ghc.mkVarOcc "parseJSON") []+          . Hs.app             srcSpan-            (Hs.app+            ( Hs.app                 srcSpan                 (Hs.qualVar srcSpan aeson $ Ghc.mkVarOcc "withObject")-            . Hs.lit srcSpan-            . Hs.string-            $ Type.qualifiedName moduleName type_+                . Hs.lit srcSpan+                . Hs.string+                $ Type.qualifiedName moduleName type_             )-        . Hs.par srcSpan-        . Hs.lam srcSpan-        . Hs.mg-        $ Ghc.L+          . Hs.par srcSpan+          . Hs.lam srcSpan+          . Hs.mg+          $ Ghc.L             srcSpan-            [ Hs.match srcSpan Ghc.LambdaExpr [Hs.varPat srcSpan object]-                $ Hs.grhss-                    srcSpan-                    [ Hs.grhs srcSpan+            [ Hs.match srcSpan Ghc.LambdaExpr [Hs.varPat srcSpan object] $+                Hs.grhss+                  srcSpan+                  [ Hs.grhs srcSpan                       . Hs.doExpr srcSpan                       $ bindStmts-                      <> [lastStmt]-                    ]+                        <> [lastStmt]+                  ]             ] -    lHsDecl = Common.makeInstanceDeclaration-      srcSpan-      type_-      aeson-      (Ghc.mkClsOcc "FromJSON")-      [lHsBind]+      lHsDecl =+        Common.makeInstanceDeclaration+          srcSpan+          type_+          aeson+          (Ghc.mkClsOcc "FromJSON")+          [lHsBind]    pure (lImportDecls, [lHsDecl]) -fromField-  :: Ghc.SrcSpan-  -> (String -> Ghc.Hsc String)-  -> Field.Field-  -> Ghc.Hsc (Field.Field, (String, Ghc.LIdP Ghc.GhcPs))+fromField ::+  Ghc.SrcSpan ->+  (String -> Ghc.Hsc String) ->+  Field.Field ->+  Ghc.Hsc (Field.Field, (String, Ghc.LIdP Ghc.GhcPs)) fromField srcSpan modifyFieldName field = do   let fieldName = Field.name field   name <- modifyFieldName $ Ghc.occNameString fieldName-  var <- Common.makeRandomVariable srcSpan . (<> "_") $ Ghc.occNameString-    fieldName+  var <-+    Common.makeRandomVariable srcSpan . (<> "_") $+      Ghc.occNameString+        fieldName   pure (field, (name, var))
source/library/Evoke/Generator/ToJSON.hs view
@@ -1,6 +1,7 @@ module Evoke.Generator.ToJSON-  ( generate-  ) where+  ( generate,+  )+where  import qualified Data.List as List import qualified Evoke.Constant.Module as Module@@ -26,68 +27,69 @@    fieldNames <-     mapM (fromField modifyFieldName)-    . List.sort-    . fmap Field.name-    . concatMap Constructor.fields-    $ Type.constructors type_+      . List.sort+      . fmap Field.name+      . concatMap Constructor.fields+      $ Type.constructors type_    aeson <- Common.makeRandomModule Module.dataAeson   monoid <- Common.makeRandomModule Module.dataMonoid   string <- Common.makeRandomModule Module.dataString   var1 <- Common.makeRandomVariable srcSpan "var_"   var2 <- Common.makeRandomVariable srcSpan "var_"-  let-    lImportDecls = Hs.importDecls-      srcSpan-      [ (Module.dataAeson, aeson)-      , (Module.dataMonoid, monoid)-      , (Module.dataString, string)-      ]+  let lImportDecls =+        Hs.importDecls+          srcSpan+          [ (Module.dataAeson, aeson),+            (Module.dataMonoid, monoid),+            (Module.dataString, string)+          ] -    toPair lRdrName (occName, fieldName) =-      Hs.opApp+      toPair lRdrName (occName, fieldName) =+        Hs.opApp           srcSpan-          (Hs.app srcSpan (Hs.qualVar srcSpan string $ Ghc.mkVarOcc "fromString")-          . Hs.lit srcSpan-          $ Hs.string fieldName+          ( Hs.app srcSpan (Hs.qualVar srcSpan string $ Ghc.mkVarOcc "fromString")+              . Hs.lit srcSpan+              $ Hs.string fieldName           )           (Hs.qualVar srcSpan aeson $ Ghc.mkVarOcc ".=")-        . Hs.app srcSpan (Hs.var srcSpan $ Hs.unqual srcSpan occName)-        $ Hs.var srcSpan lRdrName+          . Hs.app srcSpan (Hs.var srcSpan $ Hs.unqual srcSpan occName)+          $ Hs.var srcSpan lRdrName -    lHsExprs lRdrName = fmap (toPair lRdrName) fieldNames+      lHsExprs lRdrName = fmap (toPair lRdrName) fieldNames -    toJSON =-      Common.makeLHsBind+      toJSON =+        Common.makeLHsBind           srcSpan           (Ghc.mkVarOcc "toJSON")           [Hs.varPat srcSpan var1]-        . Hs.app srcSpan (Hs.qualVar srcSpan aeson $ Ghc.mkVarOcc "object")-        . Hs.explicitList srcSpan-        $ lHsExprs var1+          . Hs.app srcSpan (Hs.qualVar srcSpan aeson $ Ghc.mkVarOcc "object")+          . Hs.explicitList srcSpan+          $ lHsExprs var1 -    toEncoding =-      Common.makeLHsBind+      toEncoding =+        Common.makeLHsBind           srcSpan           (Ghc.mkVarOcc "toEncoding")           [Hs.varPat srcSpan var2]-        . Hs.app srcSpan (Hs.qualVar srcSpan aeson $ Ghc.mkVarOcc "pairs")-        . Hs.par srcSpan-        . Hs.app srcSpan (Hs.qualVar srcSpan monoid $ Ghc.mkVarOcc "mconcat")-        . Hs.explicitList srcSpan-        $ lHsExprs var2+          . Hs.app srcSpan (Hs.qualVar srcSpan aeson $ Ghc.mkVarOcc "pairs")+          . Hs.par srcSpan+          . Hs.app srcSpan (Hs.qualVar srcSpan monoid $ Ghc.mkVarOcc "mconcat")+          . Hs.explicitList srcSpan+          $ lHsExprs var2 -    lHsDecl = Common.makeInstanceDeclaration-      srcSpan-      type_-      aeson-      (Ghc.mkClsOcc "ToJSON")-      [toJSON, toEncoding]+      lHsDecl =+        Common.makeInstanceDeclaration+          srcSpan+          type_+          aeson+          (Ghc.mkClsOcc "ToJSON")+          [toJSON, toEncoding]    pure (lImportDecls, [lHsDecl]) -fromField-  :: (String -> Ghc.Hsc String) -> Ghc.OccName -> Ghc.Hsc (Ghc.OccName, String)+fromField ::+  (String -> Ghc.Hsc String) -> Ghc.OccName -> Ghc.Hsc (Ghc.OccName, String) fromField modifyFieldName occName = do   fieldName <- modifyFieldName $ Ghc.occNameString occName   pure (occName, fieldName)
source/library/Evoke/Generator/ToSchema.hs view
@@ -1,6 +1,7 @@ module Evoke.Generator.ToSchema-  ( generate-  ) where+  ( generate,+  )+where  import qualified Data.List as List import qualified Evoke.Constant.Module as Module@@ -27,9 +28,9 @@    fields <-     mapM (fromField srcSpan modifyFieldName)-    . List.sortOn Field.name-    . concatMap Constructor.fields-    $ Type.constructors type_+      . List.sortOn Field.name+      . concatMap Constructor.fields+      $ Type.constructors type_    applicative <- Common.makeRandomModule Module.controlApplicative   lens <- Common.makeRandomModule Module.controlLens@@ -40,144 +41,155 @@   string <- Common.makeRandomModule Module.dataString   swagger <- Common.makeRandomModule Module.dataSwagger   ignored <- Common.makeRandomVariable srcSpan "_proxy_"-  let-    lImportDecls = Hs.importDecls-      srcSpan-      [ (Module.controlApplicative, applicative)-      , (Module.controlLens, lens)-      , (Module.dataHashMapStrictInsOrd, hashMap)-      , (Module.dataMaybe, dataMaybe)-      , (Module.dataMonoid, monoid)-      , (Module.dataProxy, proxy)-      , (Module.dataString, string)-      , (Module.dataSwagger, swagger)-      ]+  let lImportDecls =+        Hs.importDecls+          srcSpan+          [ (Module.controlApplicative, applicative),+            (Module.controlLens, lens),+            (Module.dataHashMapStrictInsOrd, hashMap),+            (Module.dataMaybe, dataMaybe),+            (Module.dataMonoid, monoid),+            (Module.dataProxy, proxy),+            (Module.dataString, string),+            (Module.dataSwagger, swagger)+          ] -    toBind field var =-      Hs.bindStmt srcSpan (Hs.varPat srcSpan var)-        . Hs.app+      toBind field var =+        Hs.bindStmt srcSpan (Hs.varPat srcSpan var)+          . Hs.app             srcSpan             (Hs.qualVar srcSpan swagger $ Ghc.mkVarOcc "declareSchemaRef")-        . Hs.par srcSpan-        . Ghc.L srcSpan-        . Ghc.ExprWithTySig-            Ghc.noExtField+          . Hs.par srcSpan+          . Ghc.reLocA+          . Ghc.L srcSpan+          . Ghc.ExprWithTySig+            Ghc.noAnn             (Hs.qualVar srcSpan proxy $ Ghc.mkDataOcc "Proxy")-        . Ghc.HsWC Ghc.noExtField-        . Ghc.HsIB Ghc.noExtField-        . Ghc.L srcSpan-        . Ghc.HsAppTy+          . Ghc.HsWC Ghc.noExtField+          . Ghc.reLocA+          . Ghc.L srcSpan+          . Ghc.HsSig Ghc.noExtField Ghc.mkHsOuterImplicit+          . Ghc.reLocA+          . Ghc.L srcSpan+          . Ghc.HsAppTy             Ghc.noExtField             (Hs.qualTyVar srcSpan proxy $ Ghc.mkClsOcc "Proxy")-        . Ghc.L srcSpan-        . Ghc.HsParTy Ghc.noExtField-        . Ghc.L srcSpan-        $ Field.type_ field -- TODO: This requires `ScopedTypeVariables`.--    bindStmts = fmap (\((field, _), var) -> toBind field var) fields+          . Ghc.reLocA+          . Ghc.L srcSpan+          . Ghc.HsParTy Ghc.noAnn+          . Ghc.reLocA+          . Ghc.L srcSpan+          $ Field.type_ field -- TODO: This requires `ScopedTypeVariables`.+      bindStmts = fmap (\((field, _), var) -> toBind field var) fields -    setType =-      Hs.opApp+      setType =+        Hs.opApp           srcSpan           (Hs.qualVar srcSpan swagger $ Ghc.mkVarOcc "type_")           (Hs.qualVar srcSpan lens $ Ghc.mkVarOcc "?~")-        . Hs.qualVar srcSpan swagger-        $ Ghc.mkDataOcc "SwaggerObject"+          . Hs.qualVar srcSpan swagger+          $ Ghc.mkDataOcc "SwaggerObject" -    setProperties =-      Hs.opApp+      setProperties =+        Hs.opApp           srcSpan           (Hs.qualVar srcSpan swagger $ Ghc.mkVarOcc "properties")           (Hs.qualVar srcSpan lens $ Ghc.mkVarOcc ".~")-        . Hs.app srcSpan (Hs.qualVar srcSpan hashMap $ Ghc.mkVarOcc "fromList")-        . Hs.explicitList srcSpan-        $ fmap-            (\((_, name), var) -> Hs.explicitTuple srcSpan $ fmap-              (Hs.tupArg srcSpan)-              [ Hs.app srcSpan (Hs.qualVar srcSpan string $ Ghc.mkVarOcc "fromString")-              . Hs.lit srcSpan-              $ Hs.string name-              , Hs.var srcSpan var-              ]+          . Hs.app srcSpan (Hs.qualVar srcSpan hashMap $ Ghc.mkVarOcc "fromList")+          . Hs.explicitList srcSpan+          $ fmap+            ( \((_, name), var) ->+                Hs.explicitTuple srcSpan $+                  fmap+                    Hs.tupArg+                    [ Hs.app srcSpan (Hs.qualVar srcSpan string $ Ghc.mkVarOcc "fromString")+                        . Hs.lit srcSpan+                        $ Hs.string name,+                      Hs.var srcSpan var+                    ]             )             fields -    setRequired =-      Hs.opApp+      setRequired =+        Hs.opApp           srcSpan           (Hs.qualVar srcSpan swagger $ Ghc.mkVarOcc "required")           (Hs.qualVar srcSpan lens $ Ghc.mkVarOcc ".~")-        . Hs.explicitList srcSpan-        . fmap-            (Hs.app srcSpan (Hs.qualVar srcSpan string $ Ghc.mkVarOcc "fromString")-            . Hs.lit srcSpan-            . Hs.string-            . snd-            . fst+          . Hs.explicitList srcSpan+          . fmap+            ( Hs.app srcSpan (Hs.qualVar srcSpan string $ Ghc.mkVarOcc "fromString")+                . Hs.lit srcSpan+                . Hs.string+                . snd+                . fst             )-        $ filter (not . Field.isOptional . fst . fst) fields+          $ filter (not . Field.isOptional . fst . fst) fields -    lastStmt =-      Hs.lastStmt srcSpan-        . Hs.app srcSpan (Hs.qualVar srcSpan applicative $ Ghc.mkVarOcc "pure")-        . Hs.par srcSpan-        . Hs.app+      lastStmt =+        Hs.lastStmt srcSpan+          . Hs.app srcSpan (Hs.qualVar srcSpan applicative $ Ghc.mkVarOcc "pure")+          . Hs.par srcSpan+          . Hs.app             srcSpan-            (Hs.app+            ( Hs.app                 srcSpan                 (Hs.qualVar srcSpan swagger $ Ghc.mkDataOcc "NamedSchema")-            . Hs.par srcSpan-            . Hs.app-                srcSpan-                (Hs.qualVar srcSpan dataMaybe $ Ghc.mkDataOcc "Just")-            . Hs.par srcSpan-            . Hs.app srcSpan (Hs.qualVar srcSpan string $ Ghc.mkVarOcc "fromString")-            . Hs.lit srcSpan-            . Hs.string-            $ Type.qualifiedName moduleName type_+                . Hs.par srcSpan+                . Hs.app+                  srcSpan+                  (Hs.qualVar srcSpan dataMaybe $ Ghc.mkDataOcc "Just")+                . Hs.par srcSpan+                . Hs.app srcSpan (Hs.qualVar srcSpan string $ Ghc.mkVarOcc "fromString")+                . Hs.lit srcSpan+                . Hs.string+                $ Type.qualifiedName moduleName type_             )-        . Hs.par srcSpan-        . makePipeline srcSpan lens [setType, setProperties, setRequired]-        . Hs.qualVar srcSpan monoid-        $ Ghc.mkVarOcc "mempty"+          . Hs.par srcSpan+          . makePipeline srcSpan lens [setType, setProperties, setRequired]+          . Hs.qualVar srcSpan monoid+          $ Ghc.mkVarOcc "mempty" -    lHsBind =-      Common.makeLHsBind+      lHsBind =+        Common.makeLHsBind           srcSpan           (Ghc.mkVarOcc "declareNamedSchema")           [Hs.varPat srcSpan ignored]-        . Hs.doExpr srcSpan-        $ bindStmts-        <> [lastStmt]+          . Hs.doExpr srcSpan+          $ bindStmts+            <> [lastStmt] -    lHsDecl = Common.makeInstanceDeclaration-      srcSpan-      type_-      swagger-      (Ghc.mkClsOcc "ToSchema")-      [lHsBind]+      lHsDecl =+        Common.makeInstanceDeclaration+          srcSpan+          type_+          swagger+          (Ghc.mkClsOcc "ToSchema")+          [lHsBind]    pure (lImportDecls, [lHsDecl]) -fromField-  :: Ghc.SrcSpan-  -> (String -> Ghc.Hsc String)-  -> Field.Field-  -> Ghc.Hsc ((Field.Field, String), Ghc.LIdP Ghc.GhcPs)+fromField ::+  Ghc.SrcSpan ->+  (String -> Ghc.Hsc String) ->+  Field.Field ->+  Ghc.Hsc ((Field.Field, String), Ghc.LIdP Ghc.GhcPs) fromField srcSpan modifyFieldName field = do   let fieldName = Field.name field   name <- modifyFieldName $ Ghc.occNameString fieldName-  var <- Common.makeRandomVariable srcSpan . (<> "_") $ Ghc.occNameString-    fieldName+  var <-+    Common.makeRandomVariable srcSpan . (<> "_") $+      Ghc.occNameString+        fieldName   pure ((field, name), var) -makePipeline-  :: Ghc.SrcSpan-  -> Ghc.ModuleName-  -> [Ghc.LHsExpr Ghc.GhcPs]-  -> Ghc.LHsExpr Ghc.GhcPs-  -> Ghc.LHsExpr Ghc.GhcPs+makePipeline ::+  Ghc.SrcSpan ->+  Ghc.ModuleName ->+  [Ghc.LHsExpr Ghc.GhcPs] ->+  Ghc.LHsExpr Ghc.GhcPs ->+  Ghc.LHsExpr Ghc.GhcPs makePipeline srcSpan m es e = case es of   [] -> e-  h : t -> makePipeline srcSpan m t-    $ Hs.opApp srcSpan e (Hs.qualVar srcSpan m $ Ghc.mkVarOcc "&") h+  h : t ->+    makePipeline srcSpan m t $+      Hs.opApp srcSpan e (Hs.qualVar srcSpan m $ Ghc.mkVarOcc "&") h
source/library/Evoke/Hs.hs view
@@ -1,197 +1,201 @@ module Evoke.Hs-  ( app-  , bindStmt-  , doExpr-  , explicitList-  , explicitTuple-  , fieldOcc-  , funBind-  , grhs-  , grhss-  , importDecls-  , lam-  , lastStmt-  , lit-  , match-  , mg-  , opApp-  , par-  , qual-  , qualTyVar-  , qualVar-  , recField-  , recFields-  , recordCon-  , string-  , tupArg-  , tyVar-  , unqual-  , var-  , varPat-  ) where+  ( app,+    bindStmt,+    doExpr,+    explicitList,+    explicitTuple,+    fieldOcc,+    funBind,+    grhs,+    grhss,+    importDecls,+    lam,+    lastStmt,+    lit,+    match,+    mg,+    opApp,+    par,+    qual,+    qualTyVar,+    qualVar,+    recField,+    recFields,+    recordCon,+    string,+    tupArg,+    tyVar,+    unqual,+    var,+    varPat,+  )+where  import qualified GHC.Hs as Ghc import qualified GHC.Plugins as Ghc+import qualified GHC.Types.SourceText as Ghc -app-  :: Ghc.SrcSpan-  -> Ghc.LHsExpr Ghc.GhcPs-  -> Ghc.LHsExpr Ghc.GhcPs-  -> Ghc.LHsExpr Ghc.GhcPs-app s f = Ghc.L s . Ghc.HsApp Ghc.noExtField f+app ::+  Ghc.SrcSpan ->+  Ghc.LHsExpr Ghc.GhcPs ->+  Ghc.LHsExpr Ghc.GhcPs ->+  Ghc.LHsExpr Ghc.GhcPs+app s f = Ghc.reLocA . Ghc.L s . Ghc.HsApp Ghc.noAnn f -bindStmt-  :: Ghc.SrcSpan-  -> Ghc.LPat Ghc.GhcPs-  -> Ghc.LHsExpr Ghc.GhcPs-  -> Ghc.LStmt Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)+bindStmt ::+  Ghc.SrcSpan ->+  Ghc.LPat Ghc.GhcPs ->+  Ghc.LHsExpr Ghc.GhcPs ->+  Ghc.LStmt Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs) bindStmt s p e =-  Ghc.L s $ Ghc.BindStmt Ghc.noExtField p e+  Ghc.reLocA . Ghc.L s $ Ghc.BindStmt Ghc.noAnn p e  doExpr :: Ghc.SrcSpan -> [Ghc.ExprLStmt Ghc.GhcPs] -> Ghc.LHsExpr Ghc.GhcPs-doExpr s = Ghc.L s . Ghc.HsDo Ghc.noExtField (Ghc.DoExpr Nothing) . Ghc.L s+doExpr s = Ghc.reLocA . Ghc.L s . Ghc.HsDo Ghc.noAnn (Ghc.DoExpr Nothing) . Ghc.reLocA . Ghc.L s -explicitList-  :: Ghc.SrcSpan -> [Ghc.LHsExpr Ghc.GhcPs] -> Ghc.LHsExpr Ghc.GhcPs-explicitList s = Ghc.L s . Ghc.ExplicitList Ghc.noExtField Nothing+explicitList ::+  Ghc.SrcSpan -> [Ghc.LHsExpr Ghc.GhcPs] -> Ghc.LHsExpr Ghc.GhcPs+explicitList s = Ghc.reLocA . Ghc.L s . Ghc.ExplicitList Ghc.noAnn -explicitTuple-  :: Ghc.SrcSpan -> [Ghc.LHsTupArg Ghc.GhcPs] -> Ghc.LHsExpr Ghc.GhcPs-explicitTuple s xs = Ghc.L s $ Ghc.ExplicitTuple Ghc.noExtField xs Ghc.Boxed+explicitTuple ::+  Ghc.SrcSpan -> [Ghc.HsTupArg Ghc.GhcPs] -> Ghc.LHsExpr Ghc.GhcPs+explicitTuple s xs = Ghc.reLocA . Ghc.L s $ Ghc.ExplicitTuple Ghc.noAnn xs Ghc.Boxed  fieldOcc :: Ghc.SrcSpan -> Ghc.LIdP Ghc.GhcPs -> Ghc.LFieldOcc Ghc.GhcPs fieldOcc s = Ghc.L s . Ghc.FieldOcc Ghc.noExtField -funBind-  :: Ghc.SrcSpan-  -> Ghc.OccName-  -> Ghc.MatchGroup Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)-  -> Ghc.LHsBind Ghc.GhcPs+funBind ::+  Ghc.SrcSpan ->+  Ghc.OccName ->+  Ghc.MatchGroup Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs) ->+  Ghc.LHsBind Ghc.GhcPs funBind s f g =-  Ghc.L s $ Ghc.FunBind Ghc.noExtField (unqual s f) g []+  Ghc.reLocA . Ghc.L s $ Ghc.FunBind Ghc.noExtField (unqual s f) g [] -grhs-  :: Ghc.SrcSpan-  -> Ghc.LHsExpr Ghc.GhcPs-  -> Ghc.LGRHS Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)-grhs s = Ghc.L s . Ghc.GRHS Ghc.noExtField []+grhs ::+  Ghc.SrcSpan ->+  Ghc.LHsExpr Ghc.GhcPs ->+  Ghc.LGRHS Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)+grhs s = Ghc.L s . Ghc.GRHS Ghc.noAnn [] -grhss-  :: Ghc.SrcSpan-  -> [Ghc.LGRHS Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)]-  -> Ghc.GRHSs Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)-grhss s xs =-  Ghc.GRHSs Ghc.noExtField xs . Ghc.L s $ Ghc.EmptyLocalBinds Ghc.noExtField+grhss ::+  Ghc.SrcSpan ->+  [Ghc.LGRHS Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)] ->+  Ghc.GRHSs Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)+grhss _ xs =+  Ghc.GRHSs Ghc.emptyComments xs $ Ghc.EmptyLocalBinds Ghc.noExtField -importDecl-  :: Ghc.SrcSpan-  -> Ghc.ModuleName-  -> Ghc.ModuleName-  -> Ghc.LImportDecl Ghc.GhcPs-importDecl s m n = Ghc.L s $ Ghc.ImportDecl-  Ghc.noExtField-  Ghc.NoSourceText-  (Ghc.L s m)-  Nothing-  Ghc.NotBoot-  False-  Ghc.QualifiedPre-  False-  (Just $ Ghc.L s n)-  Nothing+importDecl ::+  Ghc.SrcSpan ->+  Ghc.ModuleName ->+  Ghc.ModuleName ->+  Ghc.LImportDecl Ghc.GhcPs+importDecl s m n =+  Ghc.reLocA . Ghc.L s $+    Ghc.ImportDecl+      Ghc.noAnn+      Ghc.NoSourceText+      (Ghc.reLocA $ Ghc.L s m)+      Nothing+      Ghc.NotBoot+      False+      Ghc.QualifiedPre+      False+      (Just . Ghc.reLocA $ Ghc.L s n)+      Nothing -importDecls-  :: Ghc.SrcSpan-  -> [(Ghc.ModuleName, Ghc.ModuleName)]-  -> [Ghc.LImportDecl Ghc.GhcPs]+importDecls ::+  Ghc.SrcSpan ->+  [(Ghc.ModuleName, Ghc.ModuleName)] ->+  [Ghc.LImportDecl Ghc.GhcPs] importDecls = fmap . uncurry . importDecl -lam-  :: Ghc.SrcSpan-  -> Ghc.MatchGroup Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)-  -> Ghc.LHsExpr Ghc.GhcPs-lam s = Ghc.L s . Ghc.HsLam Ghc.noExtField+lam ::+  Ghc.SrcSpan ->+  Ghc.MatchGroup Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs) ->+  Ghc.LHsExpr Ghc.GhcPs+lam s = Ghc.reLocA . Ghc.L s . Ghc.HsLam Ghc.noExtField -lastStmt-  :: Ghc.SrcSpan-  -> Ghc.LHsExpr Ghc.GhcPs-  -> Ghc.LStmt Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)-lastStmt s e = Ghc.L s $ Ghc.LastStmt Ghc.noExtField e Nothing noSyntaxExpr+lastStmt ::+  Ghc.SrcSpan ->+  Ghc.LHsExpr Ghc.GhcPs ->+  Ghc.LStmt Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)+lastStmt s e = Ghc.reLocA . Ghc.L s $ Ghc.LastStmt Ghc.noExtField e Nothing noSyntaxExpr  lit :: Ghc.SrcSpan -> Ghc.HsLit Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs-lit s = Ghc.L s . Ghc.HsLit Ghc.noExtField+lit s = Ghc.reLocA . Ghc.L s . Ghc.HsLit Ghc.noAnn  noSyntaxExpr :: Ghc.SyntaxExpr Ghc.GhcPs noSyntaxExpr = Ghc.noSyntaxExpr -match-  :: Ghc.SrcSpan-  -> Ghc.HsMatchContext (Ghc.NoGhcTc Ghc.GhcPs)-  -> [Ghc.LPat Ghc.GhcPs]-  -> Ghc.GRHSs Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)-  -> Ghc.LMatch Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)-match s c ps = Ghc.L s . Ghc.Match Ghc.noExtField c ps+match ::+  Ghc.SrcSpan ->+  Ghc.HsMatchContext (Ghc.NoGhcTc Ghc.GhcPs) ->+  [Ghc.LPat Ghc.GhcPs] ->+  Ghc.GRHSs Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs) ->+  Ghc.LMatch Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)+match s c ps = Ghc.reLocA . Ghc.L s . Ghc.Match Ghc.noAnn c ps -mg-  :: Ghc.Located [Ghc.LMatch Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)]-  -> Ghc.MatchGroup Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)-mg ms = Ghc.MG Ghc.noExtField ms Ghc.Generated+mg ::+  Ghc.Located [Ghc.LMatch Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)] ->+  Ghc.MatchGroup Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)+mg ms = Ghc.MG Ghc.noExtField (Ghc.reLocA ms) Ghc.Generated -opApp-  :: Ghc.SrcSpan-  -> Ghc.LHsExpr Ghc.GhcPs-  -> Ghc.LHsExpr Ghc.GhcPs-  -> Ghc.LHsExpr Ghc.GhcPs-  -> Ghc.LHsExpr Ghc.GhcPs-opApp s l o = Ghc.L s . Ghc.OpApp Ghc.noExtField l o+opApp ::+  Ghc.SrcSpan ->+  Ghc.LHsExpr Ghc.GhcPs ->+  Ghc.LHsExpr Ghc.GhcPs ->+  Ghc.LHsExpr Ghc.GhcPs ->+  Ghc.LHsExpr Ghc.GhcPs+opApp s l o = Ghc.reLocA . Ghc.L s . Ghc.OpApp Ghc.noAnn l o  par :: Ghc.SrcSpan -> Ghc.LHsExpr Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs-par s = Ghc.L s . Ghc.HsPar Ghc.noExtField+par s = Ghc.reLocA . Ghc.L s . Ghc.HsPar Ghc.noAnn  qual :: Ghc.SrcSpan -> Ghc.ModuleName -> Ghc.OccName -> Ghc.LIdP Ghc.GhcPs-qual s m = Ghc.L s . Ghc.mkRdrQual m+qual s m = Ghc.reLocA . Ghc.L s . Ghc.mkRdrQual m -qualTyVar-  :: Ghc.SrcSpan -> Ghc.ModuleName -> Ghc.OccName -> Ghc.LHsType Ghc.GhcPs+qualTyVar ::+  Ghc.SrcSpan -> Ghc.ModuleName -> Ghc.OccName -> Ghc.LHsType Ghc.GhcPs qualTyVar s m = tyVar s . qual s m -qualVar-  :: Ghc.SrcSpan -> Ghc.ModuleName -> Ghc.OccName -> Ghc.LHsExpr Ghc.GhcPs+qualVar ::+  Ghc.SrcSpan -> Ghc.ModuleName -> Ghc.OccName -> Ghc.LHsExpr Ghc.GhcPs qualVar s m = var s . qual s m -recFields-  :: [Ghc.LHsRecField Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)]-  -> Ghc.HsRecFields Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)+recFields ::+  [Ghc.LHsRecField Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)] ->+  Ghc.HsRecFields Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs) recFields = flip Ghc.HsRecFields Nothing -recField-  :: Ghc.SrcSpan-  -> Ghc.LFieldOcc Ghc.GhcPs-  -> Ghc.LHsExpr Ghc.GhcPs-  -> Ghc.LHsRecField Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)-recField s f e = Ghc.L s $ Ghc.HsRecField f e False+recField ::+  Ghc.SrcSpan ->+  Ghc.LFieldOcc Ghc.GhcPs ->+  Ghc.LHsExpr Ghc.GhcPs ->+  Ghc.LHsRecField Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)+recField s f e = Ghc.reLocA . Ghc.L s $ Ghc.HsRecField Ghc.noAnn f e False -recordCon-  :: Ghc.SrcSpan-  -> Ghc.LIdP Ghc.GhcPs-  -> Ghc.HsRecordBinds Ghc.GhcPs-  -> Ghc.LHsExpr Ghc.GhcPs-recordCon s c = Ghc.L s . Ghc.RecordCon Ghc.noExtField c+recordCon ::+  Ghc.SrcSpan ->+  Ghc.LIdP Ghc.GhcPs ->+  Ghc.HsRecordBinds Ghc.GhcPs ->+  Ghc.LHsExpr Ghc.GhcPs+recordCon s c = Ghc.reLocA . Ghc.L s . Ghc.RecordCon Ghc.noAnn c  string :: String -> Ghc.HsLit Ghc.GhcPs string = Ghc.HsString Ghc.NoSourceText . Ghc.mkFastString -tupArg :: Ghc.SrcSpan -> Ghc.LHsExpr Ghc.GhcPs -> Ghc.LHsTupArg Ghc.GhcPs-tupArg s = Ghc.L s . Ghc.Present Ghc.noExtField+tupArg :: Ghc.LHsExpr Ghc.GhcPs -> Ghc.HsTupArg Ghc.GhcPs+tupArg = Ghc.Present Ghc.noAnn  tyVar :: Ghc.SrcSpan -> Ghc.LIdP Ghc.GhcPs -> Ghc.LHsType Ghc.GhcPs-tyVar s = Ghc.L s . Ghc.HsTyVar Ghc.noExtField Ghc.NotPromoted+tyVar s = Ghc.reLocA . Ghc.L s . Ghc.HsTyVar Ghc.noAnn Ghc.NotPromoted  unqual :: Ghc.SrcSpan -> Ghc.OccName -> Ghc.LIdP Ghc.GhcPs-unqual s = Ghc.L s . Ghc.mkRdrUnqual+unqual s = Ghc.reLocA . Ghc.L s . Ghc.mkRdrUnqual  var :: Ghc.SrcSpan -> Ghc.LIdP Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs-var s = Ghc.L s . Ghc.HsVar Ghc.noExtField+var s = Ghc.reLocA . Ghc.L s . Ghc.HsVar Ghc.noExtField  varPat :: Ghc.SrcSpan -> Ghc.LIdP Ghc.GhcPs -> Ghc.LPat Ghc.GhcPs-varPat s = Ghc.L s . Ghc.VarPat Ghc.noExtField+varPat s = Ghc.reLocA . Ghc.L s . Ghc.VarPat Ghc.noExtField
source/library/Evoke/Hsc.hs view
@@ -1,25 +1,28 @@ module Evoke.Hsc-  ( addWarning-  , throwError-  ) where+  ( addWarning,+    throwError,+  )+where -import qualified GHC.Data.Bag as Ghc import qualified Control.Monad.IO.Class as IO-import qualified GHC.Utils.Error as Ghc+import qualified GHC as Ghc+import qualified GHC.Data.Bag as Ghc+import qualified GHC.Driver.Errors as Ghc import qualified GHC.Plugins as Ghc+import qualified GHC.Utils.Error as Ghc  -- | Adds a warning, which only causes compilation to fail if @-Werror@ is -- enabled.-addWarning :: Ghc.SrcSpan -> Ghc.MsgDoc -> Ghc.Hsc ()+addWarning :: Ghc.SrcSpan -> Ghc.SDoc -> Ghc.Hsc () addWarning srcSpan msgDoc = do+  logger <- Ghc.getLogger   dynFlags <- Ghc.getDynFlags   IO.liftIO-    . Ghc.printOrThrowWarnings dynFlags+    . Ghc.printOrThrowWarnings logger dynFlags     . Ghc.unitBag-    $ Ghc.mkPlainWarnMsg dynFlags srcSpan msgDoc+    $ Ghc.mkPlainWarnMsg srcSpan msgDoc  -- | Throws an error, which will cause compilation to fail.-throwError :: Ghc.SrcSpan -> Ghc.MsgDoc -> Ghc.Hsc a+throwError :: Ghc.SrcSpan -> Ghc.SDoc -> Ghc.Hsc a throwError srcSpan msgDoc = do-  dynFlags <- Ghc.getDynFlags-  Ghc.throwOneError $ Ghc.mkPlainErrMsg dynFlags srcSpan msgDoc+  Ghc.throwOneError $ Ghc.mkPlainWarnMsg srcSpan msgDoc
source/library/Evoke/Options.hs view
@@ -1,6 +1,7 @@ module Evoke.Options-  ( parse-  ) where+  ( parse,+  )+where  import qualified Control.Monad as Monad import qualified Evoke.Hsc as Hsc@@ -11,18 +12,17 @@ -- appropriate. Returns the list of parsed options. parse :: [Console.OptDescr a] -> [String] -> Ghc.SrcSpan -> Ghc.Hsc [a] parse optDescrs strings srcSpan = do-  let-    (xs, args, opts, errs) = Console.getOpt' Console.Permute optDescrs strings-  Monad.forM_ opts-    $ Hsc.addWarning srcSpan-    . Ghc.text-    . mappend "unknown option: "-    . quote-  Monad.forM_ args-    $ Hsc.addWarning srcSpan-    . Ghc.text-    . mappend "unexpected argument: "-    . quote+  let (xs, args, opts, errs) = Console.getOpt' Console.Permute optDescrs strings+  Monad.forM_ opts $+    Hsc.addWarning srcSpan+      . Ghc.text+      . mappend "unknown option: "+      . quote+  Monad.forM_ args $+    Hsc.addWarning srcSpan+      . Ghc.text+      . mappend "unexpected argument: "+      . quote   Monad.unless (null errs)     . Hsc.throwError srcSpan     . Ghc.vcat
source/library/Evoke/Type/Config.hs view
@@ -1,26 +1,27 @@ module Evoke.Type.Config-  ( Config(..)-  , fromFlags-  ) where+  ( Config (..),+    fromFlags,+  )+where  import qualified Data.List as List import qualified Evoke.Type.Flag as Flag  data Config = Config-  { help :: Bool-  , verbose :: Bool-  , version :: Bool+  { help :: Bool,+    verbose :: Bool,+    version :: Bool   }   deriving (Eq, Show)  initial :: Config-initial = Config { help = False, verbose = False, version = False }+initial = Config {help = False, verbose = False, version = False}  fromFlags :: Foldable t => t Flag.Flag -> Config fromFlags = List.foldl' applyFlag initial  applyFlag :: Config -> Flag.Flag -> Config applyFlag config flag = case flag of-  Flag.Help -> config { help = True }-  Flag.Verbose -> config { verbose = True }-  Flag.Version -> config { version = True }+  Flag.Help -> config {help = True}+  Flag.Verbose -> config {verbose = True}+  Flag.Version -> config {version = True}
source/library/Evoke/Type/Constructor.hs view
@@ -1,7 +1,8 @@ module Evoke.Type.Constructor-  ( Constructor(..)-  , make-  ) where+  ( Constructor (..),+    make,+  )+where  import qualified Control.Monad as Monad import qualified Evoke.Hsc as Hsc@@ -10,8 +11,8 @@ import qualified GHC.Plugins as Ghc  data Constructor = Constructor-  { name :: Ghc.IdP Ghc.GhcPs-  , fields :: [Field.Field]+  { name :: Ghc.IdP Ghc.GhcPs,+    fields :: [Field.Field]   }  make :: Ghc.SrcSpan -> Ghc.LConDecl Ghc.GhcPs -> Ghc.Hsc Constructor@@ -27,4 +28,4 @@       (lFieldOccs, lHsType) <- case Ghc.unLoc lConDeclField of         Ghc.ConDeclField _ x y _ -> pure (x, y)       mapM (Field.make srcSpan lHsType) lFieldOccs-  pure Constructor { name = Ghc.unLoc lIdP, fields = theFields }+  pure Constructor {name = Ghc.unLoc lIdP, fields = theFields}
source/library/Evoke/Type/Field.hs view
@@ -1,30 +1,31 @@ module Evoke.Type.Field-  ( Field(..)-  , make-  , isOptional-  ) where+  ( Field (..),+    make,+    isOptional,+  )+where  import qualified Evoke.Hsc as Hsc import qualified GHC.Hs as Ghc import qualified GHC.Plugins as Ghc  data Field = Field-  { name :: Ghc.OccName-  , type_ :: Ghc.HsType Ghc.GhcPs+  { name :: Ghc.OccName,+    type_ :: Ghc.HsType Ghc.GhcPs   } -make-  :: Ghc.SrcSpan-  -> Ghc.LHsType Ghc.GhcPs-  -> Ghc.LFieldOcc Ghc.GhcPs-  -> Ghc.Hsc Field+make ::+  Ghc.SrcSpan ->+  Ghc.LHsType Ghc.GhcPs ->+  Ghc.LFieldOcc Ghc.GhcPs ->+  Ghc.Hsc Field make srcSpan lHsType lFieldOcc = do   lRdrName <- case Ghc.unLoc lFieldOcc of     Ghc.FieldOcc _ x -> pure x   occName <- case Ghc.unLoc lRdrName of     Ghc.Unqual x -> pure x     _ -> Hsc.throwError srcSpan $ Ghc.text "unsupported RdrName"-  pure Field { name = occName, type_ = Ghc.unLoc lHsType }+  pure Field {name = occName, type_ = Ghc.unLoc lHsType}  isOptional :: Field -> Bool isOptional field = case type_ field of
source/library/Evoke/Type/Flag.hs view
@@ -1,7 +1,8 @@ module Evoke.Type.Flag-  ( Flag(..)-  , options-  ) where+  ( Flag (..),+    options,+  )+where  import qualified System.Console.GetOpt as Console @@ -14,18 +15,18 @@ options :: [Console.OptDescr Flag] options =   [ Console.Option-    ['h', '?']-    ["help"]-    (Console.NoArg Help)-    "shows this help message and exits"-  , Console.Option-    ['v']-    ["version"]-    (Console.NoArg Version)-    "shows the version number and exits"-  , Console.Option-    []-    ["verbose"]-    (Console.NoArg Verbose)-    "outputs derived instances"+      ['h', '?']+      ["help"]+      (Console.NoArg Help)+      "shows this help message and exits",+    Console.Option+      ['v']+      ["version"]+      (Console.NoArg Version)+      "shows the version number and exits",+    Console.Option+      []+      ["verbose"]+      (Console.NoArg Verbose)+      "outputs derived instances"   ]
source/library/Evoke/Type/Type.hs view
@@ -1,8 +1,9 @@ module Evoke.Type.Type-  ( Type(..)-  , make-  , qualifiedName-  ) where+  ( Type (..),+    make,+    qualifiedName,+  )+where  import qualified Control.Monad as Monad import qualified Evoke.Hsc as Hsc@@ -11,17 +12,17 @@ import qualified GHC.Plugins as Ghc  data Type = Type-  { name :: Ghc.IdP Ghc.GhcPs-  , variables :: [Ghc.IdP Ghc.GhcPs]-  , constructors :: [Constructor.Constructor]+  { name :: Ghc.IdP Ghc.GhcPs,+    variables :: [Ghc.IdP Ghc.GhcPs],+    constructors :: [Constructor.Constructor]   } -make-  :: Ghc.LIdP Ghc.GhcPs-  -> Ghc.LHsQTyVars Ghc.GhcPs-  -> [Ghc.LConDecl Ghc.GhcPs]-  -> Ghc.SrcSpan-  -> Ghc.Hsc Type+make ::+  Ghc.LIdP Ghc.GhcPs ->+  Ghc.LHsQTyVars Ghc.GhcPs ->+  [Ghc.LConDecl Ghc.GhcPs] ->+  Ghc.SrcSpan ->+  Ghc.Hsc Type make lIdP lHsQTyVars lConDecls srcSpan = do   lHsTyVarBndrs <- case lHsQTyVars of     Ghc.HsQTvs _ hsq_explicit -> pure hsq_explicit@@ -30,15 +31,17 @@       Ghc.UserTyVar _ _ var -> pure $ Ghc.unLoc var       _ -> Hsc.throwError srcSpan $ Ghc.text "unknown LHsTyVarBndr"   theConstructors <- mapM (Constructor.make srcSpan) lConDecls-  pure Type-    { name = Ghc.unLoc lIdP-    , variables = theVariables-    , constructors = theConstructors-    }+  pure+    Type+      { name = Ghc.unLoc lIdP,+        variables = theVariables,+        constructors = theConstructors+      }  qualifiedName :: Ghc.ModuleName -> Type -> String-qualifiedName moduleName type_ = mconcat-  [ Ghc.moduleNameString moduleName-  , "."-  , Ghc.occNameString . Ghc.rdrNameOcc $ name type_-  ]+qualifiedName moduleName type_ =+  mconcat+    [ Ghc.moduleNameString moduleName,+      ".",+      Ghc.occNameString . Ghc.rdrNameOcc $ name type_+    ]
source/test-suite/Main.hs view
@@ -1,6 +1,6 @@-{-# OPTIONS_GHC -fplugin=Evoke #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fplugin=Evoke #-}  import qualified Data.Aeson as Aeson import qualified Data.Aeson.QQ.Simple as Aeson@@ -10,61 +10,63 @@ import qualified Test.QuickCheck as QuickCheck  main :: IO ()-main = Unit.runTestTTAndExit $ Unit.test-  [ testToJSON T1C1 { t1c1f1 = 1 } [Aeson.aesonQQ| { "t1c1f1": 1 } |]-  , testToJSON-    T2C1 { t2c1f1 = 2, t2c1f2 = 3 }-    [Aeson.aesonQQ| { "t2c1f1": 2, "t2c1f2": 3 } |]-  , testToJSON T3C1 { t3c1f1aA = 4 } [Aeson.aesonQQ| { "t3c1f1a_a": 4 } |]-  , testToJSON T4C1 { t4c1f1aA = 5 } [Aeson.aesonQQ| { "t4c1f1a-a": 5 } |]-  , testToJSON T5C1 { t5c1f1 = 6 } [Aeson.aesonQQ| { "T5c1f1": 6 } |]-  , testToJSON T6C1 { t6c1f1 = 7 } [Aeson.aesonQQ| { "f1": 7 } |]-  , testToJSON T7C1 { t7c1f1 = 8 } [Aeson.aesonQQ| { "F1": 8 } |]-  , testToJSON T8C1 { t8c1f1 = 9 } [Aeson.aesonQQ| { "f1": 9 } |]-  , testToJSON-    (T9C1 { t9c1f1 = 10 } :: T9 X)-    [Aeson.aesonQQ| { "t9c1f1": 10 } |]-  , testToJSON-    T10C1 { t10c1f1 = 11 :: Int }-    [Aeson.aesonQQ| { "t10c1f1": 11 } |]-  , testToJSON T11C1 { t11c1f1A = 12 } [Aeson.aesonQQ| { "a": 12 } |]-  , testToJSON-    (T12C1 { t12c1f1 = 13, t12c1f2 = 14 } :: T12 X Int X Int X)-    [Aeson.aesonQQ| { "t12c1f1": 13, "t12c1f2": 14 } |]-  , testToJSON-    T13C1 { t13c1f1 = 15, t13c1f2 = 16 }-    [Aeson.aesonQQ| { "t13c1f1": 15, "t13c1f2": 16 } |]-  , testToJSON T14C1 { t14c1f1 = Just 17 } [Aeson.aesonQQ| { "t14c1f1": 17 } |]-  , testToJSON T15C1 { t15c1f1 = 18 } [Aeson.aesonQQ| { "t15c1": 18 } |]-  , testToJSON T16C1 { t16c1f1 = 19 } [Aeson.aesonQQ| { "one": 19 } |]-  , checkInstances (Proxy.Proxy :: Proxy.Proxy T1)-  , checkInstances (Proxy.Proxy :: Proxy.Proxy T2)-  , checkInstances (Proxy.Proxy :: Proxy.Proxy T3)-  , checkInstances (Proxy.Proxy :: Proxy.Proxy T4)-  , checkInstances (Proxy.Proxy :: Proxy.Proxy T5)-  , checkInstances (Proxy.Proxy :: Proxy.Proxy T6)-  , checkInstances (Proxy.Proxy :: Proxy.Proxy T7)-  , checkInstances (Proxy.Proxy :: Proxy.Proxy T8)-  , checkInstances (Proxy.Proxy :: Proxy.Proxy (T9 X))-  , checkInstances (Proxy.Proxy :: Proxy.Proxy (T10 Int))-  , checkInstances (Proxy.Proxy :: Proxy.Proxy T11)-  , checkInstances (Proxy.Proxy :: Proxy.Proxy (T12 X Int X Int X))-  , checkInstances (Proxy.Proxy :: Proxy.Proxy T13)-  , checkInstances (Proxy.Proxy :: Proxy.Proxy T14)-  , checkInstances (Proxy.Proxy :: Proxy.Proxy T15)-  , checkInstances (Proxy.Proxy :: Proxy.Proxy T16)-  ]+main =+  Unit.runTestTTAndExit $+    Unit.test+      [ testToJSON T1C1 {t1c1f1 = 1} [Aeson.aesonQQ| { "t1c1f1": 1 } |],+        testToJSON+          T2C1 {t2c1f1 = 2, t2c1f2 = 3}+          [Aeson.aesonQQ| { "t2c1f1": 2, "t2c1f2": 3 } |],+        testToJSON T3C1 {t3c1f1aA = 4} [Aeson.aesonQQ| { "t3c1f1a_a": 4 } |],+        testToJSON T4C1 {t4c1f1aA = 5} [Aeson.aesonQQ| { "t4c1f1a-a": 5 } |],+        testToJSON T5C1 {t5c1f1 = 6} [Aeson.aesonQQ| { "T5c1f1": 6 } |],+        testToJSON T6C1 {t6c1f1 = 7} [Aeson.aesonQQ| { "f1": 7 } |],+        testToJSON T7C1 {t7c1f1 = 8} [Aeson.aesonQQ| { "F1": 8 } |],+        testToJSON T8C1 {t8c1f1 = 9} [Aeson.aesonQQ| { "f1": 9 } |],+        testToJSON+          (T9C1 {t9c1f1 = 10} :: T9 X)+          [Aeson.aesonQQ| { "t9c1f1": 10 } |],+        testToJSON+          T10C1 {t10c1f1 = 11 :: Int}+          [Aeson.aesonQQ| { "t10c1f1": 11 } |],+        testToJSON T11C1 {t11c1f1A = 12} [Aeson.aesonQQ| { "a": 12 } |],+        testToJSON+          (T12C1 {t12c1f1 = 13, t12c1f2 = 14} :: T12 X Int X Int X)+          [Aeson.aesonQQ| { "t12c1f1": 13, "t12c1f2": 14 } |],+        testToJSON+          T13C1 {t13c1f1 = 15, t13c1f2 = 16}+          [Aeson.aesonQQ| { "t13c1f1": 15, "t13c1f2": 16 } |],+        testToJSON T14C1 {t14c1f1 = Just 17} [Aeson.aesonQQ| { "t14c1f1": 17 } |],+        testToJSON T15C1 {t15c1f1 = 18} [Aeson.aesonQQ| { "t15c1": 18 } |],+        testToJSON T16C1 {t16c1f1 = 19} [Aeson.aesonQQ| { "one": 19 } |],+        checkInstances (Proxy.Proxy :: Proxy.Proxy T1),+        checkInstances (Proxy.Proxy :: Proxy.Proxy T2),+        checkInstances (Proxy.Proxy :: Proxy.Proxy T3),+        checkInstances (Proxy.Proxy :: Proxy.Proxy T4),+        checkInstances (Proxy.Proxy :: Proxy.Proxy T5),+        checkInstances (Proxy.Proxy :: Proxy.Proxy T6),+        checkInstances (Proxy.Proxy :: Proxy.Proxy T7),+        checkInstances (Proxy.Proxy :: Proxy.Proxy T8),+        checkInstances (Proxy.Proxy :: Proxy.Proxy (T9 X)),+        checkInstances (Proxy.Proxy :: Proxy.Proxy (T10 Int)),+        checkInstances (Proxy.Proxy :: Proxy.Proxy T11),+        checkInstances (Proxy.Proxy :: Proxy.Proxy (T12 X Int X Int X)),+        checkInstances (Proxy.Proxy :: Proxy.Proxy T13),+        checkInstances (Proxy.Proxy :: Proxy.Proxy T14),+        checkInstances (Proxy.Proxy :: Proxy.Proxy T15),+        checkInstances (Proxy.Proxy :: Proxy.Proxy T16)+      ] -checkInstances-  :: ( QuickCheck.Arbitrary a-     , Eq a-     , Aeson.FromJSON a-     , Show a-     , Aeson.ToJSON a-     , Swagger.ToSchema a-     )-  => Proxy.Proxy a-  -> Unit.Test+checkInstances ::+  ( QuickCheck.Arbitrary a,+    Eq a,+    Aeson.FromJSON a,+    Show a,+    Aeson.ToJSON a,+    Swagger.ToSchema a+  ) =>+  Proxy.Proxy a ->+  Unit.Test checkInstances proxy = Unit.TestCase $ do   value <- QuickCheck.generate QuickCheck.arbitrary   Aeson.decode (Aeson.encode value) Unit.@?= Just value@@ -87,8 +89,8 @@  -- multiple fields data T2 = T2C1-  { t2c1f1 :: Int-  , t2c1f2 :: Int+  { t2c1f1 :: Int,+    t2c1f2 :: Int   }   deriving (Eq, Show)   deriving (Arbitrary, FromJSON, ToJSON, ToSchema) via "Evoke"@@ -158,8 +160,8 @@  -- multiple type variables data T12 a b c d e = T12C1-  { t12c1f1 :: d-  , t12c1f2 :: b+  { t12c1f1 :: d,+    t12c1f2 :: b   }   deriving (Eq, Show)   deriving (Arbitrary, FromJSON, ToJSON, ToSchema) via "Evoke"