packages feed

evoke (empty) → 0.2021.8.25

raw patch · 18 files changed

+1898/−0 lines, 18 filesdep +HUnitdep +QuickCheckdep +aeson

Dependencies added: HUnit, QuickCheck, aeson, base, evoke, ghc, insert-ordered-containers, lens, random, swagger2, text

Files

+ LICENSE.txt view
@@ -0,0 +1,19 @@+Copyright (c) 2021 Taylor Fausak++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ evoke.cabal view
@@ -0,0 +1,68 @@+cabal-version: >= 1.10++name: evoke+version: 0.2021.8.25+synopsis: A GHC plugin to derive instances.+description: Evoke is a GHC plugin to derive instances.++build-type: Simple+category: Plugin+license-file: LICENSE.txt+license: MIT+maintainer: Taylor Fausak++source-repository head+  location: https://github.com/tfausak/evoke+  type: git++library+  build-depends:+    base >= 4.14.1 && < 4.15+    , ghc >= 8.10.4 && < 8.11+    , random >= 1.2.0 && < 1.3+  default-language: Haskell2010+  exposed-modules:+    Evoke+    Evoke.Constant.Module+    Evoke.Generator.Arbitrary+    Evoke.Generator.Common+    Evoke.Generator.FromJSON+    Evoke.Generator.ToJSON+    Evoke.Generator.ToSchema+    Evoke.Hs+    Evoke.Hsc+    Evoke.Options+    Evoke.Type.Config+    Evoke.Type.Constructor+    Evoke.Type.Field+    Evoke.Type.Flag+    Evoke.Type.Type+  ghc-options:+    -Weverything+    -Wno-all-missed-specialisations+    -Wno-implicit-prelude+    -Wno-missing-deriving-strategies+    -Wno-missing-exported-signatures+    -Wno-missing-safe-haskell-mode+    -Wno-prepositive-qualified-module+    -Wno-safe+    -Wno-unsafe+  hs-source-dirs: src/lib+  other-modules: Paths_evoke++test-suite test+  build-depends:+    base+    , aeson+    , evoke+    , HUnit >= 1.6.2 && < 1.7+    , insert-ordered-containers >= 0.2.5 && < 0.3+    , lens >= 4.19.2 && < 4.20+    , QuickCheck >= 2.14.2 && < 2.15+    , swagger2 >= 2.6 && < 2.7+    , text >= 1.2.4 && < 1.3+  default-language: Haskell2010+  ghc-options: -rtsopts -threaded+  hs-source-dirs: src/test+  main-is: Main.hs+  type: exitcode-stdio-1.0
+ src/lib/Evoke.hs view
@@ -0,0 +1,385 @@+module Evoke+  ( plugin+  ) where++import qualified Control.Monad as Monad+import qualified Control.Monad.IO.Class as IO+import qualified Data.Bifunctor as Bifunctor+import qualified Data.Maybe as Maybe+import qualified Data.Version as Version+import qualified Evoke.Generator.Arbitrary as Arbitrary+import qualified Evoke.Generator.Common as Common+import qualified Evoke.Generator.FromJSON as FromJSON+import qualified Evoke.Generator.ToJSON as ToJSON+import qualified Evoke.Generator.ToSchema as ToSchema+import qualified Evoke.Hsc as Hsc+import qualified Evoke.Options as Options+import qualified Evoke.Type.Config as Config+import qualified Evoke.Type.Flag as Flag+import qualified GHC.Hs as Ghc+import qualified GhcPlugins as Ghc+import qualified Paths_evoke as This+import qualified System.Console.GetOpt as Console++-- | The compiler plugin. You can enable this plugin with the following pragma:+--+-- > {-# OPTIONS_GHC -fplugin=Evoke #-}+--+-- This plugin accepts some options. Pass @-fplugin-opt=Evoke:--help@ to see+-- what they are. For example:+--+-- > {-# OPTIONS_GHC -fplugin=Evoke -fplugin-opt=Evoke:--help #-}+--+-- Once this plugin is enabled, you can use it by deriving instances like this:+--+-- > data Person = Person+-- >   { name :: String+-- >   , age :: Int+-- >   } 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>.+plugin :: Ghc.Plugin+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+-- a new parsed module to replace the old one.+--+-- 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 commandLineOptions modSummary hsParsedModule = do+  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)+    . Hsc.throwError srcSpan+    . Ghc.vcat+    . fmap Ghc.text+    . lines+    $ Console.usageInfo ("Evoke version " <> version) Flag.options+  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 }++-- | This package's version number as a string.+version :: String+version = Version.showVersion This.version++-- | This is the start of the plumbing functions. Our goal is to take the+-- parsed module, find any relevant deriving clauses, and replace them with+-- generated instances. This means we need to walk the tree of the parsed+-- module looking for relevant deriving clauses. When we find them, we're going+-- to remove them and emit new declarations (and imports), which need to be+-- inserted back into the parsed module tree.+--+-- 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.GhcPs+  -> Ghc.Hsc (LHsModule Ghc.GhcPs)+handleLHsModule config moduleName lHsModule = do+  hsModule <- handleHsModule config moduleName $ Ghc.unLoc lHsModule+  pure $ Ghc.mapLoc (const hsModule) lHsModule++-- | Most GHC types have type aliases for their located versions. For some+-- reason the module type doesn't.+type LHsModule pass = Ghc.Located (Ghc.HsModule pass)++-- | See 'handleLHsModule' and 'handleLHsSigType'.+handleHsModule+  :: Config.Config+  -> Ghc.ModuleName+  -> Ghc.HsModule Ghc.GhcPs+  -> Ghc.Hsc (Ghc.HsModule Ghc.GhcPs)+handleHsModule config moduleName hsModule = do+  (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 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 moduleName lHsDecl = case Ghc.unLoc lHsDecl of+  Ghc.TyClD xTyClD tyClDecl1 -> do+    (tyClDecl2, (lImportDecls, lHsDecls)) <- handleTyClDecl+      config+      moduleName+      tyClDecl1+    pure+      ( 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 moduleName tyClDecl = case tyClDecl of+  Ghc.DataDecl tcdDExt tcdLName tcdTyVars tcdFixity tcdDataDefn -> do+    (hsDataDefn, (lImportDecls, lHsDecls)) <- handleHsDataDefn+      config+      moduleName+      tcdLName+      tcdTyVars+      tcdDataDefn+    pure+      ( 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 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+        pure+          ( Ghc.HsDataDefn+            dd_ext+            dd_ND+            dd_ctxt+            dd_cType+            dd_kindSig+            dd_cons+            hsDeriving+          , (lImportDecls, lHsDecls)+          )+    _ -> pure (hsDataDefn, ([], []))++-- | 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 moduleName lIdP lHsQTyVars lConDecls hsDeriving = do+  (lHsDerivingClauses, (lImportDecls, lHsDecls)) <-+    handleLHsDerivingClauses config moduleName lIdP lHsQTyVars lConDecls+      $ Ghc.unLoc hsDeriving+  pure+    ( Ghc.mapLoc (const lHsDerivingClauses) hsDeriving+    , (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+    pure+      . Bifunctor.bimap+          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+    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))+    _ -> pure (Just lHsDerivingClause, ([], []))++-- | This plugin only fires on specific deriving strategies. In particular it+-- looks for clauses like this:+--+-- > deriving C via "Evoke ..."+--+-- 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 mLDerivStrategy = do+  lDerivStrategy <- mLDerivStrategy+  lHsSigType <- case Ghc.unLoc lDerivStrategy of+    Ghc.ViaStrategy x -> Just x+    _ -> Nothing+  lHsType <- case lHsSigType of+    Ghc.HsIB _ x -> Just x+    _ -> Nothing+  hsTyLit <- case Ghc.unLoc lHsType of+    Ghc.HsTyLit _ x -> Just x+    _ -> Nothing+  fastString <- case hsTyLit of+    Ghc.HsStrTy _ x -> Just x+    _ -> Nothing+  case words $ Ghc.unpackFS fastString of+    "Evoke" : x -> Just x+    _ -> 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+    pure . Bifunctor.bimap mconcat mconcat $ unzip tuples++-- | This is the main workhorse of the plugin. By the time things get here,+-- everything has already been plumbed correctly. (See 'handleLHsModule' for+-- details.) This function is responsible for actually generating the instance.+-- 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+        _ -> Ghc.getLoc lIdP+    (lImportDecls, lHsDecls) <- case getGenerator lHsSigType of+      Just generate ->+        generate moduleName lIdP lHsQTyVars lConDecls options srcSpan+      Nothing -> Hsc.throwError srcSpan $ Ghc.text "unsupported type class"++    Monad.when (Config.verbose config) $ 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++    pure (lImportDecls, lHsDecls)++getGenerator :: Ghc.LHsSigType Ghc.GhcPs -> Maybe Common.Generator+getGenerator lHsSigType = do+  className <- getClassName lHsSigType+  lookup className generators++generators :: [(String, Common.Generator)]+generators =+  [ ("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+    _ -> Nothing+  lIdP <- case Ghc.unLoc lHsType of+    Ghc.HsTyVar _ _ x -> Just x+    _ -> Nothing+  case Ghc.unLoc lIdP of+    Ghc.Unqual x -> Just $ Ghc.occNameString x+    _ -> Nothing
+ src/lib/Evoke/Constant/Module.hs view
@@ -0,0 +1,46 @@+{- hlint ignore "Use camelCase" -}++module Evoke.Constant.Module+  ( control_applicative+  , control_lens+  , data_aeson+  , data_hashMap_strict_insOrd+  , data_maybe+  , data_monoid+  , data_proxy+  , data_swagger+  , data_text+  , test_quickCheck+  ) where++import qualified Module as Ghc++control_applicative :: Ghc.ModuleName+control_applicative = Ghc.mkModuleName "Control.Applicative"++control_lens :: Ghc.ModuleName+control_lens = Ghc.mkModuleName "Control.Lens"++data_aeson :: Ghc.ModuleName+data_aeson = Ghc.mkModuleName "Data.Aeson"++data_hashMap_strict_insOrd :: Ghc.ModuleName+data_hashMap_strict_insOrd = Ghc.mkModuleName "Data.HashMap.Strict.InsOrd"++data_maybe :: Ghc.ModuleName+data_maybe = Ghc.mkModuleName "Data.Maybe"++data_monoid :: Ghc.ModuleName+data_monoid = Ghc.mkModuleName "Data.Monoid"++data_proxy :: Ghc.ModuleName+data_proxy = Ghc.mkModuleName "Data.Proxy"++data_swagger :: Ghc.ModuleName+data_swagger = Ghc.mkModuleName "Data.Swagger"++data_text :: Ghc.ModuleName+data_text = Ghc.mkModuleName "Data.Text"++test_quickCheck :: Ghc.ModuleName+test_quickCheck = Ghc.mkModuleName "Test.QuickCheck"
+ src/lib/Evoke/Generator/Arbitrary.hs view
@@ -0,0 +1,79 @@+module Evoke.Generator.Arbitrary+  ( generate+  ) where++import qualified Evoke.Constant.Module as Module+import qualified Evoke.Generator.Common as Common+import qualified Evoke.Hs as Hs+import qualified Evoke.Hsc as Hsc+import qualified Evoke.Type.Constructor as Constructor+import qualified Evoke.Type.Field as Field+import qualified Evoke.Type.Type as Type+import qualified GHC.Hs as Ghc+import qualified GhcPlugins as Ghc++generate :: Common.Generator+generate _ lIdP lHsQTyVars lConDecls _ srcSpan = do+  type_ <- Type.make lIdP lHsQTyVars lConDecls srcSpan+  constructor <- case Type.constructors type_ of+    [x] -> pure x+    _ -> Hsc.throwError srcSpan $ Ghc.text "requires exactly one constructor"+  fields <-+    mapM (fromField srcSpan) . concatMap Constructor.fields $ Type.constructors+      type_++  applicative <- Common.makeRandomModule Module.control_applicative+  quickCheck <- Common.makeRandomModule Module.test_quickCheck+  let+    lImportDecls = Hs.importDecls+      srcSpan+      [ (Module.control_applicative, applicative)+      , (Module.test_quickCheck, quickCheck)+      ]++    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+                  srcSpan+                  (Hs.fieldOcc srcSpan . Hs.unqual srcSpan $ Field.name field)+                $ Hs.var srcSpan var+            )+            fields++    lHsBind =+      Common.makeLHsBind srcSpan (Ghc.mkVarOcc "arbitrary") []+        . Hs.doExpr srcSpan+        $ bindStmts+        <> [lastStmt]++    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 srcSpan field = do+  var <-+    Common.makeRandomVariable srcSpan+    . (<> "_")+    . Ghc.occNameString+    $ Field.name field+  pure (field, var)
+ src/lib/Evoke/Generator/Common.hs view
@@ -0,0 +1,304 @@+module Evoke.Generator.Common+  ( Generator+  , applyAll+  , fieldNameOptions+  , makeInstanceDeclaration+  , makeLHsBind+  , makeRandomModule+  , makeRandomVariable+  ) where++import qualified Bag as Ghc+import qualified Data.Char as Char+import qualified Data.List as List+import qualified Data.Maybe as Maybe+import qualified Data.Word as Word+import qualified Evoke.Hs as Hs+import qualified Evoke.Hsc as Hsc+import qualified Evoke.Type.Constructor as Constructor+import qualified Evoke.Type.Field as Field+import qualified Evoke.Type.Type as Type+import qualified GHC.Hs as Ghc+import qualified GhcPlugins as Ghc+import qualified System.Console.GetOpt as Console+import qualified System.Random as Random+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])++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+    []+    ["strip"]+    (Console.ReqArg+      (\prefix s1 -> case List.stripPrefix prefix s1 of+        Nothing ->+          Hsc.throwError srcSpan+            . Ghc.text+            $ show prefix+            <> " is not a prefix of "+            <> show s1+        Just s2 -> pure s2+      )+      "PREFIX"+    )+    ""+  , Console.Option [] ["title"] (Console.NoArg $ pure . upper) ""+  ]++-- | Applies all the monadic functions in order beginning with some starting+-- value.+applyAll :: Monad m => [a -> m a] -> a -> m a+applyAll fs x = case fs of+  [] -> pure x+  f : gs -> do+    y <- f x+    applyAll gs y++-- | Converts the first character into upper case.+upper :: String -> String+upper = overFirst Char.toUpper++-- | Converts the first character into lower case.+lower :: String -> String+lower = overFirst Char.toLower++overFirst :: (a -> a) -> [a] -> [a]+overFirst f xs = case xs of+  x : ys -> f x : ys+  _ -> xs++-- | Converts the string into kebab case.+--+-- >>> kebab "DoReMi"+-- "do-re-mi"+kebab :: String -> String+kebab = camelTo '-'++-- | Converts the string into snake case.+--+-- >>> snake "DoReMi"+-- "do_re_mi"+snake :: String -> String+snake = camelTo '_'++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++makeLHsType+  :: Ghc.SrcSpan+  -> Ghc.ModuleName+  -> Ghc.OccName+  -> Type.Type+  -> Ghc.LHsType Ghc.GhcPs+makeLHsType srcSpan moduleName className =+  Ghc.L srcSpan+    . Ghc.HsAppTy+        Ghc.noExtField+        (Ghc.L srcSpan+        . Ghc.HsTyVar Ghc.noExtField Ghc.NotPromoted+        . 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++    loc :: a -> Ghc.Located a+    loc = Ghc.L srcSpan++    initial :: Ghc.LHsType Ghc.GhcPs+    initial = loc . Ghc.HsTyVar ext 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++    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++makeHsContext+  :: Ghc.SrcSpan+  -> Ghc.ModuleName+  -> Ghc.OccName+  -> Type.Type+  -> [Ghc.LHsType Ghc.GhcPs]+makeHsContext srcSpan moduleName className =+  fmap+      (Ghc.L srcSpan+      . Ghc.HsAppTy+          Ghc.noExtField+          (Ghc.L srcSpan+          . Ghc.HsTyVar Ghc.noExtField Ghc.NotPromoted+          . Ghc.L srcSpan+          $ Ghc.Qual moduleName className+          )+      . Ghc.L srcSpan+      . Ghc.HsTyVar Ghc.noExtField Ghc.NotPromoted+      . Ghc.L srcSpan+      . Ghc.Unqual+      )+    . List.nub+    . Maybe.mapMaybe+        (\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 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++-- | Makes a random variable name using the given prefix.+makeRandomVariable :: Ghc.SrcSpan -> String -> Ghc.Hsc (Ghc.LIdP Ghc.GhcPs)+makeRandomVariable srcSpan prefix = do+  word16 <- randomWord16+  pure . Ghc.L srcSpan . Ghc.Unqual . Ghc.mkVarOcc $ Printf.printf+    "%s%04x"+    prefix+    word16++randomWord16 :: Ghc.Hsc Word.Word16+randomWord16 = Random.randomIO++-- | Makes a random module name. This will convert any periods to underscores+-- and add a unique suffix.+--+-- >>> makeRandomModule "Data.Aeson"+-- "Data_Aeson_01ef"+makeRandomModule :: Ghc.ModuleName -> Ghc.Hsc Ghc.ModuleName+makeRandomModule moduleName = do+  word16 <- randomWord16+  pure . Ghc.mkModuleName $ Printf.printf+    "%s_%04x"+    (underscoreAll moduleName)+    word16++underscoreAll :: Ghc.ModuleName -> String+underscoreAll = fmap underscoreOne . Ghc.moduleNameString++underscoreOne :: Char -> Char+underscoreOne c = case c of+  '.' -> '_'+  _ -> c++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++makeLHsDecl+  :: Ghc.SrcSpan+  -> Ghc.HsImplicitBndrs Ghc.GhcPs (Ghc.LHsType Ghc.GhcPs)+  -> [Ghc.LHsBind Ghc.GhcPs]+  -> Ghc.LHsDecl Ghc.GhcPs+makeLHsDecl srcSpan hsImplicitBndrs lHsBinds =+  Ghc.L srcSpan+    . Ghc.InstD Ghc.noExtField+    . Ghc.ClsInstD Ghc.noExtField+    $ Ghc.ClsInstDecl+        Ghc.noExtField+        hsImplicitBndrs+        (Ghc.listToBag lHsBinds)+        []+        []+        []+        Nothing++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++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.Prefix+        Ghc.NoSrcStrict+      )+      lPats+    . makeGRHSs srcSpan++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
+ src/lib/Evoke/Generator/FromJSON.hs view
@@ -0,0 +1,118 @@+module Evoke.Generator.FromJSON+  ( generate+  ) where++import qualified Evoke.Constant.Module as Module+import qualified Evoke.Generator.Common as Common+import qualified Evoke.Hs as Hs+import qualified Evoke.Hsc as Hsc+import qualified Evoke.Options as Options+import qualified Evoke.Type.Constructor as Constructor+import qualified Evoke.Type.Field as Field+import qualified Evoke.Type.Type as Type+import qualified GHC.Hs as Ghc+import qualified GhcPlugins as Ghc++generate :: Common.Generator+generate moduleName lIdP lHsQTyVars lConDecls options srcSpan = do+  type_ <- Type.make lIdP lHsQTyVars lConDecls srcSpan+  constructor <- case Type.constructors type_ of+    [x] -> pure x+    _ -> Hsc.throwError srcSpan $ Ghc.text "requires exactly one constructor"+  modifyFieldName <-+    Common.applyAll+      <$> Options.parse (Common.fieldNameOptions srcSpan) options srcSpan++  fields <-+    mapM (fromField srcSpan modifyFieldName)+    . concatMap Constructor.fields+    $ Type.constructors type_++  applicative <- Common.makeRandomModule Module.control_applicative+  aeson <- Common.makeRandomModule Module.data_aeson+  text <- Common.makeRandomModule Module.data_text+  object <- Common.makeRandomVariable srcSpan "object_"+  let+    lImportDecls = Hs.importDecls+      srcSpan+      [ (Module.control_applicative, applicative)+      , (Module.data_aeson, aeson)+      , (Module.data_text, text)+      ]++    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 text $ Ghc.mkVarOcc "pack")+          . 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+                  srcSpan+                  (Hs.fieldOcc srcSpan . Hs.unqual srcSpan $ Field.name field)+                $ Hs.var srcSpan var+            )+            fields++    lHsBind =+      Common.makeLHsBind srcSpan (Ghc.mkVarOcc "parseJSON") []+        . Hs.app+            srcSpan+            (Hs.app+                srcSpan+                (Hs.qualVar srcSpan aeson $ Ghc.mkVarOcc "withObject")+            . Hs.lit srcSpan+            . Hs.string+            $ Type.qualifiedName moduleName type_+            )+        . 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.doExpr srcSpan+                      $ bindStmts+                      <> [lastStmt]+                    ]+            ]++    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 srcSpan modifyFieldName field = do+  let fieldName = Field.name field+  name <- modifyFieldName $ Ghc.occNameString fieldName+  var <- Common.makeRandomVariable srcSpan . (<> "_") $ Ghc.occNameString+    fieldName+  pure (field, (name, var))
+ src/lib/Evoke/Generator/ToJSON.hs view
@@ -0,0 +1,91 @@+module Evoke.Generator.ToJSON+  ( generate+  ) where++import qualified Evoke.Constant.Module as Module+import qualified Evoke.Generator.Common as Common+import qualified Evoke.Hs as Hs+import qualified Evoke.Hsc as Hsc+import qualified Evoke.Options as Options+import qualified Evoke.Type.Constructor as Constructor+import qualified Evoke.Type.Field as Field+import qualified Evoke.Type.Type as Type+import qualified GhcPlugins as Ghc++generate :: Common.Generator+generate _ lIdP lHsQTyVars lConDecls options srcSpan = do+  type_ <- Type.make lIdP lHsQTyVars lConDecls srcSpan+  case Type.constructors type_ of+    [_] -> pure ()+    _ -> Hsc.throwError srcSpan $ Ghc.text "requires exactly one constructor"++  modifyFieldName <-+    Common.applyAll+      <$> Options.parse (Common.fieldNameOptions srcSpan) options srcSpan++  fieldNames <-+    mapM (fromField modifyFieldName)+    . fmap Field.name+    . concatMap Constructor.fields+    $ Type.constructors type_++  aeson <- Common.makeRandomModule Module.data_aeson+  monoid <- Common.makeRandomModule Module.data_monoid+  text <- Common.makeRandomModule Module.data_text+  var1 <- Common.makeRandomVariable srcSpan "var_"+  var2 <- Common.makeRandomVariable srcSpan "var_"+  let+    lImportDecls = Hs.importDecls+      srcSpan+      [ (Module.data_aeson, aeson)+      , (Module.data_monoid, monoid)+      , (Module.data_text, text)+      ]++    toPair lRdrName (occName, fieldName) =+      Hs.opApp+          srcSpan+          (Hs.app srcSpan (Hs.qualVar srcSpan text $ Ghc.mkVarOcc "pack")+          . 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++    lHsExprs lRdrName = fmap (toPair lRdrName) fieldNames++    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++    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++    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 modifyFieldName occName = do+  fieldName <- modifyFieldName $ Ghc.occNameString occName+  pure (occName, fieldName)
+ src/lib/Evoke/Generator/ToSchema.hs view
@@ -0,0 +1,181 @@+module Evoke.Generator.ToSchema+  ( generate+  ) where++import qualified Evoke.Constant.Module as Module+import qualified Evoke.Generator.Common as Common+import qualified Evoke.Hs as Hs+import qualified Evoke.Hsc as Hsc+import qualified Evoke.Options as Options+import qualified Evoke.Type.Constructor as Constructor+import qualified Evoke.Type.Field as Field+import qualified Evoke.Type.Type as Type+import qualified GHC.Hs as Ghc+import qualified GhcPlugins as Ghc++generate :: Common.Generator+generate moduleName lIdP lHsQTyVars lConDecls options srcSpan = do+  type_ <- Type.make lIdP lHsQTyVars lConDecls srcSpan+  case Type.constructors type_ of+    [_] -> pure ()+    _ -> Hsc.throwError srcSpan $ Ghc.text "requires exactly one constructor"++  modifyFieldName <-+    Common.applyAll+      <$> Options.parse (Common.fieldNameOptions srcSpan) options srcSpan++  fields <-+    mapM (fromField srcSpan modifyFieldName)+    . concatMap Constructor.fields+    $ Type.constructors type_++  applicative <- Common.makeRandomModule Module.control_applicative+  lens <- Common.makeRandomModule Module.control_lens+  hashMap <- Common.makeRandomModule Module.data_hashMap_strict_insOrd+  dataMaybe <- Common.makeRandomModule Module.data_maybe+  monoid <- Common.makeRandomModule Module.data_monoid+  proxy <- Common.makeRandomModule Module.data_proxy+  swagger <- Common.makeRandomModule Module.data_swagger+  text <- Common.makeRandomModule Module.data_text+  ignored <- Common.makeRandomVariable srcSpan "_proxy_"+  let+    lImportDecls = Hs.importDecls+      srcSpan+      [ (Module.control_applicative, applicative)+      , (Module.control_lens, lens)+      , (Module.data_hashMap_strict_insOrd, hashMap)+      , (Module.data_maybe, dataMaybe)+      , (Module.data_monoid, monoid)+      , (Module.data_proxy, proxy)+      , (Module.data_swagger, swagger)+      , (Module.data_text, text)+      ]++    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.qualVar srcSpan proxy $ Ghc.mkDataOcc "Proxy")+        . Ghc.HsWC Ghc.noExtField+        . Ghc.HsIB Ghc.noExtField+        . 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++    setType =+      Hs.opApp+          srcSpan+          (Hs.qualVar srcSpan swagger $ Ghc.mkVarOcc "type_")+          (Hs.qualVar srcSpan lens $ Ghc.mkVarOcc "?~")+        . Hs.qualVar srcSpan swagger+        $ Ghc.mkDataOcc "SwaggerObject"++    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 text $ Ghc.mkVarOcc "pack")+              . Hs.lit srcSpan+              $ Hs.string name+              , Hs.var srcSpan var+              ]+            )+            fields++    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 text $ Ghc.mkVarOcc "pack")+            . Hs.lit srcSpan+            . Hs.string+            . snd+            . fst+            )+        $ 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+            srcSpan+            (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 text $ Ghc.mkVarOcc "pack")+            . 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"++    lHsBind =+      Common.makeLHsBind+          srcSpan+          (Ghc.mkVarOcc "declareNamedSchema")+          [Hs.varPat srcSpan ignored]+        . Hs.doExpr srcSpan+        $ bindStmts+        <> [lastStmt]++    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 srcSpan modifyFieldName field = do+  let fieldName = Field.name field+  name <- modifyFieldName $ 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 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
+ src/lib/Evoke/Hs.hs view
@@ -0,0 +1,198 @@+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++import qualified GHC.Hs as Ghc+import qualified GhcPlugins as Ghc+import qualified TcEvidence 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++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 noSyntaxExpr noSyntaxExpr++doExpr :: Ghc.SrcSpan -> [Ghc.ExprLStmt Ghc.GhcPs] -> Ghc.LHsExpr Ghc.GhcPs+doExpr s = Ghc.L s . Ghc.HsDo Ghc.noExtField Ghc.DoExpr . Ghc.L s++explicitList+  :: Ghc.SrcSpan -> [Ghc.LHsExpr Ghc.GhcPs] -> Ghc.LHsExpr Ghc.GhcPs+explicitList s = Ghc.L s . Ghc.ExplicitList Ghc.noExtField Nothing++explicitTuple+  :: Ghc.SrcSpan -> [Ghc.LHsTupArg Ghc.GhcPs] -> Ghc.LHsExpr Ghc.GhcPs+explicitTuple s xs = Ghc.L s $ Ghc.ExplicitTuple Ghc.noExtField 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 s f g =+  Ghc.L s $ Ghc.FunBind Ghc.noExtField (unqual s f) g Ghc.WpHole []++grhs+  :: Ghc.SrcSpan+  -> Ghc.LHsExpr Ghc.GhcPs+  -> Ghc.LGRHS Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)+grhs s = Ghc.L s . Ghc.GRHS Ghc.noExtField []++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++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+  False+  False+  Ghc.QualifiedPre+  False+  (Just $ Ghc.L s n)+  Nothing++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++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 False noSyntaxExpr++lit :: Ghc.SrcSpan -> Ghc.HsLit Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs+lit s = Ghc.L s . Ghc.HsLit Ghc.noExtField++noSyntaxExpr :: Ghc.SyntaxExpr Ghc.GhcPs+noSyntaxExpr = Ghc.SyntaxExpr Ghc.noExpr [] Ghc.WpHole++match+  :: Ghc.SrcSpan+  -> Ghc.HsMatchContext Ghc.RdrName+  -> [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++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++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++par :: Ghc.SrcSpan -> Ghc.LHsExpr Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs+par s = Ghc.L s . Ghc.HsPar Ghc.noExtField++qual :: Ghc.SrcSpan -> Ghc.ModuleName -> Ghc.OccName -> Ghc.LIdP Ghc.GhcPs+qual s m = Ghc.L s . Ghc.mkRdrQual m++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 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 = 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++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++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++tyVar :: Ghc.SrcSpan -> Ghc.LIdP Ghc.GhcPs -> Ghc.LHsType Ghc.GhcPs+tyVar s = Ghc.L s . Ghc.HsTyVar Ghc.noExtField Ghc.NotPromoted++unqual :: Ghc.SrcSpan -> Ghc.OccName -> Ghc.LIdP Ghc.GhcPs+unqual s = 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++varPat :: Ghc.SrcSpan -> Ghc.LIdP Ghc.GhcPs -> Ghc.LPat Ghc.GhcPs+varPat s = Ghc.L s . Ghc.VarPat Ghc.noExtField
+ src/lib/Evoke/Hsc.hs view
@@ -0,0 +1,25 @@+module Evoke.Hsc+  ( addWarning+  , throwError+  ) where++import qualified Bag as Ghc+import qualified Control.Monad.IO.Class as IO+import qualified ErrUtils as Ghc+import qualified GhcPlugins as Ghc++-- | Adds a warning, which only causes compilation to fail if @-Werror@ is+-- enabled.+addWarning :: Ghc.SrcSpan -> Ghc.MsgDoc -> Ghc.Hsc ()+addWarning srcSpan msgDoc = do+  dynFlags <- Ghc.getDynFlags+  IO.liftIO+    . Ghc.printOrThrowWarnings dynFlags+    . Ghc.unitBag+    $ Ghc.mkPlainWarnMsg dynFlags srcSpan msgDoc++-- | Throws an error, which will cause compilation to fail.+throwError :: Ghc.SrcSpan -> Ghc.MsgDoc -> Ghc.Hsc a+throwError srcSpan msgDoc = do+  dynFlags <- Ghc.getDynFlags+  Ghc.throwOneError $ Ghc.mkPlainErrMsg dynFlags srcSpan msgDoc
+ src/lib/Evoke/Options.hs view
@@ -0,0 +1,39 @@+module Evoke.Options+  ( parse+  ) where++import qualified Control.Monad as Monad+import qualified Evoke.Hsc as Hsc+import qualified GhcPlugins as Ghc+import qualified System.Console.GetOpt as Console++-- | Parses command line options. Adds warnings and throws errors as+-- 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+  Monad.unless (null errs)+    . Hsc.throwError srcSpan+    . Ghc.vcat+    . fmap Ghc.text+    . lines+    $ mconcat errs+  pure xs++-- | Quotes a string using GHC's weird quoting format.+--+-- >>> quote "thing"+-- "`thing'"+quote :: String -> String+quote string = "`" <> string <> "'"
+ src/lib/Evoke/Type/Config.hs view
@@ -0,0 +1,26 @@+module Evoke.Type.Config+  ( 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+  }+  deriving (Eq, Show)++initial :: Config+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 }
+ src/lib/Evoke/Type/Constructor.hs view
@@ -0,0 +1,31 @@+module Evoke.Type.Constructor+  ( Constructor(..)+  , make+  ) where++import qualified Control.Monad as Monad+import qualified Evoke.Hsc as Hsc+import qualified Evoke.Type.Field as Field+import qualified GHC.Hs as Ghc+import qualified GhcPlugins as Ghc++data Constructor = Constructor+  { name :: Ghc.IdP Ghc.GhcPs+  , fields :: [Field.Field]+  }++make :: Ghc.SrcSpan -> Ghc.LConDecl Ghc.GhcPs -> Ghc.Hsc Constructor+make srcSpan lConDecl = do+  (lIdP, hsConDeclDetails) <- case Ghc.unLoc lConDecl of+    Ghc.ConDeclH98 _ x _ _ _ y _ -> pure (x, y)+    _ -> Hsc.throwError srcSpan $ Ghc.text "unsupported LConDecl"+  lConDeclFields <- case hsConDeclDetails of+    Ghc.RecCon x -> pure x+    _ -> Hsc.throwError srcSpan $ Ghc.text "unsupported HsConDeclDetails"+  theFields <-+    fmap concat . Monad.forM (Ghc.unLoc lConDeclFields) $ \lConDeclField -> do+      (lFieldOccs, lHsType) <- case Ghc.unLoc lConDeclField of+        Ghc.ConDeclField _ x y _ -> pure (x, y)+        _ -> Hsc.throwError srcSpan $ Ghc.text "unsupported LConDeclField"+      mapM (Field.make srcSpan lHsType) lFieldOccs+  pure Constructor { name = Ghc.unLoc lIdP, fields = theFields }
+ src/lib/Evoke/Type/Field.hs view
@@ -0,0 +1,37 @@+module Evoke.Type.Field+  ( Field(..)+  , make+  , isOptional+  ) where++import qualified Evoke.Hsc as Hsc+import qualified GHC.Hs as Ghc+import qualified GhcPlugins as Ghc++data Field = Field+  { name :: Ghc.OccName+  , type_ :: Ghc.HsType Ghc.GhcPs+  }++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+    _ -> Hsc.throwError srcSpan $ Ghc.text "unsupported LFieldOcc"+  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 }++isOptional :: Field -> Bool+isOptional field = case type_ field of+  Ghc.HsAppTy _ lHsType _ -> case Ghc.unLoc lHsType of+    Ghc.HsTyVar _ _ lIdP -> case Ghc.unLoc lIdP of+      Ghc.Unqual occName -> Ghc.occNameString occName == "Maybe"+      _ -> False+    _ -> False+  _ -> False
+ src/lib/Evoke/Type/Flag.hs view
@@ -0,0 +1,31 @@+module Evoke.Type.Flag+  ( Flag(..)+  , options+  ) where++import qualified System.Console.GetOpt as Console++data Flag+  = Help+  | Verbose+  | Version+  deriving (Eq, Show)++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"+  ]
+ src/lib/Evoke/Type/Type.hs view
@@ -0,0 +1,45 @@+module Evoke.Type.Type+  ( Type(..)+  , make+  , qualifiedName+  ) where++import qualified Control.Monad as Monad+import qualified Evoke.Hsc as Hsc+import qualified Evoke.Type.Constructor as Constructor+import qualified GHC.Hs as Ghc+import qualified GhcPlugins as Ghc++data Type = Type+  { 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 lIdP lHsQTyVars lConDecls srcSpan = do+  lHsTyVarBndrs <- case lHsQTyVars of+    Ghc.HsQTvs _ hsq_explicit -> pure hsq_explicit+    _ -> Hsc.throwError srcSpan $ Ghc.text "unsupported LHsQTyVars"+  theVariables <- Monad.forM lHsTyVarBndrs $ \lHsTyVarBndr ->+    case Ghc.unLoc lHsTyVarBndr of+      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+    }++qualifiedName :: Ghc.ModuleName -> Type -> String+qualifiedName moduleName type_ = mconcat+  [ Ghc.moduleNameString moduleName+  , "."+  , Ghc.occNameString . Ghc.rdrNameOcc $ name type_+  ]
+ src/test/Main.hs view
@@ -0,0 +1,175 @@+{-# OPTIONS_GHC -fplugin=Evoke #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}++import qualified Data.Aeson as Aeson+import qualified Data.Aeson.QQ.Simple as Aeson+import qualified Data.Proxy as Proxy+import qualified Data.Swagger as Swagger+import qualified Test.HUnit as Unit+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 } |]+  , 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+  :: ( 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+  let json = Aeson.toJSON $ Proxy.asProxyTypeOf value proxy+  Aeson.fromJSON json Unit.@?= Aeson.Success value+  Swagger.validateJSON mempty (Swagger.toSchema proxy) json Unit.@?= []++testToJSON :: Aeson.ToJSON a => a -> Aeson.Value -> Unit.Test+testToJSON = (Unit.~?=) . Aeson.toJSON++-- custom void type with no instances+data X++-- one field+newtype T1 = T1C1+  { t1c1f1 :: Int+  }+  deriving (Eq, Show)+  deriving (Arbitrary, FromJSON, ToJSON, ToSchema) via "Evoke"++-- multiple fields+data T2 = T2C1+  { t2c1f1 :: Int+  , t2c1f2 :: Int+  }+  deriving (Eq, Show)+  deriving (Arbitrary, FromJSON, ToJSON, ToSchema) via "Evoke"++-- snake case+newtype T3 = T3C1+  { t3c1f1aA :: Int+  }+  deriving (Eq, Show)+  deriving (Arbitrary, FromJSON, ToJSON, ToSchema) via "Evoke --snake"++-- kebab case+newtype T4 = T4C1+  { t4c1f1aA :: Int+  }+  deriving (Eq, Show)+  deriving (Arbitrary, FromJSON, ToJSON, ToSchema) via "Evoke --kebab"++-- capitalized+newtype T5 = T5C1+  { t5c1f1 :: Int+  }+  deriving (Eq, Show)+  deriving (Arbitrary, FromJSON, ToJSON, ToSchema) via "Evoke --title"++-- stripped prefix+newtype T6 = T6C1+  { t6c1f1 :: Int+  }+  deriving (Eq, Show)+  deriving (Arbitrary, FromJSON, ToJSON, ToSchema) via "Evoke --strip t6c1"++-- stripped then capitalized+newtype T7 = T7C1+  { t7c1f1 :: Int+  }+  deriving (Eq, Show)+  deriving (Arbitrary, FromJSON, ToJSON, ToSchema) via "Evoke --strip t7c1 --title"++-- capitalized then stripped+newtype T8 = T8C1+  { t8c1f1 :: Int+  }+  deriving (Eq, Show)+  deriving (Arbitrary, FromJSON, ToJSON, ToSchema) via "Evoke --title --strip T8c1"++-- phantom type+newtype T9 a = T9C1+  { t9c1f1 :: Int+  }+  deriving (Eq, Show)+  deriving (Arbitrary, FromJSON, ToJSON, ToSchema) via "Evoke"++-- type variable+newtype T10 a = T10C1+  { t10c1f1 :: a+  }+  deriving (Eq, Show)+  deriving (Arbitrary, FromJSON, ToJSON, ToSchema) via "Evoke"++-- lower cased+newtype T11 = T11C1+  { t11c1f1A :: Int+  }+  deriving (Eq, Show)+  deriving (Arbitrary, FromJSON, ToJSON, ToSchema) via "Evoke --strip t11c1f1 --camel"++-- multiple type variables+data T12 a b c d e = T12C1+  { t12c1f1 :: d+  , t12c1f2 :: b+  }+  deriving (Eq, Show)+  deriving (Arbitrary, FromJSON, ToJSON, ToSchema) via "Evoke"++-- multiple fields with one signature+data T13 = T13C1+  { t13c1f1, t13c1f2 :: Int+  }+  deriving (Eq, Show)+  deriving (Arbitrary, FromJSON, ToJSON, ToSchema) via "Evoke"++-- optional field+newtype T14 = T14C1+  { t14c1f1 :: Maybe Int+  }+  deriving (Eq, Show)+  deriving (Arbitrary, FromJSON, ToJSON, ToSchema) via "Evoke"