packages feed

boilerplate 0.0.1 → 0.0.2

raw patch · 14 files changed

+344/−304 lines, 14 filesdep +transformersdep ~hsinspect

Dependencies added: transformers

Dependency ranges changed: hsinspect

Files

+ README.md view
@@ -0,0 +1,197 @@+Rather than [Scrap your Boilerplate](https://www.microsoft.com/en-us/research/wp-content/uploads/2003/01/hmap.pdf), we say: **Generate your Boilerplate**.++`boilerplate` is a command line tool that generates explicit boilerplate and inserts it into your source code, enclosed in comments that text editors can easily hide from view. Like the way IDEs do it for languages such as Java, C++ and Go.++The advantages of this approach are:++- lower bar for users: no need to understand `Generic` and typelevel programming+- better compiler errors makes edge cases easier to debug and fix (just manually edit them!)+- a simple DSL for typeclass authors to define derivation rules+- can also be used to create functions and data, as well as typeclass instances+- faster compile times+- potential for faster runtime+- easy to customise+- more portable (e.g. works for whole program optimising compilers)+- can replace all `deriving` language extensions++A community repo could hold a curated list of rules, and typeclass authors may ship rules in their documentation.++# Installation++```+cabal install -O2 boilerplate --constraint="parsers -attoparsec -binary"+```++or install per-project in the `build-tool-depends` of your `.cabal` files.++# How to Use++This section explains how to use the `boilerplate` tool on Haskell source code to automatically generate code.++It assumes that some rules are available in a `boilerplate` directory in the codebase, see the `boilerplate` directory of this repo for examples; including rules for `Eq`, `Ord`, `Show`, `Functor`, `Foldable`, `Traversable`, `FFunctor`, Aeson's `FromJSON` / `ToJSON`, and QuickCheck's `Gen` (which is not a typeclass). Further below are instructions on how to write rules.++## Code Markers++The `boilerplate` tool parses source code to find block comments marking what to expand and will update the source inline++```+boilerplate -i path/to/File.hs+```++The syntax of the block comment looks like++```haskell+{- BOILERPLATE <type> <rules> <options> -}+```++where `<type>` is a `type` constructor defined in the module, `<rules>` is comma separated list of rules to expand. `<options>` are described below.++When the tool runs, it will insert the output immediately after the comment, between comments++```haskell+{- BOILERPLATE START-}+...+{- BOILERPLATE END -}+```++which indicates the region that is to be destructively replaced, and should not be moved.++The closing comment may be used by text editors to automatically collapse the region, e.g. [`hide-show` in Emacs](https://www.gnu.org/software/emacs/manual/html_node/emacs/Hideshow.html) and [folding in VSCode](https://code.visualstudio.com/docs/editor/codebasics#_folding).++For example, the following data type and expansion rules would be processed by `boilerplate` for the rules named `FromJSON` and `ToJSON`++```haskell+data Coord = Coordy { a :: Double, b :: Double}++{- BOILERPLATE Coord FromJSON, ToJSON -}+```++producing++```haskell+{- BOILERPLATE START-}+instance FromJSON Coord where+  parseJSON = withObject "Coord" $ v ->+    Coordy <$> v .: "a" <*> v .: "b"+instance ToJSON Coord where+  toJSON (Coordy p_1_1 p_1_2) = object ["a" .= p_1_1, "b" .= p_1_2]+  toEncoding (Coordy p_1_1 p_1_2) = pairs (("a", p_1_1) <> ("b", p_1_2))+{- BOILERPLATE END -}+```++If integration with code formatters is required, just add [magic comments](https://github.com/tweag/ormolu#magic-comments) to your rules or around the boilerplate markers.++### Options++The `<options>` section is a JSON-like object that is translated into `{Custom NAME}` parameters on a per-rule basis. Multiple options may be specified in the form++```+<key> = <value>+```++where `<value>` can be a string, array or object. Unlike in JSON, strings do not need to be quoted, but can be. For example, in the `FromJSON` and `ToJSON` rules, a custom `field` value is defined that overrides the record field name. This can be provided as either an array, overriding the field names by position:++```+{- BOILERPLATE Coord FromJSON, ToJSON+   field = [x, y] -}+```++or a translation map:++```+{- BOILERPLATE Coord FromJSON, ToJSON+   field = {a:x, b:y} -}+```++producing++```haskell+{- BOILERPLATE START-}+instance FromJSON Coord where+  parseJSON = withObject "Coord" $ v ->+    Coordy <$> v .: "x" <*> v .: "y"+instance ToJSON Coord where+  toJSON (Coordy p_1_1 p_1_2) = object ["x" .= p_1_1, "y" .= p_1_2]+  toEncoding (Coordy p_1_1 p_1_2) = pairs (("x", p_1_1) <> ("y", p_1_2))+{- BOILERPLATE END -}+```++The way the custom values are interpreted depends on the context of their use:++- string values can be used anywhere+- arrays can only contain strings and are used for positional arguments of a product type+- objects of strings can be used+  - for named record fields+  - for data constructors of a sum type+- objects of arrays are used for positional arguments of a sum type++It is intentionally not possible to use objects of objects to provide custom values to field names in sum types; record syntax in sum types results in partial functions and should be discouraged.++- if the `type` is a product type, the value may be an array of strings corresponding to positional field values+- if the `type` is a record product type, the value may additionally be an object where the field names match the record field names and their inner values are strings.+- if the `type` is a sum type, then the value may be an object where the field names of the JSON correspond to the type tag names. The inner contents may be an array or object as for product types.++Note that all rules share the same namespace.++# Templates++This section is for template authors.++## Rules++The DSL for the `boilerplate` rules are fundamentally plain text, with markers that expand containing product and sum information. This allows rules to expand to generate anything that is a valid top-level form. It also means that it is the user's responsibility to ensure that the relevant imports and language extensions are enabled as required by that rule.++The filename dictates the name of the rule, using the same module naming convention as haskell source code. e.g. `Data/Aeson/FromJson.rule` provides the rule named `Data.Aeson.FromJson` which may be referred to in a codebase as `FromJson` if there are no rule namespace conflicts.++Note that naming a rule for the typeclass it represents is just convention. Multiple rules may exist for the same typeclass, for example we may wish to have `Data/Aeson/FromJson-Untagged.rule` for a different sum type encoding.++"magic" syntax is triggered by curly braces `{ }`. Literal `{`, `}` or `\` may be used when escaped with `\`.++In any location the following syntax will expand:++- `{Type}` the type constructor.++And, unless nested, the following syntax will expand:++- `{TParams T_ARGS}` repeating for each type parameter.+- `{Product ...}` the contents only printed if the type is a product type.+- `{Sum S_ARGS}` the contents only printed if the type is a sum type, repeated for each data constructor.++`T_ARGS` can be either `{ELEMENT}{SEP}` or `{EMPTY}{PREFIX}{ELEMENT}{SEP}{SUFFIX}` where `EMPTY` is used when there are no elements to iterate. `PREFIX` / `ELEMENT` / `SEP` / `SUFFIX` are used when there are elements.++`S_ARGS` can be a `ELEMENT`, `{ELEMENT}{SEP}` or `{PREFIX}{ELEMENT}{SEP}{SUFFIX}`; there is no `{EMPTY}` since there is always at least 2 tagged types.++Inside a `{TParams}` `ELEMENT`, the syntax `{TParam}` may be used to insert the verbatim type parameter.++Inside a `{Product }` or `{Sum }` `ELEMENT` the following will expand:++- `{Uncons}` the data constructor's pattern extractor, with generated parameter names.+- `{Cons}` the data constructor.+- `{Field F_ARGS}` repeats for each field.++`F_ARGS` can be either `{ELEMENT}{SEP}` or `{EMPTY}{PREFIX}{ELEMENT}{SEP}{SUFFIX}` following the same principles as `{TParams}`.++Inside a `Field` `ELEMENT`, the following will expand:++- `{Param}` is the generated parameter matching the `{Uncons}`.+- `{FieldName}` is the field name, will cause an error for non-record `data`.+- `{FieldType}` is the field's type.+- `{TyCase {POLY}{HIGHER}{OTHER}}` expands `POLY` when the field has exactly the same type as a type parameter, `HIGHER` when it contains one of the type parameters, and `OTHER` when neither. This can be used to implement typeclasses like `Functor` and `Foldable`.++It should be noted that all `{X }` syntax is stripped and is not replaced by whitespace. Pay special attention when relying on significant whitespace that the output is correct, regardless of how it is aligned in the `.rule` file.++Inside a `{Field}` `ELEMENT` the syntax `{Uncons}` and `{Param}` introduced so far is shorthand for `{Uncons1}` and `{Param1}`. `{UnconsN}` and `{ParamN}` may be used to refer to the `N`th product inside a `{Product ...}` or `{Sum ...}`. For example, consider writing a rule for a typeclass with a binary operator like `Semigroup`. For sum types, only the inner product can be created, it is not possible to combine arbitrary data constructors.++A `{Custom NAME FALLBACK}` will expand anywhere for a user-defined parameter named `NAME`, optionally defaulting to `FALLBACK` (which may be another magic expansion). User-defined parameters may be defined for the entire rule, for each `{Sum ...}` repetition, or in each `{Field ...}`, and will be expanded accordingly.++Syntax sugar is available for some common templates, e.g. `{Instance Foo}` expands to++```+instance {TParams {}{(}{Foo {TParam}}{, }{) => }}Foo {TParams {{Type}}{({Type} }{{TParam}}{ }{)}} where+```++and `{Data ...}` expands to `{Product ...}{Sum ...}` which is useful when the same templates work for both product, and no special handling is needed for empty cases, prefix, separators or suffixes.++which is useful to define an `instance` declaration for a typical typeclass that depends on instances for all type parameters.++Examples rules are available in the `boilerplate` directory of this repository.
boilerplate.cabal view
@@ -1,17 +1,19 @@-cabal-version: 2.2-name:          boilerplate-version:       0.0.1-synopsis:      Generate Haskell boilerplate.-license:       GPL-3.0-or-later-license-file:  LICENSE-author:        Tseen She-maintainer:    Tseen She-copyright:     2020 Tseen She-tested-with:   GHC ^>=8.8.3-category:      Building+cabal-version:      2.2+name:               boilerplate+version:            0.0.2+synopsis:           Generate Haskell boilerplate.+license:            GPL-3.0-or-later+license-file:       LICENSE+author:             Tseen She+maintainer:         Tseen She+copyright:          2020 Tseen She+tested-with:        GHC ^>=8.8.3+category:           Building description:   Generates boilerplate from templates and markers in Haskell source code. +extra-source-files: README.md+ source-repository head   type:     git   location: https://gitlab.com/tseenshe/boilerplate.git@@ -25,18 +27,23 @@  common deps   build-depends:-    , base        >=4.11 && <5+    , base          >=4.11   && <5     , containers     , directory     , filepath     , ghc+    , hsinspect     ^>=0.0.17     , text+    , transformers -  ghc-options:      -Wall -Werror=missing-home-modules -Werror=orphans+  ghc-options:+    -Wall -Werror=missing-home-modules -Werror=orphans+    -Wno-name-shadowing+   default-language: Haskell2010    if flag(ghcflags)-    build-tool-depends: hsinspect:hsinspect ==0.0.13+    build-tool-depends: hsinspect:hsinspect -any     build-depends:      ghcflags     ghc-options:        -fplugin GhcFlags.Plugin @@ -54,9 +61,8 @@   hs-source-dirs:  library   build-depends:     , ghc-paths-    , hsinspect  ^>=0.0.13-    , parsers    >0.12   && <0.13-    , vector     >0.12   && <0.13+    , parsers    >0.12 && <0.13+    , vector     >0.12 && <0.13    -- cabal-fmt: expand library   exposed-modules:@@ -78,8 +84,6 @@   other-modules:     Boilerplate.ConfigParserTests     Boilerplate.DocTests-    Boilerplate.Example-    Boilerplate.GhcParserTests     Boilerplate.InterpreterTests     Boilerplate.RuleParserTests
exe/Main.hs view
@@ -25,6 +25,7 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T+import HsInspect.Types (Comment(..), Pos(..), Type(..)) import System.Environment (getArgs) import System.Exit (ExitCode(..), exitWith) import System.IO (stderr)@@ -48,8 +49,16 @@   " -v,--version            Print version information\n" ++   "    --ghc-version        Print ghc version information\n" ++   " -i,--inplace            Overwrite FILE in place\n" ++-  "    --verbose            Print debugging information to stderr\n"+  "    --verbose            Print debugging information to stderr\n" +++  "    --check-rule         Parse FILE as a rule file and display errors\n" +-- TODO automatic imports+--+-- rules could declare imports they probably need quite easily, but figuring out+-- if an import is necessary (especially considering reexports) and making a+-- diff to the import section is very difficult and probably warrants its own+-- tool. Nevertheless, this would be an excellent feature.+ main :: IO () main = do   args <- getArgs@@ -66,18 +75,23 @@   when (elem "--ghc-version" args) $     (putStrLn GHC.cProjectVersion) >> exitWith ExitSuccess -  when (null args) $-    (putStrLn "missing arguments") >> (exitWith $ ExitFailure 1)+  let exit1 msg = (hPutStrLn stderr msg) >> (exitWith $ ExitFailure 1) +  when (null args) $ exit1 "missing arguments"+   let inplace = hasAny ["-i", "--inplace"] args       file = last $ filter (not . isPrefixOf "-") args       verbose = elem "--verbose" args -  -- FIXME a --check-rule flag that just parses a rule+  -- TODO all parsec errors should be formatted as path/to/file.hs:line:col: -  content <- T.readFile file+  when (elem "--check-rule" args) $ do+    parsed <- parseFromFile ruleParser file+    case parsed of+      Left err -> exit1 $ show err+      Right _ -> exitWith ExitSuccess -  -- TODO all parsec errors should be formatted as path/to/file.hs:line:col:+  content <- T.readFile file    -- early exit when there is no work to do   when (not $ T.isInfixOf "BOILERPLATE" content) $@@ -122,32 +136,32 @@             then Just path             else Nothing       case mapMaybe pickRule ruleFiles of-        [] -> error "no rules"+        [] -> exit1 "no rules"         [ruleFile] -> do           cached <- readIORef rulesCache           case M.lookup ruleFile cached of             Nothing -> do               parsed <- parseFromFile ruleParser ruleFile               case parsed of-                Left err -> error $ show err+                Left err -> exit1 $ show err                 Right r -> r <$ modifyIORef' rulesCache (M.insert ruleFile r)             Just hit -> do               when verbose $                 hPutStrLn stderr $ "hit cache for " <> ruleFile               pure hit-        many -> error $ "ambiguous rules" <> show many+        many -> exit1 $ "ambiguous rules" <> show many      tpes :: Map Text Type     tpes = M.fromList $ (\t -> (tycon t, t)) <$> types       where         tycon = \case-          ProductType tc _ _ _ -> tc-          RecordType tc _ _ _ -> tc+          ProductType tc _ _ _ _ -> tc+          RecordType tc _ _ _ _ -> tc           SumType tc _ _ -> tc      resolve (Action tycon rulenames custom start end) = do       tpe <- case M.lookup tycon tpes of-        Nothing -> error $ "could not find the type definition for " <> show tycon+        Nothing -> exit1 $ "could not find the type definition for " <> show tycon         Just a -> pure a       rules' <- traverse findRule rulenames       pure $ Action tpe rules' custom start end@@ -167,7 +181,7 @@     end_comment = "\n{- BOILERPLATE END -}"    replacement <- unDoc <$> case interpreted of-    Left err -> (putStrLn $ T.unpack err) >> (exitWith $ ExitFailure 1)+    Left err -> exit1 $ T.unpack err     Right good -> pure $ upsertMany (mkDoc content) good    if inplace
library/Boilerplate/Doc.hs view
@@ -1,11 +1,11 @@  module Boilerplate.Doc (Doc, mkDoc, unDoc, upsert, upsertMany) where -import Boilerplate.Types import Data.Text (Text) import qualified Data.Text as T import Data.Vector (Vector) import qualified Data.Vector as V+import HsInspect.Types (Pos(..))  newtype Doc = Doc (Vector Text)
library/Boilerplate/GhcParser.hs view
@@ -4,119 +4,14 @@  module Boilerplate.GhcParser (parseHaskell) where -import Boilerplate.Types-import Control.Exception (throwIO)-import Control.Monad (when)-import Control.Monad.IO.Class (liftIO)-import Data.List (isSuffixOf)-import Data.List (sortOn)-import Data.Maybe (mapMaybe)-import Data.Text (Text)-import qualified Data.Text as T-import DriverPipeline (preprocess)-import qualified DynFlags as GHC-import qualified FastString as GHC-import qualified GHC as GHC+import Control.Monad.Trans.Except (runExceptT)+import Data.Either (fromRight) import GHC.Paths (libdir)-import qualified HeaderInfo as GHC-import qualified HsInspect.Util as H-import qualified Lexer as GHC-import qualified Outputable as GHC-import qualified Parser-import qualified SrcLoc as GHC-import qualified StringBuffer as GHC-import System.Directory (removeFile)+import HsInspect.Runner+import HsInspect.Types (Comment(..), Type(..), types) --- FIXME move to hsinspect and share as a library------and then a single boilerplate binary---      could call out to a package-specific hsinspect? Would centralise all the---      ghc logic at the expense of a more complex setup. Perhaps make hsinspect---      available as a library to simplify this process, since this information---      would be useful for all kinds of tools (e.g. documentation generation). parseHaskell :: FilePath -> IO ([Type], [Comment]) parseHaskell file = do-  -- TODO construct the real session from .ghc.flags, or use a hardcoded ParserFlags-  env <- liftIO . GHC.runGhc (Just libdir) $ do-    dflags <- GHC.getSessionDynFlags-    -- enablesx comment parsing-    _ <- GHC.setSessionDynFlags $ GHC.gopt_set dflags GHC.Opt_KeepRawTokenStream-    GHC.getSession-  pstate <- mkCppState env file-  let showGhc :: GHC.Outputable a => a -> Text-      showGhc = T.pack . H.showGhc-  case GHC.unP Parser.parseModule pstate of-    -- ParseResult (Located (HsModule GhcPs))-    GHC.POk st (GHC.L _ hsmod) -> do-      -- http://hackage.haskell.org/package/ghc-8.8.3/docs/HsDecls.html#t:HsDecl-      -- [Located (HsDecl p)]-      let decls = GHC.hsmodDecls hsmod-          findType (GHC.L _ (GHC.TyClD _ (GHC.DataDecl _ tycon' (GHC.HsQTvs _ tparams') _ ddn))) =-            let-              tycon = showGhc tycon'-              tparams = renderTparam <$> tparams'-              renderField :: GHC.GenLocated l (GHC.ConDeclField GHC.GhcPs) -> (Text, Text)-              renderField (GHC.L _ field) = (showGhc . head $ GHC.cd_fld_names field, showGhc $ GHC.cd_fld_type field)-              renderArg :: GHC.LBangType GHC.GhcPs -> Text-              renderArg (GHC.L _ arg) = showGhc arg-              rhs = do-                (GHC.L _ ddl) <- GHC.dd_cons ddn-                case ddl of-                  GHC.ConDeclH98 _ cons _ _ _ (GHC.RecCon (GHC.L _ fields)) _ -> [(showGhc cons, Left $ renderField <$> fields)]-                  GHC.ConDeclH98 _ cons _ _ _ (GHC.InfixCon a1 a2) _ -> [(showGhc cons, Right $ [renderArg a1, renderArg a2])]-                  GHC.ConDeclH98 _ cons _ _ _ (GHC.PrefixCon args) _ -> [(showGhc cons, Right $ renderArg <$> args)]-                  _ -> [] -- GADTS--             in case rhs of-              [] -> Nothing-              [(cons, Right tpes)] -> Just $ ProductType tycon tparams cons tpes-              [(cons, Left fields)] -> Just $ RecordType tycon tparams cons fields-              mult -> Just . SumType tycon tparams $ render <$> mult-                where-                  render (cons, Right args) = (cons, args)-                  render (cons, Left fargs) = (cons, snd <$> fargs)--          findType _ = Nothing--          renderTparam :: GHC.GenLocated l (GHC.HsTyVarBndr GHC.GhcPs) -> Text-          renderTparam (GHC.L _ (GHC.UserTyVar _ p)) = showGhc p-          renderTparam (GHC.L _ (GHC.KindedTyVar _ p _)) = showGhc p-          renderTparam (GHC.L _ (GHC.XTyVarBndr _)) = "<unsupported>"--          extractComment (GHC.L (GHC.RealSrcSpan pos) c) =-            let start = Pos (GHC.srcSpanStartLine pos) (GHC.srcSpanStartCol pos)-                end = Pos (GHC.srcSpanEndLine pos) (GHC.srcSpanEndCol pos)-             in (\str -> Comment (T.pack str) start end) <$> case c of-            (GHC.AnnLineComment txt) -> Just txt-            (GHC.AnnBlockComment txt) -> Just txt-            _ -> Nothing-          extractComment _ = Nothing--          types = mapMaybe findType decls-          comments = mapMaybe extractComment $ GHC.comment_q st--      pure (types, sortOn (\(Comment _ s _) -> s) comments)--    GHC.PFailed _ _ err -> throwIO . userError $ "unable to parse " <> file <> " due to " <> GHC.showSDocUnsafe err---- from hsinspect, share with parseHeader'---- applies CPP rules to the input file and extracts the pragmas,--- a more portable alternative to GHC.hGetStringBuffer-mkCppState :: GHC.HscEnv -> FilePath -> IO GHC.PState-mkCppState sess file = do-#if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0)-  pp <- preprocess sess file Nothing Nothing-  let (dflags, tmp) = case pp of-        Left _ -> error $ "preprocessing failed " <> show file-        Right success -> success-#else-  (dflags, tmp) <- preprocess sess (file, Nothing)-#endif-  full <- GHC.hGetStringBuffer tmp-  when (".hscpp" `isSuffixOf` tmp) $-    liftIO . removeFile $ tmp-  let pragmas = GHC.getOptions dflags full file-      loc  = GHC.mkRealSrcLoc (GHC.mkFastString file) 1 1-  (dflags', _, _) <- GHC.parseDynamicFilePragma dflags pragmas-  pure $ GHC.mkPState dflags' full loc+  let fallback = ["-B" <> libdir]+  flags <- fromRight fallback <$> (runExceptT . ghcflags_flags $ Just file)+  runGhcAndJamMasterShe flags False $ types file
library/Boilerplate/Interpreter.hs view
@@ -5,17 +5,22 @@ module Boilerplate.Interpreter (interpretRule) where  import Boilerplate.Types+import Data.List (intersect) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Text (Text) import qualified Data.Text as T+import HsInspect.Types (Type(..))  data Ctx = G -- ^^ global context-         | P Text [(Maybe Text, Text)] -- ^^ product-like thing: cons [(maybe fieldname, param type)]-         | F Text Int (Maybe Text) Text -- ^^ field in a product-like: cons idx fieldname param type+         | P Text [(Maybe Text, Text, TyCtx)] -- ^^ product-like thing: cons [(maybe fieldname, param type, typarams)]+         | F Text Int (Maybe Text) Text TyCtx -- ^^ field in a product-like: cons idx fieldname param type typarams          | T Text -- ^^ type parameter field   deriving (Eq, Show) +data TyCtx = Poly | Higher | Concrete+  deriving (Eq, Show)+ interpretRule :: Rule -> Type -> Map Text Custom -> Either Text Text interpretRule (Rule atoms) tpe options = T.strip <$> interpretTree G atoms   where@@ -35,12 +40,20 @@     param :: Int -> Int -> Text     param n p = "p_" <> showt n <> "_" <> showt p +    tyCtx :: [Text] -> Text -> [Text] -> TyCtx+    tyCtx type_params tpe tpe_params =+      if elem tpe type_params+      then Poly+      else if not . null $ intersect type_params tpe_params+      then Higher+      else Concrete+     -- no context interpreter     interpret ctx = \case       Raw txt -> Right txt       Type -> Right $ case tpe of-        ProductType tn _ _ _ -> tn-        RecordType tn _ _ _ -> tn+        ProductType tn _ _ _ _ -> tn+        RecordType tn _ _ _ _ -> tn         SumType tn _ _ -> tn       TParams empty prefix els sep suffix ->         if null tparams@@ -48,8 +61,8 @@         else (\p b -> p <> b <> suffix) <$> interpretTree G prefix <*> body         where           tparams = T <$> case tpe of-            ProductType _ tps _ _ -> tps-            RecordType _ tps _ _ -> tps+            ProductType _ tps _ _ _ -> tps+            RecordType _ tps _ _ _ -> tps             SumType _ tps _ -> tps           body = T.intercalate sep <$> traverse (flip interpretTree els) tparams       TParam -> case ctx of@@ -59,14 +72,14 @@         let interpret' c ps = interpretTree (P c ps) els          in case tpe of         SumType _ _ _ -> Right T.empty-        ProductType _ _ cons params -> interpret' cons $ (Nothing,) <$> params-        RecordType _ _ cons params -> interpret' cons $ (\(a, b) -> (Just a, b)) <$> params+        ProductType _ tps _ cons params -> interpret' cons $ (\(tpe, tys) -> (Nothing, tpe, tyCtx tps tpe tys)) <$> params+        RecordType _ tps _ cons params -> interpret' cons $ (\(nme, tpe, tys) -> (Just nme, tpe, tyCtx tps tpe tys)) <$> params       Sum prefix els sep suffix -> case tpe of-        ProductType _ _ _ _ -> Right T.empty-        RecordType _ _ _ _ -> Right T.empty-        SumType _ _ tags -> (\b -> prefix <> b <> suffix) <$> body+        ProductType _ _ _ _ _ -> Right T.empty+        RecordType _ _ _ _ _ -> Right T.empty+        SumType _ tps tags -> (\b -> prefix <> b <> suffix) <$> body           where-            tags' = (\(cons, tpes) -> P cons ((Nothing,) <$> tpes)) <$> tags+            tags' = (\(cons, tpes) -> P cons ((\(tpe, tys) -> (Nothing, tpe, tyCtx tps tpe tys)) <$> tpes)) <$> tags             body = T.intercalate sep <$> traverse (flip interpretTree els) tags'       Uncons n -> case ctx of         P cons [] -> Right cons@@ -76,45 +89,53 @@         _ -> impossible "Uncons"       Cons -> case ctx of         P cons _ -> Right cons-        F cons _ _ _ -> Right cons+        F cons _ _ _ _ -> Right cons         _ -> impossible "Cons"       Field empty prefix els sep suffix -> case ctx of         P _ [] -> interpretTree ctx empty         P cons ps -> (\p b -> p <> b <> suffix) <$> interpretTree ctx prefix <*> body           where-            fields = (\(n, (f, t)) -> F cons n f t) <$> zip [1..] ps+            fields = (\(n, (f, t, tc)) -> F cons n f t tc) <$> zip [1..] ps             body = T.intercalate sep <$> traverse (flip interpretTree els) fields         _ -> impossible "Field"       Param n ->  case ctx of-        F _ p _ _ -> Right $ param n p+        F _ p _ _ _ -> Right $ param n p         _ -> impossible "Param"       FieldName -> case ctx of-        F _ _ n _ -> maybe (Left "field names are required") Right n+        F _ _ n _ _ -> maybe (Left "field names are required") Right n         _ -> impossible "FieldName"       FieldType -> case ctx of-        F _ _ _ t -> Right t+        F _ _ _ t _ -> Right t         _ -> impossible "FieldType"+      TyCase poly higher concrete -> case ctx of+        F _ _ _ _ ty -> interpretTree ctx $ case ty of+          Poly -> poly+          Higher -> higher+          Concrete -> concrete+        _ -> impossible "TyCase"       Custom sym fallback ->         let err = Left $ "missing required option '" <> sym <> "' which should be " <> ctx'             ctx' = case ctx of               G -> "a global value"               T _ -> "a global value"               P cons _ -> "a mapping for the data constructors of " <> cons-              F cons _ _ _ -> "an indexed sequence for fields of the data constructor " <> cons+              F cons _ _ _ _ -> "an indexed sequence for fields of the data constructor " <> cons          in case (M.lookup sym options, ctx) of           (Just (Global txt), _) -> Right txt-          (Just (Indexed vs), F _ p _ _) -> maybe err Right $ atMay (p - 1) vs-          (Just (Named vs), F _ _ (Just f) _) -> maybe err Right $ M.lookup f vs-          (Just (NamedIndexed vs), F cons p _ _) -> maybe err Right $ atMay (p - 1) =<< M.lookup cons vs+          (Just (Indexed vs), F _ p _ _ _) -> maybe err Right $ atMay (p - 1) vs+          (Just (Named vs), F _ _ (Just f) _ _) -> maybe err Right $ M.lookup f vs+          (Just (NamedIndexed vs), F cons p _ _ _) -> maybe err Right $ atMay (p - 1) =<< M.lookup cons vs           (Just (Named vs), P cons _) -> maybe err Right $ M.lookup cons vs           _ -> case fallback of             Nothing -> err             Just t -> interpretTree ctx t-      Sugar (Instance tc) ->-        interpretTree ctx [-          Raw "instance ",-          TParams [] [Raw "("] [Raw tc, Raw " ", TParam] ", " ") => ", Raw tc, Raw " ",-          TParams [Type] [Raw "(", Type, Raw " "] [TParam] " " ")", Raw " where"]+      Sugar sugar -> interpretTree ctx $ case sugar of+        Instance tc ->+          [Raw "instance ",+           TParams [] [Raw "("] [Raw tc, Raw " ", TParam] ", " ") => ", Raw tc, Raw " ",+           TParams [Type] [Raw "(", Type, Raw " "] [TParam] " " ")", Raw " where"]+        Data tree ->+          [Product tree, Sum "" tree "" ""]  atMay :: Int -> [a] -> Maybe a atMay i as | i < 0 = Nothing
library/Boilerplate/RuleFinder.hs view
@@ -7,14 +7,11 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Traversable (for)+import HsInspect.Util (locateDominating) import qualified HsInspect.Util as H import System.Directory (makeAbsolute)-import System.Directory (listDirectory)-import System.FilePath (takeBaseName)-import System.FilePath (makeRelative)-import System.FilePath (dropExtension)-import System.FilePath (pathSeparator)-import System.FilePath (takeDirectory, takeFileName, (</>))+import System.FilePath (dropExtension, makeRelative, pathSeparator,+                        takeBaseName, takeDirectory)  -- Finds all .rule files that live in dominant directories named "boilerplate" -- starting from the file. The files are sorted lexiographically within each@@ -35,7 +32,7 @@  locateDirs :: FilePath -> IO [FilePath] locateDirs dir = do-  mdir <- locateDominatingFile ("boilerplate" ==) dir+  mdir <- locateDominating ("boilerplate" ==) dir   case mdir of     Nothing -> pure []     Just hit ->@@ -50,17 +47,3 @@       short = takeBaseName file       replace from to = fmap (\c -> if c == from then to else c)    in (T.pack fqn, T.pack short, file)---- FIXME from hsinspect-lsp, move to the Utils module to share---- same as locateDominating but returns the first file that matches the predicate-locateDominatingFile :: (String -> Bool) -> FilePath -> IO (Maybe FilePath)-locateDominatingFile p dir = do-  files <- listDirectory dir-  let parent = takeDirectory dir-  case L.find p $ takeFileName <$> files of-    Just file -> pure . Just $ dir </> file-    Nothing ->-      if parent == dir-       then pure Nothing-       else locateDominatingFile p parent
library/Boilerplate/RuleParser.hs view
@@ -22,7 +22,7 @@           RootTree -> [pTParams, pProduct, pSum, pSugarInstance]           TParamTree -> [pTParam]           DataTree -> [pUncons, pCons, pField]-          FieldTree -> [pCons, pParam, pFieldName, pFieldType]+          FieldTree -> [pCons, pParam, pFieldName, pFieldType, pTyCase]     pRaw = Raw <$> T.pack <$> some pSourceChar <?> "haskell source"     pRaw' = T.pack <$> many pSourceChar <?> "haskell source"     pSourceChar = choice $ noneOf "{}\\" : (escaped <$> "{}\\")@@ -34,7 +34,7 @@     pTParams = tryText "TParams" *> space *> (try pTParams1 <|> pTParams2)       where         pTParams1 = TParams <$> pMagic_ (pTree RootTree) <*> pMagic (pTree RootTree) <*> pMagic (pTree TParamTree) <*> pMagic pRaw' <*> pMagic pRaw'-        pTParams2 = (\el sep -> TParams [Raw ""] [Raw ""] el sep "") <$> pMagic_ (pTree TParamTree) <*> pMagic pRaw'+        pTParams2 = (\el sep -> TParams [] [] el sep "") <$> pMagic_ (pTree TParamTree) <*> pMagic pRaw'     pTParam = TParam <$ tryText "TParam"     pProduct = tryText "Product" *> space *> (Product <$> pTree DataTree)     pSum = tryText "Sum" *> space *> (try pSum1 <|> try pSum2 <|> pSum3)@@ -47,10 +47,16 @@     pField = tryText "Field" *> space *> (try pField1 <|> pField2)       where         pField1 = Field <$> pMagic_ (pTree DataTree) <*> pMagic (pTree DataTree) <*> pMagic (pTree FieldTree) <*> pMagic pRaw' <*> pMagic pRaw'-        pField2 = (\el sep -> Field [Raw ""] [Raw ""] el sep "") <$> pMagic_ (pTree FieldTree) <*> pMagic pRaw'+        pField2 = (\el sep -> Field [] [] el sep "") <$> pMagic_ (pTree FieldTree) <*> pMagic pRaw'+    pTyCase = tryText "TyCase" *> space *> pTyCase'+      where+        pTyCase' = TyCase <$> pMagic_ (pTree FieldTree) <*> pMagic (pTree FieldTree) <*> pMagic (pTree FieldTree)     pParam = Param <$> (tryText "Param" *> pN)     pFieldName = FieldName <$ tryText "FieldName"     pFieldType = FieldType <$ tryText "FieldType"     pCustom tree = Custom <$> (tryText "Custom" *> space *> pId) <*> (optional $ space *> pTree tree)       where pId = T.pack <$> some alphaNum-    pSugarInstance = Sugar . Instance . T.pack <$> (tryText "Instance" *> space *> (some alphaNum))+    pSugarInstance = Sugar <$> (instance' <|> data')+      where+        instance' = Instance . T.pack <$> (tryText "Instance" *> space *> (some alphaNum))+        data' = Data <$> (tryText "Data" *> space *> pTree DataTree)
library/Boilerplate/Types.hs view
@@ -8,13 +8,6 @@ data Marker = Marker Text Int (Maybe Int) -- ^^ config (start position) (end position)   deriving (Eq, Show) --- line, col (1-indexed)-data Pos = Pos Int Int-  deriving (Eq, Ord, Show)--data Comment = Comment Text Pos Pos -- text start end-  deriving (Eq, Show)- data Config = Config Text [Text] [(Text, Custom)] -- ^^ type [rule] [custom key, value]             | ConfigStart             | ConfigEnd@@ -27,11 +20,6 @@             | NamedIndexed (Map Text [Text]) -- ^^ applies to ordered fields inside a sum type   deriving (Eq, Show) -data Type = ProductType Text [Text] Text [Text]  -- ^^ type tparams cons [param types]-          | RecordType Text [Text] Text [(Text, Text)] -- ^^ type tparams cons [(fieldname, param type)]-          | SumType Text [Text] [(Text, [Text])] -- ^^ type tparams [(cons, param types)] (no records)-  deriving (Eq, Show)- type Tree = [Atom]  newtype Rule = Rule Tree@@ -48,6 +36,7 @@   | Uncons Int -- ^^ id   | Cons   | Field Tree Tree Tree Text Text -- ^^ empty prefix elem sep suffix+  | TyCase Tree Tree Tree -- ^^ (type param) (higher kinded) (neither)   | Param Int -- ^^ id   | FieldName   | FieldType@@ -56,11 +45,10 @@     deriving (Eq, Show)  data Sugar = Instance Text+           | Data Tree   deriving (Eq, Show) --- FIXME support for iterating parameters with free type params (in the---      interpreter, filter fields by the type name and only include things with---      a type parameter), e.g. Foldable.---+-- TODO {RecordCase {RECORD}{DATA}} e.g. to support different Show for data vs records+ -- TODO syntax sugar for a strict subset with semantics of Divisible, Decidable, --      Applicative, Alt
test/Boilerplate/DocTests.hs view
@@ -3,8 +3,8 @@ module Boilerplate.DocTests where  import Boilerplate.Doc-import Boilerplate.Types import Data.Text (Text)+import HsInspect.Types (Pos(..)) import Test.Tasty.Hspec  upsert' :: Text -> (Int, Int) -> Maybe (Int, Int) -> Text -> Text
− test/Boilerplate/Example.hs 
@@ -1,32 +0,0 @@-{-# LANGUAGE KindSignatures #-}---- $foo-module Boilerplate.Example where--import Data.Text (Text)--{- this is a-   block comment--}---- | BOILERPLATE This is a doc string-data Coord1 = Coordy1 Double Double-{- BOILERPLATE Coord1 FromJSON, ToJSON -}--data Coord2 = Coordy2 { a :: Double, b :: Double}--- BOILERPLATE Coord FromJSON, ToJSON field={a:x, b:y}--- BOILERPLATE END--data Union = Wales String | England Int Int | Scotland--data Things a b = T a b Double--data Logger (m :: * -> *) = Logger { log :: Text -> m () }--data Action a = Admin [a] Text | User a Text--data InfixProd = Text :| Text--data InfixSum = Text :|| Text-              | Text :||| Text-
− test/Boilerplate/GhcParserTests.hs 
@@ -1,31 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Boilerplate.GhcParserTests where--import Boilerplate.GhcParser-import Boilerplate.Types-import Test.Tasty.Hspec--spec_ghc :: Spec-spec_ghc = do-  it "should parse the example data" $ do-    (types, markers) <- parseHaskell "test/Boilerplate/Example.hs"--    types `shouldBe` [-      ProductType "Coord1" [] "Coordy1" ["Double","Double"],-      RecordType "Coord2" [] "Coordy2" [("a","Double"),("b","Double")],-      SumType "Union" [] [("Wales",["String"]),("England",["Int","Int"]),("Scotland",[])],-      ProductType "Things" ["a","b"] "T" ["a","b","Double"],-      RecordType "Logger" ["m"] "Logger" [("log","Text -> m ()")],-      SumType "Action" ["a"] [("Admin",["[a]","Text"]),("User",["a","Text"])],-      ProductType "InfixProd" [] ":|" ["Text","Text"],-      SumType "InfixSum" [] [(":||",["Text","Text"]),(":|||",["Text","Text"])]]--    markers `shouldBe` [-      Comment "{-# LANGUAGE KindSignatures #-}" (Pos 1 1) (Pos 1 32),-      Comment "-- $foo" (Pos 3 1) (Pos 3 8),-      Comment "{- this is a\n   block comment\n-}" (Pos 8 1) (Pos 10 3),-      Comment "-- | BOILERPLATE This is a doc string" (Pos 12 1) (Pos 12 38),-      Comment "{- BOILERPLATE Coord1 FromJSON, ToJSON -}" (Pos 14 1) (Pos 14 42),-      Comment "-- BOILERPLATE Coord FromJSON, ToJSON field={a:x, b:y}" (Pos 17 1) (Pos 17 55),-      Comment "-- BOILERPLATE END" (Pos 18 1) (Pos 18 19)]
test/Boilerplate/InterpreterTests.hs view
@@ -3,36 +3,37 @@ module Boilerplate.InterpreterTests where  import Boilerplate.Interpreter-import Boilerplate.RuleParserTests (ffunctorRule, fromJSONRule, toJSONRule)+import Boilerplate.RuleParserTests (fromJSONRule, toJSONRule) import Boilerplate.Types import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Text (Text)+import HsInspect.Types (Type(..)) import Test.Tasty.Hspec  -- data Coord = Coordy Double Double egProduct :: Type-egProduct = ProductType "Coord" [] "Coordy" ["Double", "Double"]+egProduct = ProductType "Coord" [] False "Coordy" [("Double", []), ("Double", [])]  -- data Coord = Coordy { a :: Double, b :: Double} egRecord :: Type-egRecord = RecordType "Coord" [] "Coordy" [("a", "Double"), ("b", "Double")]+egRecord = RecordType "Coord" [] False "Coordy" [("a", "Double", []), ("b", "Double", [])]  -- data Union = Wales String | England Int Int | Scotland egSum :: Type-egSum = SumType "Union" [] [ ("Wales", ["String"]), ("England", ["Int", "Int"]), ("Scotland", [])]+egSum = SumType "Union" [] [("Wales", [("String", [])]), ("England", [("Int", []), ("Int", [])]), ("Scotland", [])]  -- data Things a b = T a b Double egPolyProduct :: Type-egPolyProduct = ProductType "Things" ["a", "b"] "T" ["a", "b", "Double"]+egPolyProduct = ProductType "Things" ["a", "b"] False "T" [("a", ["a"]), ("b", ["b"]), ("Double", [])]  -- data Logger m = Logger { log :: Text -> m () } egPolyRecord :: Type-egPolyRecord = RecordType "Logger" ["m"] "Logger" [("log", "Text -> m ()")]+egPolyRecord = RecordType "Logger" ["m"] False "Logger" [("log", "Text -> m ()", ["m"])]  -- data Action a = Admin [a] Text | User a Text egPolySum :: Type-egPolySum = SumType "Action" ["a"] [("Admin", ["[a]", "Text"]), ("User", ["a", "Text"])]+egPolySum = SumType "Action" ["a"] [("Admin", [("[a]", ["a"]), ("Text", [])]), ("User", [("a", ["a"]), ("Text", [])])]  custom :: Text -> Custom -> Map Text Custom custom key value = M.fromList [(key, value)]@@ -66,17 +67,14 @@             \  toJSON (T p_1_1 p_1_2 p_1_3) = object [\"x\" .= p_1_1, \"y\" .= p_1_2, \"z\" .= p_1_3]\n\             \  toEncoding (T p_1_1 p_1_2 p_1_3) = pairs (\"x\" .= p_1_1 <> \"y\" .= p_1_2 <> \"z\" .= p_1_3)" -  it "should interpret FFunctor for polymorphic records" $ do-    interpretRule ffunctorRule egPolyRecord M.empty `shouldBe`-      Right "instance FFunctor Logger where\n\-            \  ffmap nt (Logger p_1_1) = Logger (nt ... p_1_1)"-   it "should interpret ToJSON for polymorphic sum" $ do     let options = custom "field" $ Indexed ["x", "y", "z"]     interpretRule toJSONRule egPolySum options `shouldBe`       Right "instance (ToJSON a) => ToJSON (Action a) where\n\             \  toJSON (Admin p_1_1 p_1_2) = object [\"Admin\" .= object [\"x\" .= p_1_1, \"y\" .= p_1_2]]\n\-            \  toJSON (User p_1_1 p_1_2) = object [\"User\" .= object [\"x\" .= p_1_1, \"y\" .= p_1_2]]"+            \  toJSON (User p_1_1 p_1_2) = object [\"User\" .= object [\"x\" .= p_1_1, \"y\" .= p_1_2]]\n\+            \  toEncoding (Admin p_1_1 p_1_2) = pairs . pair \"Admin\" $ pairs (\"x\" .= p_1_1 <> \"y\" .= p_1_2 :: Series)\n\+            \  toEncoding (User p_1_1 p_1_2) = pairs . pair \"User\" $ pairs (\"x\" .= p_1_1 <> \"y\" .= p_1_2 :: Series)"    it "should interpret ToJSON for records without custom" $ do     interpretRule toJSONRule egRecord M.empty `shouldBe`@@ -97,7 +95,10 @@       Right "instance ToJSON Union where\n\             \  toJSON (Wales p_1_1) = object [\"Wales\" .= object [\"foo\" .= p_1_1]]\n\             \  toJSON (England p_1_1 p_1_2) = object [\"England\" .= object [\"a\" .= p_1_1, \"b\" .= p_1_2]]\n\-            \  toJSON Scotland = object [\"Scotland\" .= object []]"+            \  toJSON Scotland = object [\"Scotland\" .= object []]\n\+            \  toEncoding (Wales p_1_1) = pairs . pair \"Wales\" $ pairs (\"foo\" .= p_1_1 :: Series)\n\+            \  toEncoding (England p_1_1 p_1_2) = pairs . pair \"England\" $ pairs (\"a\" .= p_1_1 <> \"b\" .= p_1_2 :: Series)\n\+            \  toEncoding Scotland = pairs . pair \"Scotland\" $ emptyObject_"    it "should interpret FromJSON for sum types" $ do     let options = custom "field" . NamedIndexed $ M.fromList [("Wales", ["foo"]), ("England", ["a", "b"]), ("Scotland", [])]@@ -117,4 +118,7 @@       Right "instance ToJSON Union where\n\             \  toJSON (Wales p_1_1) = object [\"dragon\" .= object [\"foo\" .= p_1_1]]\n\             \  toJSON (England p_1_1 p_1_2) = object [\"lion\" .= object [\"a\" .= p_1_1, \"b\" .= p_1_2]]\n\-            \  toJSON Scotland = object [\"unicorn\" .= object []]"+            \  toJSON Scotland = object [\"unicorn\" .= object []]\n\+            \  toEncoding (Wales p_1_1) = pairs . pair \"dragon\" $ pairs (\"foo\" .= p_1_1 :: Series)\n\+            \  toEncoding (England p_1_1 p_1_2) = pairs . pair \"lion\" $ pairs (\"a\" .= p_1_1 <> \"b\" .= p_1_2 :: Series)\n\+            \  toEncoding Scotland = pairs . pair \"unicorn\" $ emptyObject_"
test/Boilerplate/RuleParserTests.hs view
@@ -46,18 +46,18 @@     shouldNotParse "{Param} = foo"     shouldNotParse "{Product {Param}} = foo"     "{Product\n{Field {{Param}}{}}} = foo" `shouldParseTo`-      [Product [Field [Raw ""] [Raw ""] [Param 1] "" ""], Raw " = foo"]+      [Product [Field [] [] [Param 1] "" ""], Raw " = foo"]   it "should parse long form Field inside Product" $ do     "{Product  {Field {}{<$>}{v .: }{ <*> }{}}}" `shouldParseTo`       [Product [Raw " ", Field [] [Raw "<$>"] [Raw "v .: "] " <*> " ""]]   it "should parse Field and ParamN inside Product" $ do     "{Product {Uncons1} {Uncons2} -> {Cons} {Field {{Param1} <> {Param2}}{ }}}" `shouldParseTo`       [Product [Uncons 1, Raw " ", Uncons 2, Raw " -> ", Cons, Raw " ",-        Field [Raw ""] [Raw ""] [Param 1, Raw " <> ", Param 2] " " ""]]+        Field [] [] [Param 1, Raw " <> ", Param 2] " " ""]]   it "should parse Field and ParamN inside Sum" $ do     "{Sum {{Uncons1} {Uncons2} -> {Cons} {Field {{Param1} <> {Param2}} { }}}{\n}}" `shouldParseTo`       [Sum "" [Uncons 1, Raw " ", Uncons 2, Raw " -> ", Cons, Raw " ",-        Field [Raw ""] [Raw ""] [Param 1, Raw " <> ", Param 2] " " ""] "\n" ""]+        Field [] [] [Param 1, Raw " <> ", Param 2] " " ""] "\n" ""]    it "should parse the FromJSON example" $ do     parsed <- parseRuleFile "boilerplate/Data/Aeson/FromJSON.rule"@@ -67,17 +67,8 @@     parsed <- parseRuleFile "boilerplate/Data/Aeson/ToJSON.rule"     parsed `shouldBe` (Right toJSONRule) -  it "should parse the FFunctor example" $ do-    parsed <- parseRuleFile "boilerplate/Data/FFunctor/FFunctor.rule"-    parsed `shouldBe` (Right ffunctorRule)- fromJSONRule :: Rule fromJSONRule = Rule [Sugar (Instance "FromJSON"),Raw "\n  parseJSON = withObject \"",Type,Raw "\" $ \\v ->\n",Product [Raw "    ",Cons,Raw " ",Field [] [Raw "<$> "] [Raw "v .: \"",Custom "field" (Just [FieldName]),Raw "\""] " <*> " "",Raw "\n"],Sum "    let withField key parse = (maybe (fail \"\") pure $ H.lookup key v) >>= (withObject (T.unpack key) parse)\n     in " [Raw "(withField \"",Custom "tag" (Just [Cons]),Raw "\" $ ",Field [Raw "\\_ -> pure ",Cons] [Raw "\\v' -> ",Cons,Raw " <$> "] [Raw "v' .: \"",Custom "field" (Just [FieldName]),Raw "\""] " <*> " "",Raw ")"] "\n    <|> " "\n    <|> (fail \"no valid type constructor tags\")\n"]  toJSONRule :: Rule-toJSONRule = Rule [Sugar (Instance "ToJSON"),Raw "\n",Product [Raw "  toJSON ",Uncons 1,Raw " = object ",Field [Raw "[]"] [Raw "["] [Raw "\"",Custom "field" (Just [FieldName]),Raw "\" .= ",Param 1] ", " "]",Raw "\n  toEncoding ",Uncons 1,Raw " = pairs ",Field [Raw "mempty"] [Raw "("] [Raw "\"",Custom "field" (Just [FieldName]),Raw "\" .= ",Param 1] " <> " ")",Raw "\n"],Sum "" [Raw "  toJSON ",Uncons 1,Raw " = object [\"",Custom "tag" (Just [Cons]),Raw "\" .= object ",Field [Raw "[]"] [Raw "["] [Raw "\"",Custom "field" (Just [FieldName]),Raw "\" .= ",Param 1] ", " "]",Raw "]\n"] "" ""]--ffunctorRule :: Rule-ffunctorRule = Rule [Raw "instance FFunctor ",Type,Raw " where\n",-                     Product [Raw "  ffmap nt ",Uncons 1,Raw " = ",Cons,Raw " ",Field [Raw ""] [Raw ""] [Raw "(nt ... ",Param 1,Raw ")"] " " "",Raw "\n"],-                     Sum "" [Raw "  ffmap nt ",Uncons 1,Raw " = ",Cons,Raw " ",Field [Raw ""] [Raw ""] [Raw "(nt ... ",Param 1,Raw ")"] " " "",Raw "\n"] "" ""]+toJSONRule = Rule [Sugar (Instance "ToJSON"),Raw "\n",Product [Raw "  toJSON ",Uncons 1,Raw " = object ",Field [Raw "[]"] [Raw "["] [Raw "\"",Custom "field" (Just [FieldName]),Raw "\" .= ",Param 1] ", " "]",Raw "\n  toEncoding ",Uncons 1,Raw " = pairs ",Field [Raw "mempty"] [Raw "("] [Raw "\"",Custom "field" (Just [FieldName]),Raw "\" .= ",Param 1] " <> " ")",Raw "\n"],Sum "" [Raw "  toJSON ",Uncons 1,Raw " = object [\"",Custom "tag" (Just [Cons]),Raw "\" .= object ",Field [Raw "[]"] [Raw "["] [Raw "\"",Custom "field" (Just [FieldName]),Raw "\" .= ",Param 1] ", " "]",Raw "]\n"] "" "",Sum "" [Raw "  toEncoding ",Uncons 1,Raw " = pairs . pair \"",Custom "tag" (Just [Cons]),Raw "\" $ ",Field [Raw "emptyObject_"] [Raw "pairs ("] [Raw "\"",Custom "field" (Just [FieldName]),Raw "\" .= ",Param 1] " <> " " :: Series)",Raw "\n"] "" "",Raw "\n"]