morpheus-graphql-code-gen 0.23.0 → 0.24.0
raw patch · 7 files changed
+115/−72 lines, 7 filesdep ~morpheus-graphql-code-gen-utilsdep ~morpheus-graphql-coredep ~morpheus-graphql-serverPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: morpheus-graphql-code-gen-utils, morpheus-graphql-core, morpheus-graphql-server
API changes (from Hackage documentation)
Files
- app/CLI/Commands.hs +11/−15
- app/CLI/File.hs +24/−8
- app/CLI/Generator.hs +14/−7
- app/Main.hs +56/−31
- morpheus-graphql-code-gen.cabal +6/−6
- src/Data/Morpheus/CodeGen/Server/Internal/AST.hs +3/−3
- src/Data/Morpheus/CodeGen/Server/Interpreting/Transform.hs +1/−2
app/CLI/Commands.hs view
@@ -3,7 +3,7 @@ module CLI.Commands ( GlobalOptions (..), App (..),- Operation (..),+ Command (..), parseCLI, ) where@@ -29,13 +29,14 @@ import qualified Options.Applicative as OA import Relude hiding (ByteString) -data Operation- = Build {source :: [FilePath]}+data Command+ = Build [FilePath]+ | Check [FilePath] | About deriving (Show) data App = App- { operations :: Operation,+ { operations :: Command, options :: GlobalOptions } deriving (Show)@@ -45,26 +46,21 @@ } deriving (Show) -commandParser :: Parser Operation+commandParser :: Parser Command commandParser = buildOperation- [ ( "build",- "builds Haskell API from GraphQL schema",- Build <$> readFiles- ),- ( "about",- "api information",- pure About- )+ [ ("build", "builds Haskell code from GQL source", Build <$> readFiles),+ ("check", "check if built Haskell code represent GQL source", Check <$> readFiles),+ ("about", "api information", pure About) ] -buildOperation :: [(String, String, Parser Operation)] -> Parser Operation+buildOperation :: [(String, String, Parser Command)] -> Parser Command buildOperation xs = joinParsers $ map parseOperation xs joinParsers :: [OA.Mod OA.CommandFields a] -> Parser a joinParsers xs = subparser $ mconcat xs -parseOperation :: (String, String, Parser Operation) -> OA.Mod OA.CommandFields Operation+parseOperation :: (String, String, Parser Command) -> OA.Mod OA.CommandFields Command parseOperation (bName, bDesc, bValue) = command bName (info (helper <*> bValue) (fullDesc <> progDesc bDesc))
app/CLI/File.hs view
@@ -1,18 +1,18 @@ {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} module CLI.File where -import Data.ByteString.Lazy (ByteString)-import qualified Data.ByteString.Lazy as L- ( writeFile,- )+import Data.ByteString.Lazy.Char8 (ByteString, readFile, writeFile) import Data.Char+import Data.Morpheus.Error (printError, printWarning) import Data.Morpheus.Internal.Ext ( GQLResult, Result (..), )-import Relude hiding (ByteString)+import Data.Morpheus.Types.Internal.AST (GQLError (..), msg)+import Relude hiding (ByteString, readFile, writeFile) import System.FilePath.Posix ( dropExtensions, makeRelative,@@ -30,9 +30,25 @@ capitalize [] = [] capitalize (x : xs) = toUpper x : xs -saveDocument :: FilePath -> GQLResult ByteString -> IO ()-saveDocument _ (Failure errors) = print errors-saveDocument output Success {result} = L.writeFile output result+printWarnings :: [GQLError] -> IO ()+printWarnings [] = pure ()+printWarnings warnings = traverse_ (putStr . (" " <>) . printWarning) warnings++cliError :: GQLError -> IO ()+cliError = putStr . (" " <>) . printError "error" "\x1b[31m"++checkGenerated :: FilePath -> ByteString -> IO Bool+checkGenerated path result = do+ file <- readFile path+ let isOutdated = file /= result+ traverse_ cliError ["outdated: " <> msg path | isOutdated]+ pure $ not isOutdated++processDocument :: Bool -> FilePath -> GQLResult ByteString -> IO Bool+processDocument _ _ (Failure errors) = traverse_ cliError (toList errors) $> False+processDocument check path Success {result, warnings}+ | check = printWarnings warnings >> checkGenerated path result+ | otherwise = printWarnings warnings >> writeFile path result $> True getModuleNameByPath :: FilePath -> FilePath -> [Char] getModuleNameByPath root path = intercalate "." $ splitDirectories $ dropExtensions $ makeRelative root path
app/CLI/Generator.hs view
@@ -16,6 +16,7 @@ ( SchemaSource, parseClientTypeDeclarations, )+import Data.Morpheus.Client.CodeGen.AST (ClientDeclaration (..), DERIVING_MODE (SCALAR_MODE)) import Data.Morpheus.CodeGen ( CodeGenConfig (..), parseServerTypeDefinitions,@@ -50,15 +51,21 @@ ] <> map (,["*"]) globalImports, extensions =- [ "DeriveGeneric",- "TypeFamilies",+ [ "DataKinds",+ "DeriveGeneric",+ "DuplicateRecordFields", "OverloadedStrings",- "DataKinds",- "DuplicateRecordFields"+ "TypeFamilies",+ "{-# HLINT ignore \"Use camelCase\" #-}",+ "{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}" ], types } +notScalars :: ClientDeclaration -> Bool+notScalars (InstanceDeclaration SCALAR_MODE _) = False+notScalars _ = True+ processClientDocument :: BuildConfig -> SchemaSource ->@@ -66,7 +73,7 @@ Text -> GQLResult ByteString processClientDocument BuildConfig {..} schema query moduleName = do- types <- parseClientTypeDeclarations schema query+ types <- filter notScalars <$> parseClientTypeDeclarations schema query let moduleDef = ModuleDefinition { moduleName,@@ -76,9 +83,9 @@ extensions = [ "DeriveGeneric", "DuplicateRecordFields",- "TypeFamilies",+ "LambdaCase", "OverloadedStrings",- "LambdaCase"+ "TypeFamilies" ], types }
app/Main.hs view
@@ -10,8 +10,8 @@ import CLI.Commands ( App (..),+ Command (..), GlobalOptions (..),- Operation (..), parseCLI, ) import CLI.Config@@ -20,8 +20,12 @@ ServiceOptions (..), readConfig, )-import CLI.File (getModuleNameByPath, processFileName, saveDocument)+import CLI.File (getModuleNameByPath, processDocument, processFileName) import CLI.Generator+ ( BuildConfig (..),+ processClientDocument,+ processServerDocument,+ ) import qualified Data.ByteString.Lazy as L ( readFile, )@@ -31,6 +35,7 @@ import Data.Version (showVersion) import qualified Paths_morpheus_graphql_code_gen as CLI import Relude hiding (ByteString)+import System.Exit (ExitCode (..)) import System.FilePath (normalise, (</>)) import System.FilePath.Glob (glob) @@ -46,64 +51,84 @@ | otherwise = runOperation operations where runOperation About = putStrLn $ "Morpheus GraphQL CLI, version " <> currentVersion- runOperation Build {source} = traverse_ scan source+ runOperation (Build source) = processAll (scan . Context False) source+ runOperation (Check source) = processAll (scan . Context True) source -scan :: FilePath -> IO ()-scan path = do- Config {server, client} <- readConfig path- traverse_ (handleServerService path) (concat $ maybeToList server)- traverse_ (handleClientService path) (concat $ maybeToList client)+data Context = Context+ { isCheck :: Bool,+ configDir :: FilePath+ } +type CommandResult = Bool++processAll :: (Traversable t, MonadIO m) => (a1 -> m Bool) -> t a1 -> m b+processAll f xs = do+ res <- traverse f xs+ if and res+ then putStr "\x1b[32mOK\x1b[0m\n" >> exitSuccess+ else exitWith (ExitFailure 1)++scan :: Context -> IO CommandResult+scan ctx = do+ Config {server, client} <- readConfig (configDir ctx)+ servers <- traverse (handleServerService ctx) (concat $ maybeToList server)+ clients <- traverse (handleClientService ctx) (concat $ maybeToList client)+ pure $ and (servers <> clients)+ getImports :: Maybe ServiceOptions -> [Text] getImports = concat . maybeToList . (>>= globals) -handleClientService :: FilePath -> Service -> IO ()-handleClientService target Service {name, source, includes, options, schema} = do- let root = normalise (target </> source)+parseServiceData :: Context -> Service -> IO (FilePath, Bool, [FilePath], [Text])+parseServiceData ctx Service {source, includes, options} = do+ let root = normalise (configDir ctx </> source) let namespaces = fromMaybe False (options >>= namespace) let patterns = map (normalise . (root </>)) includes files <- concat <$> traverse glob patterns+ let globalImports = getImports options+ pure (root, namespaces, files, globalImports)++handleClientService :: Context -> Service -> IO CommandResult+handleClientService ctx s@Service {name, schema} = do+ (root, namespaces, files, globalImports) <- parseServiceData ctx s putStrLn ("\n build:" <> name) schemaPath <- maybe (fail $ "client service " <> name <> " should provide schema!") pure schema- let globalImports = getImports options let config = BuildConfig {..}- buildClientGlobals config (normalise $ root </> schemaPath)- traverse_ (buildClientQuery config (normalise $ root </> schemaPath)) files+ globals <- buildClientGlobals ctx config (normalise $ root </> schemaPath)+ and . (globals :) <$> traverse (buildClientQuery ctx config (normalise $ root </> schemaPath)) files -buildClientGlobals :: BuildConfig -> FilePath -> IO ()-buildClientGlobals options schemaPath = do+buildClientGlobals :: Context -> BuildConfig -> FilePath -> IO CommandResult+buildClientGlobals ctx options schemaPath = do putStr (" - " <> schemaPath <> "\n") schemaDoc <- readSchemaSource schemaPath let hsPath = processFileName schemaPath let moduleName = pack $ getModuleNameByPath (root options) hsPath- saveDocument hsPath (processClientDocument options schemaDoc Nothing moduleName)+ let result = processClientDocument options schemaDoc Nothing moduleName+ processDocument (isCheck ctx) hsPath result -buildClientQuery :: BuildConfig -> FilePath -> FilePath -> IO ()-buildClientQuery options schemaPath queryPath = do+buildClientQuery :: Context -> BuildConfig -> FilePath -> FilePath -> IO CommandResult+buildClientQuery ctx options schemaPath queryPath = do putStr (" - " <> queryPath <> "\n") file <- TIO.readFile queryPath schemaDoc <- readSchemaSource schemaPath let moduleName = getModuleNameByPath (root options) hsPath let globalModuleName = pack (getModuleNameByPath (root options) (processFileName schemaPath))- saveDocument hsPath (processClientDocument (options {globalImports = [globalModuleName]}) schemaDoc (Just file) (pack moduleName))+ let result = processClientDocument (options {globalImports = [globalModuleName]}) schemaDoc (Just file) (pack moduleName)+ processDocument (isCheck ctx) hsPath result where hsPath = processFileName queryPath -handleServerService :: FilePath -> Service -> IO ()-handleServerService target Service {name, source, includes, options} = do- let root = normalise (target </> source)- let namespaces = fromMaybe False (options >>= namespace)- let patterns = map (normalise . (root </>)) includes- files <- concat <$> traverse glob patterns+handleServerService :: Context -> Service -> IO CommandResult+handleServerService ctx s@Service {name} = do+ (root, namespaces, files, globalImports) <- parseServiceData ctx s putStrLn ("\n build:" <> name)- let globalImports = getImports options- traverse_ (buildServer (BuildConfig {..}) {root, namespaces}) files+ and <$> traverse (buildServer ctx (BuildConfig {..}) {root, namespaces}) files -buildServer :: BuildConfig -> FilePath -> IO ()-buildServer options path = do+buildServer :: Context -> BuildConfig -> FilePath -> IO CommandResult+buildServer ctx options path = do putStr (" - " <> path <> "\n") file <- L.readFile path let moduleName = getModuleNameByPath (root options) hsPath- saveDocument hsPath (processServerDocument options moduleName file)+ let result = processServerDocument options moduleName file+ processDocument (isCheck ctx) hsPath result where hsPath = processFileName path
morpheus-graphql-code-gen.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: morpheus-graphql-code-gen-version: 0.23.0+version: 0.24.0 synopsis: Morpheus GraphQL CLI description: code generator for Morpheus GraphQL category: web, graphql, cli@@ -44,9 +44,9 @@ , bytestring >=0.10.4 && <0.12.0 , containers >=0.4.2.1 && <0.7.0 , file-embed >=0.0.10 && <1.0.0- , morpheus-graphql-code-gen-utils >=0.23.0 && <0.24.0- , morpheus-graphql-core >=0.23.0 && <0.24.0- , morpheus-graphql-server >=0.23.0 && <0.24.0+ , morpheus-graphql-code-gen-utils >=0.24.0 && <0.25.0+ , morpheus-graphql-core >=0.24.0 && <0.25.0+ , morpheus-graphql-server >=0.24.0 && <0.25.0 , prettyprinter >=1.7.0 && <2.0.0 , relude >=0.3.0 && <2.0.0 , template-haskell >=2.0.0 && <3.0.0@@ -75,8 +75,8 @@ , morpheus-graphql-client , morpheus-graphql-code-gen , morpheus-graphql-code-gen-utils- , morpheus-graphql-core >=0.23.0 && <0.24.0- , morpheus-graphql-server >=0.23.0 && <0.24.0+ , morpheus-graphql-core >=0.24.0 && <0.25.0+ , morpheus-graphql-server >=0.24.0 && <0.25.0 , optparse-applicative >=0.12.0 && <0.18.0 , prettyprinter >=1.7.0 && <2.0.0 , relude >=0.3.0 && <2.0.0
src/Data/Morpheus/CodeGen/Server/Internal/AST.hs view
@@ -51,13 +51,12 @@ Value, unpackName, )+import Data.Text.Prettyprint.Doc (concatWith, indent, line) import Language.Haskell.TH.Lib (appE, varE) import Prettyprinter ( Pretty (..), align, pretty,- punctuate,- vsep, (<+>), ) import Relude hiding (Show, optional, print, show)@@ -141,6 +140,7 @@ <+> "TypeGuard" <+> unpack (print interfaceName .<> "m") <+> unpack (print unionName .<> "m")+ <> line -- TODO: on scalar we should render user provided type pretty ScalarType {..} = "type" <+> ignore (print scalarTypeName) <+> "= Int" pretty (DataType cgType) = pretty cgType@@ -158,7 +158,7 @@ instance Pretty ServerMethod where pretty (ServerMethodDefaultValues x) = pretty (show x)- pretty (ServerMethodDirectives dirs) = align $ vsep $ punctuate " <>" (map pretty dirs)+ pretty (ServerMethodDirectives dirs) = line <> indent 2 (align $ concatWith (\x y -> x <> "\n <>" <+> y) (map pretty dirs)) instance PrintExp ServerMethod where printExp (ServerMethodDefaultValues values) = [|values|]
src/Data/Morpheus/CodeGen/Server/Interpreting/Transform.hs view
@@ -24,7 +24,6 @@ MethodArgument (..), TypeClassInstance (..), fromTypeName,- getFullName, ) import Data.Morpheus.CodeGen.Server.Internal.AST ( CodeGenConfig (..),@@ -349,7 +348,7 @@ { constructorName, constructorFields = [ CodeGenField- { fieldName = coerce ("un" <> getFullName constructorName),+ { fieldName = "_", fieldType = packName (toHaskellTypeName memberName), wrappers = [PARAMETRIZED], fieldIsNullable = False