proto-lens-protoc 0.3.1.3 → 0.4.0.0

raw patch · 6 files changed

+126/−598 lines, 6 filesdep −Cabaldep −data-default-classdep −deepseqdep ~basedep ~containersdep ~proto-lensPVP ok

version bump matches the API change (PVP)

Dependencies removed: Cabal, data-default-class, deepseq, directory, lens-labels, process, temporary

Dependency ranges changed: base, containers, proto-lens

API changes (from Hackage documentation)

Files

• Changelog.md +12/−6
• app/protoc-gen-haskell.hs +8/−6
• proto-lens-protoc.cabal +9/−44
• src/Data/ProtoLens/Compiler/Combinators.hs +6/−0
• src/Data/ProtoLens/Compiler/Generate.hs +91/−63
• src/Data/ProtoLens/Setup.hs +0/−479

@@ -1,9 +1,18 @@ # Changelog for `proto-lens-protoc` -## v0.3.1.3+## v0.4+- Split out `proto-lens-setup` and `proto-lens-runtime` into separate+  packages.+- Hide the constructors and record fields of message types, and make `Show`+  instances call `showMessageShort`.+- Generate explicit `NFData` instances for each type.+- Track the change to `proto-lens`: Don't use `data-default` for+  defaul proto values (#194).+- Use simplified lens-labels instances. (#208)++## v0.3.1.2 - Bump the upper bound to `temporary-1.3`. - Fix warnings.-- Add support for ghc-8.6.  ## v0.3.1.1 - Fix management of generated files between Cabal components (#171).@@ -24,14 +33,11 @@ - Don't generate Haskell modules if they won't be used. (#126) - Bundle enum pattern synonyms exports with their type. (#136) - Split the `Message` class into separate methods. (#139)-- Refactor the `FieldDescriptorType. (#147)+- Refactor the `FieldDescriptorType`. (#147) - Add a case to proto3 enums for unknown values. (#137) - Track consolidation of `proto-lens-descriptors` into `proto-lens`. (#140) - Generate service definitions using promoted datatypes. (#154) - Generate prisms for `oneof` message fields. (#160)-- Build with `haskell-src-exts-1.20.*`. (#170)-- Add Haddock comments to fields. (#172)-- Don't unnecessarily touch files. (#177)  ## v0.2.2.3 - Don't camel-case message names.  This reverts behavior which was added

@@ -14,7 +14,7 @@ import qualified Data.Set as Set import qualified Data.Text as T import Data.Text (Text, pack)-import Data.ProtoLens (decodeMessage, def, encodeMessage)+import Data.ProtoLens (decodeMessage, defMessage, encodeMessage) import Lens.Family2 import Proto.Google.Protobuf.Compiler.Plugin     ( CodeGeneratorRequest@@ -51,19 +51,21 @@  makeResponse :: String -> CodeGeneratorRequest -> CodeGeneratorResponse makeResponse prog request = let-    useReexport = case T.unpack $ request ^. parameter of+    useRuntime = case T.unpack $ request ^. parameter of                     "" -> reexported-                    "no-reexports" -> id+                    "no-runtime" -> id                     p -> error $ "Error reading parameter: " ++ show p-    outputFiles = generateFiles useReexport header+    outputFiles = generateFiles useRuntime header                       (request ^. protoFile)                       (request ^. fileToGenerate)     header :: FileDescriptorProto -> Text     header f = "{- This file was auto-generated from "                 <> (f ^. name)                 <> " by the " <> pack prog <> " program. -}\n"-    in def & file .~ [ def & name .~ outputName-                           & content .~ outputContent+    in defMessage+           & file .~ [ defMessage+                            & name .~ outputName+                            & content .~ outputContent                      | (outputName, outputContent) <- outputFiles                      ] 

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 67abce4e43117635551e092a847159fa0cd85ababdeba28c6bd694ab998bbc50+-- hash: f70b96202ee9a7ec921d1b59d0317817c43f639d31fda260d34e2c74d90463df  name:           proto-lens-protoc-version:        0.3.1.3+version:        0.4.0.0 synopsis:       Protocol buffer compiler for the proto-lens library. description:    Turn protocol buffer files (.proto) into Haskell files (.hs) which can be used with the proto-lens package.                 The library component of this package contains compiler code (namely Data.ProtoLens.Compiler.*) is not guaranteed to have stable APIs.'@@ -18,7 +18,7 @@ license:        BSD3 license-file:   LICENSE build-type:     Simple-cabal-version:  >= 1.22+cabal-version:  >= 1.10 extra-source-files:     Changelog.md @@ -27,55 +27,24 @@   location: https://github.com/google/proto-lens   subdir: proto-lens-protoc -flag only-executable-  description: Only build the executable.  Used for bootstrapping.-  manual: False-  default: False- library   exposed-modules:       Data.ProtoLens.Compiler.Combinators       Data.ProtoLens.Compiler.Definitions       Data.ProtoLens.Compiler.Generate       Data.ProtoLens.Compiler.Plugin-      Data.ProtoLens.Setup   other-modules:       Paths_proto_lens_protoc-  reexported-modules:-      Prelude as Data.ProtoLens.Reexport.Prelude,-      Data.Int as Data.ProtoLens.Reexport.Data.Int,-      Data.Word as Data.ProtoLens.Reexport.Data.Word,-      Data.ByteString as Data.ProtoLens.Reexport.Data.ByteString,-      Data.ByteString.Char8 as Data.ProtoLens.Reexport.Data.ByteString.Char8,-      Data.Default.Class as Data.ProtoLens.Reexport.Data.Default.Class,-      Data.Map as Data.ProtoLens.Reexport.Data.Map,-      Data.ProtoLens as Data.ProtoLens.Reexport.Data.ProtoLens,-      Data.ProtoLens.Service.Types as Data.ProtoLens.Reexport.Data.ProtoLens.Service.Types,-      Data.ProtoLens.Message.Enum as Data.ProtoLens.Reexport.Data.ProtoLens.Message.Enum,-      Data.Text as Data.ProtoLens.Reexport.Data.Text,-      Lens.Family2 as Data.ProtoLens.Reexport.Lens.Family2,-      Lens.Family2.Unchecked as Data.ProtoLens.Reexport.Lens.Family2.Unchecked,-      Lens.Labels as Data.ProtoLens.Reexport.Lens.Labels,-      Lens.Labels.Prism as Data.ProtoLens.Reexport.Lens.Labels.Prism,-      Text.Read as Data.ProtoLens.Reexport.Text.Read   hs-source-dirs:       src   build-depends:-      Cabal >=1.22 && <2.5-    , base >=4.9 && <4.13-    , bytestring ==0.10.*-    , containers >=0.5 && <0.7-    , data-default-class >=0.0 && <0.2-    , deepseq ==1.4.*-    , directory >=1.2 && <1.4+      base >=4.9 && <4.12+    , containers ==0.5.*     , filepath >=1.4 && <1.6     , haskell-src-exts >=1.17 && <1.21     , lens-family ==1.2.*-    , lens-labels ==0.2.*     , pretty ==1.1.*-    , process >=1.2 && <1.7-    , proto-lens ==0.3.*-    , temporary >=1.2 && <1.4+    , proto-lens ==0.4.*     , text ==1.2.*   default-language: Haskell2010 @@ -86,15 +55,11 @@   hs-source-dirs:       app   build-depends:-      base >=4.9 && <4.13+      base >=4.9 && <4.12     , bytestring ==0.10.*-    , containers >=0.5 && <0.7-    , data-default-class >=0.0 && <0.2-    , deepseq ==1.4.*-    , filepath >=1.4 && <1.6-    , haskell-src-exts >=1.17 && <1.21+    , containers ==0.5.*     , lens-family ==1.2.*-    , proto-lens ==0.3.*+    , proto-lens ==0.4.*     , proto-lens-protoc     , text ==1.2.*   default-language: Haskell2010

@@ -157,6 +157,9 @@ stringExp :: String -> Exp stringExp = Syntax.Lit () . string +charExp :: Char -> Exp+charExp = Syntax.Lit () . char+ tuple :: [Exp] -> Exp tuple = Syntax.Tuple () Syntax.Boxed @@ -406,6 +409,9 @@  string :: String -> Syntax.Literal () string s = Syntax.String () s (show s)++char :: Char -> Syntax.Literal ()+char c = Syntax.Char () c [c]  modifyModuleName :: (String -> String) -> ModuleName -> ModuleName modifyModuleName f (Syntax.ModuleName _ unpacked) =

@@ -65,9 +65,9 @@     "" -> Proto2  -- The proto compiler doesn't set syntax for proto2 files.     s -> error $ "Unknown syntax type " ++ show s --- Whether to import the "Reexport" modules or the originals;--- e.g., Data.ProtoLens.Reexport.Data.Map vs Data.Map.-data UseReexport = UseReexport | UseOriginal+-- Whether to import the "Runtime" modules or the originals;+-- e.g., Data.ProtoLens.Runtime.Data.Map vs Data.Map.+data UseRuntime = UseRuntime | UseOriginal     deriving (Eq, Read)  -- | Generate a Haskell module for the given input file(s).@@ -84,7 +84,7 @@     = [ Module modName                 (Just $ (serviceExports ++) $ concatMap generateExports $ Map.elems definitions)                 pragmas-                (prismImport:sharedImports)+                (mainImports ++ sharedImports)           $ (concatMap generateDecls $ Map.toList definitions)          ++ map uncommented (concatMap (generateServiceDecls env) services)       , Module fieldModName@@ -110,11 +110,12 @@           -- in a single entry, so we use two: `Foo(..)` and `Foo(A, B)`.           , optionsGhcPragma "-fno-warn-duplicate-exports"           ]-    prismImport = modifyImport $ importSimple "Lens.Labels.Prism"+    mainImports = map (modifyImport . importSimple)+                    [ "Control.DeepSeq", "Lens.Labels.Prism" ]     sharedImports = map (modifyImport . importSimple)               [ "Prelude", "Data.Int", "Data.Word"               , "Data.ProtoLens", "Data.ProtoLens.Message.Enum", "Data.ProtoLens.Service.Types"-              , "Lens.Family2", "Lens.Family2.Unchecked", "Data.Default.Class"+              , "Lens.Family2", "Lens.Family2.Unchecked"               , "Data.Text",  "Data.Map", "Data.ByteString", "Data.ByteString.Char8"               , "Lens.Labels", "Text.Read"               ]@@ -165,7 +166,7 @@ reexported imp@ImportDecl {importModule = m}     = imp { importAs = Just m, importModule = m' }   where-    m' = fromString $ "Data.ProtoLens.Reexport." ++ prettyPrint m+    m' = fromString $ "Data.ProtoLens.Runtime." ++ prettyPrint m  messageComment :: ModuleName -> Name -> [RecordField] -> String messageComment fieldModName n fields = unlines@@ -181,8 +182,10 @@  generateMessageExports :: MessageInfo Name -> [ExportSpec] generateMessageExports m =-    map (exportAll . unQual)-        $ messageName m : map oneofTypeName (messageOneofFields m)+    -- Hide the message contructor, but expose "oneof" case constructors.+    exportWith (unQual $ messageName m) []+        : map (exportAll . unQual . oneofTypeName)+                (messageOneofFields m)  generateServiceDecls :: Env QName -> ServiceInfo -> [Decl] generateServiceDecls env si =@@ -253,9 +256,16 @@                       ]                       ++ [(messageUnknownFields info, "Data.ProtoLens.FieldSet")]             ]-            $ deriving' ["Prelude.Show", "Prelude.Eq", "Prelude.Ord"]+            $ deriving' ["Prelude.Eq", "Prelude.Ord"]+    -- instance Show Bar where+    --   showsPrec __x __s = showChar '{' (showString (showMessageShort __x) (showChar '}' s))+    , uncommented $+        instDecl [] ("Prelude.Show" `ihApp` [dataType])+            [[match "showsPrec" ["_", "__x", "__s"]+                $ "Prelude.showChar" @@ charExp '{'+                    @@ ("Prelude.showString" @@ ("Data.ProtoLens.showMessageShort" @@ "__x")+                        @@ ("Prelude.showChar" @@ charExp '}' @@ "__s"))]]     ] ++-     -- oneof field data type declarations     -- proto: message Foo {     --          oneof bar {@@ -274,24 +284,13 @@       $ deriving' ["Prelude.Show", "Prelude.Eq", "Prelude.Ord"]     | oneofInfo <- messageOneofFields info     ] ++-    -- instance (HasLens' f Foo x a, HasLens' f Foo x b, a ~ b)-    --    => HasLens f Foo Foo x a b-    [ uncommented $-          instDecl [classA "Lens.Labels.HasLens'" ["f", dataType, "x", "a"],-                    equalP "a" "b"]-              ("Lens.Labels.HasLens" `ihApp`-                  ["f", dataType, dataType, "x", "a", "b"])-              [[match "lensOf" [] "Lens.Labels.lensOf'"]]-    ]-    ++-    -- instance Functor f-    --     => HasLens' f Foo "foo" Bar+    -- instance HasLens' Foo "foo" Bar     --   lensOf _ = ...     -- Note: for optional fields, this generates an instance both for "foo" and     -- for "maybe'foo" (see plainRecordField below).-    [ uncommented $ instDecl [classA "Prelude.Functor" ["f"]]+    [ uncommented $ instDecl []         ("Lens.Labels.HasLens'" `ihApp`-            ["f", dataType, sym, tyParen t])+            [dataType, sym, tyParen t])             [[match "lensOf'" [pWildCard] $                 "Prelude.."                     @@ rawFieldAccessor (unQual $ recordFieldName li)@@ -302,27 +301,19 @@     , let sym = promoteSymbol $ lensSymbol i     ]     ++-    -- instance Data.Default.Class.Default Bar where-    [ uncommented $ instDecl [] ("Data.Default.Class.Default" `ihApp` [dataType])-        -- def = Bar { _Bar_foo = 0 }-        [-            [ match "def" []-                $ recConstr (unQual dataName) $-                      [ fieldUpdate (unQual $ haskellRecordFieldName $ plainFieldName f)-                            (hsFieldDefault syntaxType env (fieldDescriptor f))-                      | f <- messageFields info-                      ] ++-                      [ fieldUpdate (unQual $ haskellRecordFieldName $ oneofFieldName o)-                            "Prelude.Nothing"-                      | o <- messageOneofFields info-                      ] ++-                      [ fieldUpdate (unQual $ messageUnknownFields info)-                            "[]"]-            ]-        ]     -- instance Message.Message Bar where-    , uncommented $ instDecl [] ("Data.ProtoLens.Message" `ihApp` [dataType])+    [ uncommented $ instDecl [] ("Data.ProtoLens.Message" `ihApp` [dataType])         $ messageInstance syntaxType env protoName info+    -- instance NFData Bar where+    , uncommented $ instDecl [] ("Control.DeepSeq.NFData" `ihApp` [dataType])+        [[match "rnf" [] $ messageRnfExpr info]]+    ] +++    -- instance NFData Foo'Bar where+    [ uncommented $+        instDecl [] ("Control.DeepSeq.NFData" `ihApp`+                        [tyCon $ unQual $ oneofTypeName o])+        [map oneofRnfMatch $ oneofCases o]+    | o <- messageOneofFields info     ]   where     dataType = tyCon $ unQual dataName@@ -523,14 +514,15 @@             "Data.ProtoLens.Message.Enum.messageEnumFromThenTo"         ] -    -- instance Data.Default.Class.Default Foo where-    --   def = FirstEnumValue-    , instDecl [] ("Data.Default.Class.Default" `ihApp` [dataType])-        [[match "def" [] defaultCon]]     -- instance Data.ProtoLens.FieldDefault Foo where     --   fieldDefault = FirstEnumValue     , instDecl [] ("Data.ProtoLens.FieldDefault" `ihApp` [dataType])         [[match "fieldDefault" [] defaultCon]]+    -- instance NFData Foo where+    --   rnf x__ = seq x__ ()+    -- (Trivial since enum types are already strict)+    , instDecl [] ("Control.DeepSeq.NFData" `ihApp` [dataType])+        [[ match "rnf" ["x__"] $ "Prelude.seq" @@ "x__" @@ "()" ]]     ] ++     -- pattern Enum2a :: FooEnum     -- pattern Enum2a = Enum2@@ -601,10 +593,6 @@     [ dataDecl dataName         [conDecl n [] | n <- constructorNames]         $ deriving' ["Prelude.Show", "Prelude.Eq", "Prelude.Ord"]-    -- instance Data.Default.Class.Default Foo where-    --   def = FirstEnumValue-    , instDecl [] ("Data.Default.Class.Default" `ihApp` [dataType])-        [[match "def" [] defaultCon]]     -- instance Data.ProtoLens.FieldDefault Foo where     --   fieldDefault = FirstEnumValue     , instDecl [] ("Data.ProtoLens.FieldDefault" `ihApp` [dataType])@@ -684,6 +672,11 @@         [[ match "minBound" [] $ con $ unQual minBoundName          , match "maxBound" [] $ con $ unQual maxBoundName          ]]+    -- instance NFData Foo where+    --   rnf x__ = seq x__ ()+    -- (Trivial since enum types are already strict)+    , instDecl [] ("Control.DeepSeq.NFData" `ihApp` [dataType])+        [[ match "rnf" ["x__"] $ "Prelude.seq" @@ "x__" @@ "()" ]]     ]     ++     -- pattern FooAlias :: Foo@@ -738,14 +731,14 @@  generateFieldDecls :: Symbol -> [Decl] generateFieldDecls xStr =-    -- foo :: forall x f s t a b-    --        . HasLens f s t x a b => LensLike f s t a b-    -- -- Note: `Lens.Family2.LensLike f` implies Functor f.+    -- foo :: forall f s a+    --        . (Functor f, HasLens s x a) => LensLike' f s a     -- foo = lensOf (Proxy# :: Proxy# x)     [ typeSig [x]-          $ tyForAll ["f", "s", "t", "a", "b"]-                  [classA "Lens.Labels.HasLens" ["f", "s", "t", xSym, "a", "b"]]-                    $ "Lens.Family2.LensLike" @@ "f" @@ "s" @@ "t" @@ "a" @@ "b"+          $ tyForAll ["f", "s", "a"]+                  [classA "Prelude.Functor" ["f"],+                   classA "Lens.Labels.HasLens'" ["s", xSym, "a"]]+                    $ "Lens.Family2.LensLike'" @@ "f" @@ "s" @@ "a"     , funBind [match x [] $ lensOfExp xStr]     ]   where@@ -763,7 +756,7 @@         -- ^ All of the (overloaded) lenses accessing this record field.     } --- | An instance of HasLens for a particualr field.+-- | An instance of HasLens' for a particular field. data LensInstance = LensInstance     { lensSymbol :: Symbol           -- ^ The overloaded name for this lens.@@ -949,10 +942,10 @@  hsFieldValueDefault :: Env QName -> FieldDescriptorProto -> Exp hsFieldValueDefault env fd = case fd ^. type' of-    FieldDescriptorProto'TYPE_MESSAGE -> "Data.Default.Class.def"-    FieldDescriptorProto'TYPE_GROUP -> "Data.Default.Class.def"+    FieldDescriptorProto'TYPE_MESSAGE -> "Data.ProtoLens.defMessage"+    FieldDescriptorProto'TYPE_GROUP -> "Data.ProtoLens.defMessage"     FieldDescriptorProto'TYPE_ENUM-        | T.null def -> "Data.Default.Class.def"+        | T.null def -> "Data.ProtoLens.fieldDefault"         | Enum e <- definedFieldType fd env         , Just v <- List.lookup def [ (enumValueDescriptor v ^. name, enumValueName v)                                     | v <- enumValues e@@ -1047,6 +1040,19 @@           let' (map (fieldDescriptorVarBind $ messageName m) $ fields)               $ "Data.Map.fromList" @@ list fieldsByTag ]     , [ match "unknownFields" [] $ rawFieldAccessor (unQual $ messageUnknownFields m) ]+    , [ match "defMessage" []+           $ recConstr (unQual $ messageName m) $+                  [ fieldUpdate (unQual $ haskellRecordFieldName $ plainFieldName f)+                        (hsFieldDefault syntaxType env (fieldDescriptor f))+                  | f <- messageFields m+                  ] +++                  [ fieldUpdate (unQual $ haskellRecordFieldName $ oneofFieldName o)+                        "Prelude.Nothing"+                  | o <- messageOneofFields m+                  ] +++                  [ fieldUpdate (unQual $ messageUnknownFields m)+                        "[]"]+      ]     ]   where     fieldsByTag =@@ -1129,7 +1135,7 @@               _ -> overloadedField f  lensOfExp :: Symbol -> Exp-lensOfExp sym = ("Lens.Labels.lensOf"+lensOfExp sym = ("Lens.Labels.lensOf'"                   @@ ("Lens.Labels.proxy#" @::@                       ("Lens.Labels.Proxy#" @@ promoteSymbol sym))) @@ -1181,3 +1187,25 @@   where     mk x y = fromString ("Data.ProtoLens." ++ x)               @@ fromString ("Data.ProtoLens." ++ y)++-- | Generate the implementation of NFData.rnf for the given message.+--+-- instance NFData Bar where+--    rnf = \x -> deepseq (_Bar'foo x) (deepseq (_Bar'bar x) ())+messageRnfExpr :: MessageInfo Name -> Exp+messageRnfExpr msg = lambda ["x__"] $ foldr (@@) "()" (map seqField fieldNames)+  where+    fieldNames = messageUnknownFields msg+                : map (haskellRecordFieldName . plainFieldName)+                       (messageFields msg)+                ++ map (haskellRecordFieldName . oneofFieldName)+                       (messageOneofFields msg)+    seqField :: Name -> Exp+    seqField f = "Control.DeepSeq.deepseq" @@ (var (unQual f) @@ "x__")++-- instance NFData Bar where+--   rnf (Foo'a x__) = rnf x__+--   rnf (Bar'b x__) = rnf x__+oneofRnfMatch :: OneofCase -> Match+oneofRnfMatch c = match "rnf" [unQual (caseConstructorName c) `pApp` ["x__"]]+                    $ "Control.DeepSeq.rnf" @@ "x__"

@@ -1,479 +0,0 @@--- Copyright 2016 Google Inc. All Rights Reserved.------ Use of this source code is governed by a BSD-style--- license that can be found in the LICENSE file or at--- https://developers.google.com/open-source/licenses/bsd---- | Helper functions to generate proto files as part of a @Setup.hs@ script.------ These functions assume that the @proto-lens-protoc@ executable is on the--- PATH, and throw an exception otherwise.  That executable will be installed--- automatically as part of installing this package; in particular, it should--- be enough to just list `proto-lens-protoc` in a user package's--- `build-dependencies`.------ See @README.md@ for instructions on how to use proto-lens with Cabal.-{-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns #-}-module Data.ProtoLens.Setup-    ( defaultMainGeneratingProtos-    , defaultMainGeneratingSpecificProtos-    , generatingProtos-    , generatingSpecificProtos-    , generateProtosWithImports-    , generateProtos-    ) where--import Control.Monad (filterM, forM_, when)-import qualified Data.ByteString as BS-import qualified Data.Map as Map-import Data.Maybe (maybeToList)-import qualified Data.Set as Set-import qualified Data.Text as T-import Distribution.ModuleName (ModuleName)-import qualified Distribution.ModuleName as ModuleName-import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo-import Distribution.PackageDescription-    ( PackageDescription(..)-    , benchmarkBuildInfo-    , benchmarkName-    , buildInfo-    , exeName-    , exposedModules-    , extraSrcFiles-#if !MIN_VERSION_Cabal(2,0,0)-    , hsSourceDirs-#endif-#if MIN_VERSION_Cabal(2,4,0)-    , specVersion-#endif-    , libBuildInfo-    , otherModules-    , testBuildInfo-    , testBuildInfo-    , testName-    )-import qualified Distribution.Simple.BuildPaths as BuildPaths-import Distribution.Simple.InstallDirs (datadir)-import Distribution.Simple.LocalBuildInfo-    ( LocalBuildInfo(..)-    , absoluteInstallDirs-    , ComponentName(..)-    , ComponentLocalBuildInfo-    , componentPackageDeps-#if MIN_VERSION_Cabal(2,0,0)-    , allComponentsInBuildOrder-    , componentNameMap-#endif-    )-import qualified Distribution.Simple.PackageIndex as PackageIndex-import Distribution.Simple.Setup (fromFlag, copyDest, copyVerbosity)-import Distribution.Simple.Utils-    ( createDirectoryIfMissingVerbose-    , installOrdinaryFile-#if MIN_VERSION_Cabal(2,4,0)-#else-    , matchFileGlob-#endif-    )-#if MIN_VERSION_Cabal(2,4,0)-import Distribution.Simple.Glob (matchDirFileGlob)-#endif-import Distribution.Simple-    ( defaultMainWithHooks-    , simpleUserHooks-    , UserHooks(..)-    )-import Distribution.Verbosity-    ( Verbosity-#if MIN_VERSION_Cabal(2,4,0)-    , normal-#endif-    )-import System.FilePath-    ( (</>)-    , equalFilePath-    , isRelative-    , makeRelative-    , takeDirectory-    , takeExtension-    )-import System.Directory-    ( copyFile-    , createDirectoryIfMissing-    , doesDirectoryExist-    , doesFileExist-    , findExecutable-    , removeDirectoryRecursive-    )-import System.IO (hPutStrLn, stderr)-import System.IO.Temp (withSystemTempDirectory)-import System.Process (callProcess)--import qualified Data.ProtoLens.Compiler.Plugin as Plugin---- | This behaves the same as 'Distribution.Simple.defaultMain', but--- auto-generates Haskell files from .proto files which are:------ * Listed in the @.cabal@ file under @extra-source-files@,------ * Located under the given root directory, and------ * Correspond to a module (@"Proto.*"@) in `exposed-modules` or--- `other-modules` of some component in the @.cabal@ file.------ Writes the generated files to the autogen directory (@dist\/build\/autogen@--- for Cabal, and @.stack-work\/dist\/...\/build\/autogen@ for stack).------ Throws an exception if the @proto-lens-protoc@ executable is not on the PATH.-defaultMainGeneratingProtos-    :: FilePath -- ^ The root directory under which .proto files can be found.-    -> IO ()-defaultMainGeneratingProtos root-    = defaultMainWithHooks $ generatingProtos root simpleUserHooks---- | This behaves the same as 'Distribution.Simple.defaultMain', but--- auto-generates Haskell files from the .proto files listed. The given .proto--- files should be under the given root directory.------ Writes the generated files to the autogen directory (@dist\/build\/autogen@--- for Cabal, and @.stack-work\/dist\/...\/build\/autogen@ for stack).------ Throws an exception if the @proto-lens-protoc@ executable is not on the PATH.-defaultMainGeneratingSpecificProtos-    :: FilePath -- ^ The root directory under which .proto files can be found.-    -> (LocalBuildInfo -> IO [FilePath])-    -- ^ A function to return a list of .proto files. Takes the Cabal package-    -- description as input. Non-absolute paths are treated as relative to the-    -- provided root directory.-    -> IO ()-defaultMainGeneratingSpecificProtos root getProtos-    = defaultMainWithHooks-    $ generatingSpecificProtos root getProtos simpleUserHooks---- | Augment the given 'UserHooks' to auto-generate Haskell files from the--- .proto files which are:------ * Listed in the @.cabal@ file under @extra-source-files@,------ * Located under the given root directory, and------ * Correspond to a module (@"Proto.*"@) in `exposed-modules` or--- `other-modules` of some component in the @.cabal@ file.------ Writes the generated files to the autogen directory (@dist\/build\/autogen@--- for Cabal, and @.stack-work\/dist\/...\/build\/autogen@ for stack).------ Throws an exception if the @proto-lens-protoc@ executable is not on the PATH.-generatingProtos-    :: FilePath -- ^ The root directory under which .proto files can be found.-    -> UserHooks -> UserHooks-generatingProtos root = generatingSpecificProtos root getProtos-  where-    getProtos l = do-      -- Replicate Cabal's own logic for parsing file globs.-      files <- concat <$> mapM (match $ localPkgDescr l)-                               (extraSrcFiles $ localPkgDescr l)-      pure-           . filter (\f -> takeExtension f == ".proto")-           . map (makeRelative root)-           . filter (isSubdirectoryOf root)-           $ files--match :: PackageDescription -> FilePath -> IO [FilePath]-#if MIN_VERSION_Cabal(2,4,0)-match desc f = matchDirFileGlob normal (specVersion desc) "." f-#else-match _ f = matchFileGlob f-#endif---- | Augment the given 'UserHooks' to auto-generate Haskell files from the--- .proto files returned by a function @getProtos@.------ Writes the generated files to the autogen directory (@dist\/build\/autogen@--- for Cabal, and @.stack-work\/dist\/...\/build\/autogen@ for stack).------ Throws an exception if the @proto-lens-protoc@ executable is not on the PATH.-generatingSpecificProtos-    :: FilePath -- ^ The root directory under which .proto files can be found.-    -> (LocalBuildInfo -> IO [FilePath])-    -- ^ A function to return a list of .proto files. Takes the Cabal package-    -- description as input. Non-absolute paths are treated as relative to the-    -- provided root directory.-    -> UserHooks -> UserHooks-generatingSpecificProtos root getProtos hooks = hooks-    { buildHook = \p l h f -> generate l >> buildHook hooks p l h f-    , haddockHook = \p l h f -> generate l >> haddockHook hooks p l h f-    , replHook = \p l h f args -> generate l >> replHook hooks p l h f args-#if !MIN_VERSION_Cabal(2,0,0)-    -- Older versions of Cabal don't support the autogen-modules field.-    -- Work around it by manually generating the modules and putting them-    -- in a place where `cabal sdist` will pick them up.-    , sDistHook = \p maybe_l h f -> case maybe_l of-            Nothing -> error "Can't run protoc; run 'cabal configure' first."-            Just l -> do-                        generate l-                        sDistHook hooks (fudgePackageDesc l p) maybe_l h f-#endif-    , postCopy = \a flags pkg lbi -> do-                  let verb = fromFlag $ copyVerbosity flags-                  let destDir = datadir (absoluteInstallDirs pkg lbi-                                             $ fromFlag $ copyDest flags)-                              </> protoLensImportsPrefix-                  getProtos lbi >>= copyProtosToDataDir verb root destDir-                  postCopy hooks a flags pkg lbi-    }-  where-    generate l = getProtos l >>= generateSources root l---- | Generate Haskell source files for the given input .proto files.------ Process all the proto files that are referenced in the exposed-modules--- or other-modules of some "active" component, and write them all to a--- single temporary directory.  (For example, passing --no-enable-tests--- makes all test-suite components inactive.)------ Then, for each active component, copy the corresponding module files--- over to its specific autogen directory (if Cabal-2.*) or to the global--- autogen directory (if Cabal-1.*).  However, don't actually do the copy--- if it's the same as what's already there.  This way, we don't needlessly--- touch the generated .hs files when nothing changes, and thus don't--- needlessly make GHC recompile them (as it considers their modification--- times for that).-generateSources :: FilePath -- ^ The root directory-                -> LocalBuildInfo-                -> [FilePath] -- ^ Proto files relative to the root directory.-                -> IO ()-generateSources root l files = withSystemTempDirectory "protoc-out" $ \tmpDir -> do-    -- Collect import paths from build-depends of this package.-    importDirs <- filterM doesDirectoryExist-                     [ InstalledPackageInfo.dataDir info </> protoLensImportsPrefix-                     | info <- collectDeps l-                     ]-    -- Generate .hs files for all active components into a single temporary-    -- directory.-    let activeModules = collectActiveModules l-    let allModules = Set.fromList . concat . map snd $ activeModules-    let usedInComponent f = ModuleName.fromString (Plugin.moduleNameStr "Proto" f)-                          `Set.member` allModules-    generateProtosWithImports (root : importDirs) tmpDir-                              -- Applying 'root </>' does nothing if the path is already-                              -- absolute.-                              $ map (root </>) $ filter usedInComponent files-    -- Copy each active component's files over to its autogen directory, but-    -- only if they've changed since last time.-    forM_ activeModules $ \(compBI, mods) -> forM_ mods $ \m -> do-          let f = T.unpack (Plugin.outputFilePath $ ModuleName.toFilePath m)-          let sourcePath = tmpDir </> f-          sourceExists <- doesFileExist sourcePath-          when sourceExists $ do-            let dest = autogenComponentModulesDir l compBI </> f-            copyIfDifferent sourcePath dest---- Note: we do a copy rather than a move since a given module may be used in--- more than one component.-copyIfDifferent :: FilePath -> FilePath -> IO ()-copyIfDifferent sourcePath targetPath = do-    targetExists <- doesFileExist targetPath-    identical <- do-        if not targetExists-            then return False-            else do-                -- This could be done in a streaming fashion,-                -- but since the .hs files usually easily fit-                -- into RAM, this is OK.-                sourceContents <- BS.readFile sourcePath-                targetContents <- BS.readFile targetPath-                return (sourceContents == targetContents)-    -- Do the move if necessary.-    when (not identical) $ do-        createDirectoryIfMissing True (takeDirectory targetPath)-        copyFile sourcePath targetPath----- | Copy each .proto file into the installed "data-dir" path,--- so that it can be included by other packages that depend on this one.-copyProtosToDataDir :: Verbosity-                    -> FilePath -- ^ The root for source .proto files in this-                                -- package.-                    -> FilePath -- ^ The final location where .proto files should-                                -- be installed.-                    -> [FilePath] -- ^ .proto files relative to the root-                    -> IO ()-copyProtosToDataDir verb root destDir files = do-    -- Make the build more hermetic by clearing the output-    -- directory.-    exists <- doesDirectoryExist destDir-    when exists $ removeDirectoryRecursive destDir-    forM_ files $ \f -> do-        let srcFile = root </> f-        let destFile = destDir </> f-        createDirectoryIfMissingVerbose verb True-            (takeDirectory destFile)-        installOrdinaryFile verb srcFile destFile---- | Imports are stored as $datadir/proto-lens-imports/**/*.proto.-protoLensImportsPrefix :: FilePath-protoLensImportsPrefix = "proto-lens-imports"--#if !MIN_VERSION_Cabal(2,0,0)--- | Add the autogen directory to the hs-source-dirs of all the targets in the--- .cabal file.  Used to fool 'sdist' by pointing it to the generated source--- files.-fudgePackageDesc :: LocalBuildInfo -> PackageDescription -> PackageDescription-fudgePackageDesc lbi p = p-    { library =-        (\lib -> lib { libBuildInfo = fudgeBuildInfo CLibName $ libBuildInfo lib })-            <$> library p-    , executables =-        (\exe -> exe { buildInfo = fudgeBuildInfo (CExeName $ exeName exe)-                                        $ buildInfo exe })-            <$> executables p-    , testSuites =-        (\test -> test { testBuildInfo = fudgeBuildInfo (CTestName $ testName test)-                                            $ testBuildInfo test })-            <$> testSuites p-    , benchmarks =-        (\bench -> bench { benchmarkBuildInfo =-                              fudgeBuildInfo (CBenchName $ benchmarkName bench)-                                  $ benchmarkBuildInfo bench })-            <$> benchmarks p-    }-  where-    comps = allComponents lbi-    fudgeBuildInfo n bi-        | Just compLBI <- Map.lookup n comps-            = bi { hsSourceDirs = autogenComponentModulesDir lbi compLBI-                                    : hsSourceDirs bi }-        | otherwise = bi -- Could happen if a component isn't active; try-                         -- anyway and see whether Cabal complains later on.-#endif---- | Returns whether the @root@ is a parent folder of @f@.-isSubdirectoryOf :: FilePath -> FilePath -> Bool-isSubdirectoryOf root f-    = isRelative f-      -- Note: `makeRelative root f` returns `f` when f doesn't live under the-      -- root.-      && equalFilePath f (root </> makeRelative root f)---- | Run the proto compiler to generate Haskell files from the given .proto files.------ Writes the generated files to the autogen directory (@dist\/build\/autogen@--- for Cabal, and @.stack-work\/dist\/...\/build\/autogen@ for stack).------ Throws an exception if the @proto-lens-protoc@ executable is not on the PATH.-generateProtos-    :: FilePath -- ^ The root directory under which .proto files can be found.-    -> FilePath -- ^ The output directory for the generated Haskell files.-    -> [FilePath] -- ^ The .proto files to process.-    -> IO ()-generateProtos root = generateProtosWithImports [root]------ | Run the proto compiler to generate Haskell files from the given .proto files.------ Writes the generated files to the autogen directory (@dist\/build\/autogen@--- for Cabal, and @.stack-work\/dist\/...\/build\/autogen@ for stack).------ Throws an exception if the @proto-lens-protoc@ executable is not on the PATH.-generateProtosWithImports-    :: [FilePath] -- ^ Directories under which .proto files and/or files that-                  -- they import can be found.-    -> FilePath -- ^ The output directory for the generated Haskell files.-    -> [FilePath] -- ^ The .proto files to process.-    -> IO ()-generateProtosWithImports _ _ [] = return ()-generateProtosWithImports imports output files = do-    protoLensProtoc-        <- findExecutableOrDie "proto-lens-protoc"-              $ "Please file a bug at "-                  ++ "https://github.com/google/proto-lens/issues ."-    protoc <- findExecutableOrDie "protoc"-                $ "Follow the installation instructions at "-                    ++ "https://google.github.io/proto-lens/installing-protoc.html ."-    createDirectoryIfMissing True output-    callProcess protoc $-        [ "--plugin=protoc-gen-haskell=" ++ protoLensProtoc-        , "--haskell_out=" ++ output-        ]-        ++ ["--proto_path=" ++ p | p <- imports]-        ++ files---- | Search the PATH for an executable, printing an error message if it's not--- found.-findExecutableOrDie :: String -> String -> IO FilePath-findExecutableOrDie name debugMsg = do-    maybePath <- findExecutable name-    case maybePath of-        Just path -> return path-        Nothing -> do-            let sep = "=========="-            hPutStrLn stderr sep-            hPutStrLn stderr $ "Error: couldn't find the executable " ++ show name-                            ++ " in your $PATH."-                            ++ "\n    " ++ debugMsg-            hPutStrLn stderr sep-            error $ "Missing executable " ++ show name---- | Collect all the module names that we need to build.--- For example: only include test-suites if we're building with tests enabled--- (e.g., `stack test` vs `stack build`).-collectActiveModules-    :: LocalBuildInfo -> [(ComponentLocalBuildInfo, [ModuleName])]-collectActiveModules l = map (\(n, c) -> (c, f n)) $ Map.toList $ allComponents l-  where-    p = localPkgDescr l-    f CLibName = maybeToList (library p) >>=-                    \lib -> exposedModules lib-                                ++ otherModules (libBuildInfo lib)-    f (CExeName n) = otherModules . buildInfo $ exes Map.! n-    f (CTestName n) = otherModules . testBuildInfo $ tests Map.! n-    f (CBenchName n) = otherModules . benchmarkBuildInfo $ benchs Map.! n-#if MIN_VERSION_Cabal(2,0,0)-    f _ = []  -- TODO: other lib kinds; for now just suppress the warning-#endif-    exes = Map.fromList [(exeName e, e) | e <- executables p]-    tests = Map.fromList [(testName e, e) | e <- testSuites p]-    benchs = Map.fromList [(benchmarkName e, e) | e <- benchmarks p]------------------------------------------------------------ Compatibility layer between Cabal-1.* and Cabal-2.*---- | List all the packages that this one depends on.-collectDeps :: LocalBuildInfo -> [InstalledPackageInfo.InstalledPackageInfo]-#if MIN_VERSION_Cabal(2,0,0)-collectDeps l = do-    c <- allComponentsInBuildOrder l-    (i,_) <- componentPackageDeps c-    Just p <- [PackageIndex.lookupUnitId (installedPkgs l) i]-    return p-#else-collectDeps l = do-    (_, c ,_) <- componentsConfigs l-    (_, i) <- componentPackageDeps c-    PackageIndex.lookupSourcePackageId (installedPkgs l) i-#endif---- | All the components that will be built by this Cabal command.-allComponents :: LocalBuildInfo -> Map.Map ComponentName ComponentLocalBuildInfo-#if MIN_VERSION_Cabal(2,0,0)-allComponents l = fmap requireOne $ componentNameMap l-  where-    -- TODO: this doesn't support Backpack, which can have more than one-    -- ComponentLocalBuildInfo associated with a name.-    requireOne [x] = x-    requireOne xs = error $ "Data.ProtoLens.Setup.allComponents: expected one "-                          ++ "component per name, got " ++ show xs--#else-allComponents l = Map.fromList [(c, b) | (c, b, _) <- componentsConfigs l]-#endif---- | Get the component-level "autogen" directory where we're putting the--- generated .hs files.  (For Cabal-1.0, use the shared 'BuildPaths.autogenModulesDir'.)-autogenComponentModulesDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath-#if MIN_VERSION_Cabal(2,0,0)-autogenComponentModulesDir = BuildPaths.autogenComponentModulesDir-#else-autogenComponentModulesDir lbi _ = BuildPaths.autogenModulesDir lbi-#endif