hpack 0.21.2 → 0.22.0

raw patch · 26 files changed

+1309/−419 lines, 26 filesdep +http-clientdep +http-client-tlsdep +http-typesdep −HUnitPVP ok

version bump matches the API change (PVP)

Dependencies added: http-client, http-client-tls, http-types

Dependencies removed: HUnit

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• hpack.cabal +29/−9
• src/Hpack.hs +1/−0
• src/Hpack/Config.hs +384/−205
• src/Hpack/Defaults.hs +69/−0
• src/Hpack/GenericsUtil.hs +0/−45
• src/Hpack/Options.hs +2/−1
• src/Hpack/Run.hs +28/−16
• src/Hpack/Syntax.hs +122/−0
• src/Hpack/Syntax/GenericsUtil.hs +45/−0
• src/Hpack/Syntax/Git.hs +28/−0
• src/Hpack/Syntax/UnknownFields.hs +83/−0
• src/Hpack/Syntax/Util.hs +36/−0
• src/Hpack/UnknownFields.hs +0/−92
• src/Hpack/Util.hs +2/−1
• test/EndToEndSpec.hs +139/−8
• test/Helper.hs +9/−0
• test/Hpack/ConfigSpec.hs +32/−8
• test/Hpack/DefaultsSpec.hs +39/−0
• test/Hpack/DependencySpec.hs +2/−9
• test/Hpack/GenericsUtilSpec.hs +0/−24
• test/Hpack/RunSpec.hs +1/−1
• test/Hpack/Syntax/GenericsUtilSpec.hs +24/−0
• test/Hpack/Syntax/GitSpec.hs +57/−0
• test/Hpack/Syntax/UtilSpec.hs +21/−0
• test/Hpack/SyntaxSpec.hs +148/−0

@@ -1,3 +1,11 @@+## next+  - Add support for `defaults`+  - Add `--numeric-version`+  - Add support for `signatures`+  - `extra-doc-files` requires setting `cabal-version` to at least+    1.18; this is now done properly.+  - Accept bool for `condition` (see #230)+ ## Changes in 0.21.2   - Fix a bug in module inference for conditionals (see #236)   - Add support for `extra-doc-files`.

@@ -1,11 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.21.0.+-- This file has been generated from package.yaml by hpack version 0.21.2. -- -- see: https://github.com/sol/hpack ----- hash: 717efcb68d31a77fdd5eec9b427eaba95d5ca99c5d2aedf570e483461daa01ca+-- hash: ed684f1c6e2ea1bdc1674463da6eeef99a1dd9a3fac6bf2ce309d3d675879539  name:           hpack-version:        0.21.2+version:        0.22.0 synopsis:       An alternative format for Haskell packages description:    See README at <https://github.com/sol/hpack#readme> category:       Development@@ -40,6 +40,9 @@     , deepseq     , directory     , filepath+    , http-client+    , http-client-tls+    , http-types     , pretty     , scientific     , text@@ -53,13 +56,17 @@       Hpack.Yaml   other-modules:       Hpack.CabalFile+      Hpack.Defaults       Hpack.Dependency       Hpack.FormattingHints-      Hpack.GenericsUtil       Hpack.Haskell       Hpack.Options       Hpack.Render-      Hpack.UnknownFields+      Hpack.Syntax+      Hpack.Syntax.GenericsUtil+      Hpack.Syntax.Git+      Hpack.Syntax.UnknownFields+      Hpack.Syntax.Util       Hpack.Utf8       Hpack.Util       Paths_hpack@@ -83,6 +90,9 @@     , directory     , filepath     , hpack+    , http-client+    , http-client-tls+    , http-types     , pretty     , scientific     , text@@ -104,7 +114,6 @@   build-depends:       Cabal     , Glob-    , HUnit >=1.6.0.0     , QuickCheck     , aeson >=0.11     , base >=4.8 && <5@@ -116,6 +125,9 @@     , directory     , filepath     , hspec ==2.*+    , http-client+    , http-client-tls+    , http-types     , interpolate     , mockery >=0.3     , pretty@@ -130,27 +142,35 @@       Helper       Hpack.CabalFileSpec       Hpack.ConfigSpec+      Hpack.DefaultsSpec       Hpack.DependencySpec       Hpack.FormattingHintsSpec-      Hpack.GenericsUtilSpec       Hpack.HaskellSpec       Hpack.OptionsSpec       Hpack.RenderSpec       Hpack.RunSpec+      Hpack.Syntax.GenericsUtilSpec+      Hpack.Syntax.GitSpec+      Hpack.Syntax.UtilSpec+      Hpack.SyntaxSpec       Hpack.Utf8Spec       Hpack.UtilSpec       HpackSpec       Hpack       Hpack.CabalFile       Hpack.Config+      Hpack.Defaults       Hpack.Dependency       Hpack.FormattingHints-      Hpack.GenericsUtil       Hpack.Haskell       Hpack.Options       Hpack.Render       Hpack.Run-      Hpack.UnknownFields+      Hpack.Syntax+      Hpack.Syntax.GenericsUtil+      Hpack.Syntax.Git+      Hpack.Syntax.UnknownFields+      Hpack.Syntax.Util       Hpack.Utf8       Hpack.Util       Hpack.Yaml

@@ -50,6 +50,7 @@   args <- getArgs   case parseOptions args of     PrintVersion -> putStrLn (programVersion version)+    PrintNumericVersion -> putStrLn (Version.showVersion version)     Help -> printHelp     Run options -> case options of       Options _verbose _force True dir -> hpackStdOut dir

@@ -1,19 +1,16 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleContexts #-} module Hpack.Config (   packageConfig , readPackageConfig@@ -42,6 +39,7 @@ , pathsModuleFromPackageName , determineModules , BuildType(..)+, Cond(..)  , LibrarySection(..) , fromLibrarySectionInConditional@@ -49,8 +47,8 @@ ) where  import           Control.Applicative+import           Control.Arrow ((>>>)) import           Control.Monad-import           Data.Aeson.Types import           Data.Data import           Data.Bifunctor import           Data.Bifoldable@@ -58,24 +56,28 @@ import           Data.Map.Lazy (Map) import qualified Data.Map.Lazy as Map import qualified Data.HashMap.Lazy as HashMap-import           Data.List (nub, (\\), sortBy)+import           Data.List (nub, (\\), sortBy, intercalate) import           Data.Maybe import           Data.Monoid hiding (Product) import           Data.Ord import           Data.String import           Data.Text (Text) import qualified Data.Text as T-import           GHC.Generics (Generic, Rep) import           System.Directory import           System.FilePath import           Data.Functor.Identity+import           Control.Monad.Trans.Class import           Control.Monad.Trans.Writer+import           Control.Monad.Trans.Except import           Control.Monad.IO.Class -import           Hpack.GenericsUtil-import           Hpack.UnknownFields-import           Hpack.Util-import           Hpack.Yaml+import           Hpack.Syntax.Util+import           Hpack.Syntax.UnknownFields+import           Hpack.Syntax+import           Hpack.Util hiding (expandGlobs)+import qualified Hpack.Util as Util+import           Hpack.Defaults+import qualified Hpack.Yaml as Yaml import           Hpack.Dependency  package :: String -> String -> Package@@ -141,16 +143,6 @@ packageConfig :: FilePath packageConfig = "package.yaml" -#if MIN_VERSION_aeson(1,0,0)-genericParseJSON_ :: forall a d m. (GFromJSON Zero (Rep a), HasTypeName a d m) => Value -> Parser a-#else-genericParseJSON_ :: forall a d m. (GFromJSON (Rep a), HasTypeName a d m) => Value -> Parser a-#endif-genericParseJSON_ = genericParseJSON defaultOptions {fieldLabelModifier = hyphenize name}-  where-    name :: String-    name = typeName (Proxy :: Proxy a)- data CustomSetupSection = CustomSetupSection {   customSetupSectionDependencies :: Maybe Dependencies } deriving (Eq, Show, Generic)@@ -158,37 +150,49 @@ instance HasFieldNames CustomSetupSection  instance FromJSON CustomSetupSection where-  parseJSON = genericParseJSON_+  parseJSON = genericParseJSON  data LibrarySection = LibrarySection {   librarySectionExposed :: Maybe Bool , librarySectionExposedModules :: Maybe (List String) , librarySectionOtherModules :: Maybe (List String) , librarySectionReexportedModules :: Maybe (List String)+, librarySectionSignatures :: Maybe (List String) } deriving (Eq, Show, Generic) -emptyLibrarySection :: LibrarySection-emptyLibrarySection = LibrarySection Nothing Nothing Nothing Nothing+instance Monoid LibrarySection where+  mempty = LibrarySection Nothing Nothing Nothing Nothing Nothing+  mappend a b = LibrarySection {+      librarySectionExposed = librarySectionExposed b <|> librarySectionExposed a+    , librarySectionExposedModules = librarySectionExposedModules a <> librarySectionExposedModules b+    , librarySectionOtherModules = librarySectionOtherModules a <> librarySectionOtherModules b+    , librarySectionReexportedModules = librarySectionReexportedModules a <> librarySectionReexportedModules b+    , librarySectionSignatures = librarySectionSignatures a <> librarySectionSignatures b+    }  instance HasFieldNames LibrarySection  instance FromJSON LibrarySection where-  parseJSON = genericParseJSON_+  parseJSON = genericParseJSON  data ExecutableSection = ExecutableSection {   executableSectionMain :: Maybe FilePath , executableSectionOtherModules :: Maybe (List String) } deriving (Eq, Show, Generic) -emptyExecutableSection :: ExecutableSection-emptyExecutableSection = ExecutableSection Nothing Nothing+instance Monoid ExecutableSection where+  mempty = ExecutableSection Nothing Nothing+  mappend a b = ExecutableSection {+      executableSectionMain = executableSectionMain b <|> executableSectionMain a+    , executableSectionOtherModules = executableSectionOtherModules a <> executableSectionOtherModules b+    }  instance HasFieldNames ExecutableSection  instance FromJSON ExecutableSection where-  parseJSON = genericParseJSON_+  parseJSON = genericParseJSON -data CommonOptions a capture cSources jsSources = CommonOptions {+data CommonOptions capture cSources jsSources a = CommonOptions {   commonOptionsSourceDirs :: Maybe (List FilePath) , commonOptionsDependencies :: Maybe Dependencies , commonOptionsPkgConfigDependencies :: Maybe (List String)@@ -209,16 +213,66 @@ , commonOptionsInstallIncludes :: Maybe (List FilePath) , commonOptionsLdOptions :: Maybe (List LdOption) , commonOptionsBuildable :: Maybe Bool-, commonOptionsWhen :: Maybe (List (ConditionalSection a capture cSources jsSources))+, commonOptionsWhen :: Maybe (List (ConditionalSection capture cSources jsSources a)) , commonOptionsBuildTools :: Maybe Dependencies-} deriving Generic+} deriving (Functor, Generic) -type ParseCommonOptions a = CommonOptions a CaptureUnknownFields ParseCSources ParseJsSources+instance (Monoid cSources, Monoid jsSources) => Monoid (CommonOptions capture cSources jsSources a) where+  mempty = CommonOptions {+    commonOptionsSourceDirs = Nothing+  , commonOptionsDependencies = Nothing+  , commonOptionsPkgConfigDependencies = Nothing+  , commonOptionsDefaultExtensions = Nothing+  , commonOptionsOtherExtensions = Nothing+  , commonOptionsGhcOptions = Nothing+  , commonOptionsGhcProfOptions = Nothing+  , commonOptionsGhcjsOptions = Nothing+  , commonOptionsCppOptions = Nothing+  , commonOptionsCcOptions = Nothing+  , commonOptionsCSources = mempty+  , commonOptionsJsSources = mempty+  , commonOptionsExtraLibDirs = Nothing+  , commonOptionsExtraLibraries = Nothing+  , commonOptionsExtraFrameworksDirs = Nothing+  , commonOptionsFrameworks = Nothing+  , commonOptionsIncludeDirs = Nothing+  , commonOptionsInstallIncludes = Nothing+  , commonOptionsLdOptions = Nothing+  , commonOptionsBuildable = Nothing+  , commonOptionsWhen = Nothing+  , commonOptionsBuildTools = Nothing+  }+  mappend a b = CommonOptions {+    commonOptionsSourceDirs = commonOptionsSourceDirs a <> commonOptionsSourceDirs b+  , commonOptionsDependencies = commonOptionsDependencies b <> commonOptionsDependencies a+  , commonOptionsPkgConfigDependencies = commonOptionsPkgConfigDependencies a <> commonOptionsPkgConfigDependencies b+  , commonOptionsDefaultExtensions = commonOptionsDefaultExtensions a <> commonOptionsDefaultExtensions b+  , commonOptionsOtherExtensions = commonOptionsOtherExtensions a <> commonOptionsOtherExtensions b+  , commonOptionsGhcOptions = commonOptionsGhcOptions a <> commonOptionsGhcOptions b+  , commonOptionsGhcProfOptions = commonOptionsGhcProfOptions a <> commonOptionsGhcProfOptions b+  , commonOptionsGhcjsOptions = commonOptionsGhcjsOptions a <> commonOptionsGhcjsOptions b+  , commonOptionsCppOptions = commonOptionsCppOptions a <> commonOptionsCppOptions b+  , commonOptionsCcOptions = commonOptionsCcOptions a <> commonOptionsCcOptions b+  , commonOptionsCSources = commonOptionsCSources a <> commonOptionsCSources b+  , commonOptionsJsSources = commonOptionsJsSources a <> commonOptionsJsSources b+  , commonOptionsExtraLibDirs = commonOptionsExtraLibDirs a <> commonOptionsExtraLibDirs b+  , commonOptionsExtraLibraries = commonOptionsExtraLibraries a <> commonOptionsExtraLibraries b+  , commonOptionsExtraFrameworksDirs = commonOptionsExtraFrameworksDirs a <> commonOptionsExtraFrameworksDirs b+  , commonOptionsFrameworks = commonOptionsFrameworks a <> commonOptionsFrameworks b+  , commonOptionsIncludeDirs = commonOptionsIncludeDirs a <> commonOptionsIncludeDirs b+  , commonOptionsInstallIncludes = commonOptionsInstallIncludes a <> commonOptionsInstallIncludes b+  , commonOptionsLdOptions = commonOptionsLdOptions a <> commonOptionsLdOptions b+  , commonOptionsBuildable = commonOptionsBuildable b <|> commonOptionsBuildable a+  , commonOptionsWhen = commonOptionsWhen a <> commonOptionsWhen b+  , commonOptionsBuildTools = commonOptionsBuildTools b <> commonOptionsBuildTools a+  } +type ParseCommonOptions = CommonOptions CaptureUnknownFields ParseCSources ParseJsSources+ instance HasFieldNames (ParseCommonOptions a)  instance (FromJSON a, HasFieldNames a) => FromJSON (ParseCommonOptions a) where-  parseJSON = genericParseJSON_+  parseJSON = genericParseJSON  type ParseCSources = Maybe (List FilePath) type ParseJsSources = Maybe (List FilePath)@@ -226,7 +280,7 @@ type CSources = [FilePath] type JsSources = [FilePath] -type WithCommonOptions a capture cSources jsSources = Product (CommonOptions a capture cSources jsSources) a+type WithCommonOptions capture cSources jsSources a = Product (CommonOptions capture cSources jsSources a) a  data Traverse m capture capture_ cSources cSources_ jsSources jsSources_ = Traverse {   traverseCapture :: forall a. capture a -> m (capture_ a)@@ -234,12 +288,24 @@ , traverseJsSources :: jsSources -> m jsSources_ } +defaultTraverse :: Applicative m => Traverse m capture capture cSources cSources jsSources jsSources+defaultTraverse = Traverse {+  traverseCapture = pure+, traverseCSources = pure+, traverseJsSources = pure+}+ type Traversal t = forall m capture capture_ cSources cSources_ jsSources jsSources_. (Monad m, Traversable capture_)   => Traverse m capture capture_ cSources cSources_ jsSources jsSources_   -> t capture cSources jsSources   -> m (t capture_ cSources_ jsSources_) -traverseCommonOptions :: Traversal (CommonOptions a)+type Traversal_ t = forall m capture capture_ cSources cSources_ jsSources jsSources_ a. (Monad m, Traversable capture_)+  => Traverse m capture capture_ cSources cSources_ jsSources jsSources_+  -> t capture cSources jsSources a+  -> m (t capture_ cSources_ jsSources_ a)++traverseCommonOptions :: Traversal_ CommonOptions traverseCommonOptions t@Traverse{..} c@CommonOptions{..} = do   cSources <- traverseCSources commonOptionsCSources   jsSources <- traverseJsSources commonOptionsJsSources@@ -250,23 +316,27 @@     , commonOptionsWhen = xs     } -traverseConditionalSection :: Traversal (ConditionalSection a)+traverseConditionalSection :: Traversal_ ConditionalSection traverseConditionalSection t@Traverse{..} = \ case-  ThenElseConditional c -> ThenElseConditional <$> (traverseCapture c >>= traverse (traverseThenElse t))+  ThenElseConditional c -> ThenElseConditional <$> (traverseCapture c >>= traverse (bitraverse (traverseThenElse t) return))   FlatConditional c -> FlatConditional <$> (traverseCapture c >>= traverse (bitraverse (traverseWithCommonOptions t) return)) -traverseThenElse :: Traversal (ThenElse a)+traverseThenElse :: Traversal_ ThenElse traverseThenElse t@Traverse{..} c@ThenElse{..} = do   then_ <- traverseCapture thenElseThen >>= traverse (traverseWithCommonOptions t)   else_ <- traverseCapture thenElseElse >>= traverse (traverseWithCommonOptions t)   return c{thenElseThen = then_, thenElseElse = else_} -traverseWithCommonOptions :: Traversal (WithCommonOptions a)+traverseWithCommonOptions :: Traversal_ WithCommonOptions traverseWithCommonOptions t = bitraverse (traverseCommonOptions t) return  data Product a b = Product a b-  deriving (Eq, Show)+  deriving (Eq, Show, Functor, Foldable, Traversable) +instance (Monoid a, Monoid b) => Monoid (Product a b) where+  mempty = Product mempty mempty+  Product a1 b1 `mappend` Product a2 b2 = Product (a1 <> a2) (b1 <> b2)+ instance Bifunctor Product where   bimap fa fb (Product a b) = Product (fa a) (fb b) @@ -287,12 +357,17 @@        ignoreUnderscoredUnknownFields (Proxy :: Proxy a)     || ignoreUnderscoredUnknownFields (Proxy :: Proxy b) -data ConditionalSection a capture cSources jsSources =-    ThenElseConditional (capture (ThenElse a capture cSources jsSources))-  | FlatConditional (capture (Product (WithCommonOptions a capture cSources jsSources) Condition))+data ConditionalSection capture cSources jsSources a =+    ThenElseConditional (capture (Product (ThenElse capture cSources jsSources a) Condition))+  | FlatConditional (capture (Product (WithCommonOptions capture cSources jsSources a) Condition)) -type ParseConditionalSection a = ConditionalSection a CaptureUnknownFields ParseCSources ParseJsSources+instance Functor capture => Functor (ConditionalSection capture cSources jsSources) where+  fmap f = \ case+    ThenElseConditional c -> ThenElseConditional (first (fmap f) <$> c)+    FlatConditional c -> FlatConditional (first (bimap (fmap f) f) <$> c) +type ParseConditionalSection = ConditionalSection CaptureUnknownFields ParseCSources ParseJsSources+ instance (FromJSON a, HasFieldNames a) => FromJSON (ParseConditionalSection a) where   parseJSON v     | hasKey "then" v || hasKey "else" v = ThenElseConditional <$> parseJSON v@@ -303,30 +378,48 @@ hasKey _ _ = False  newtype Condition = Condition {-  conditionCondition :: String+  _conditionCondition :: Cond } deriving (Eq, Show, Generic)  instance FromJSON Condition where-  parseJSON = genericParseJSON_+  parseJSON = genericParseJSON  instance HasFieldNames Condition -data ThenElse a capture cSources jsSources = ThenElse {-  _thenElseCondition :: String-, thenElseThen :: capture (WithCommonOptions a capture cSources jsSources)-, thenElseElse :: capture (WithCommonOptions a capture cSources jsSources)+newtype Cond = Cond String+  deriving (Eq, Show)++instance FromJSON Cond where+  parseJSON v = case v of+    String _ -> Cond <$> parseJSON v+    Bool True -> return (Cond "true")+    Bool False -> return (Cond "false")+    _ -> typeMismatch "Boolean or String" v++data ThenElse capture cSources jsSources a = ThenElse {+  thenElseThen :: capture (WithCommonOptions capture cSources jsSources a)+, thenElseElse :: capture (WithCommonOptions capture cSources jsSources a) } deriving Generic -type ParseThenElse a = ThenElse a CaptureUnknownFields ParseCSources ParseJsSources+instance Functor capture => Functor (ThenElse capture cSources jsSources) where+  fmap f c@ThenElse{..} = c{thenElseThen = map_ thenElseThen, thenElseElse = map_ thenElseElse}+    where+      map_ = fmap (bimap (fmap f) f) +type ParseThenElse = ThenElse CaptureUnknownFields ParseCSources ParseJsSources+ instance HasFieldNames (ParseThenElse a)  instance (FromJSON a, HasFieldNames a) => FromJSON (ParseThenElse a) where-  parseJSON = genericParseJSON_+  parseJSON = genericParseJSON  data Empty = Empty   deriving (Eq, Show) +instance Monoid Empty where+  mempty = Empty+  mappend Empty Empty = Empty+ instance FromJSON Empty where   parseJSON _ = return Empty @@ -349,9 +442,21 @@     "Custom"    -> return Custom     _           -> fail "build-type must be one of: Simple, Configure, Make, Custom" -type SectionConfig a capture cSources jsSources = capture (WithCommonOptions a capture cSources jsSources)+type SectionConfigWithDefaluts capture cSources jsSources a = capture (Product (DefaultsConfig capture) (WithCommonOptions capture cSources jsSources a)) -data PackageConfig capture cSources jsSources = PackageConfig {+type PackageConfigWithDefaults capture cSources jsSources = PackageConfig_+  (SectionConfigWithDefaluts capture cSources jsSources LibrarySection)+  (SectionConfigWithDefaluts capture cSources jsSources ExecutableSection)+  capture cSources jsSources++type SectionConfig capture cSources jsSources a = capture (WithCommonOptions capture cSources jsSources a)++type PackageConfig capture cSources jsSources = PackageConfig_+  (SectionConfig capture cSources jsSources LibrarySection)+  (SectionConfig capture cSources jsSources ExecutableSection)+  capture cSources jsSources++data PackageConfig_ library executable capture cSources jsSources = PackageConfig {   packageConfigName :: Maybe String , packageConfigVersion :: Maybe String , packageConfigSynopsis :: Maybe String@@ -374,14 +479,23 @@ , packageConfigGithub :: Maybe Text , packageConfigGit :: Maybe String , packageConfigCustomSetup :: Maybe (capture CustomSetupSection)-, packageConfigLibrary :: Maybe (SectionConfig LibrarySection capture cSources jsSources)-, packageConfigInternalLibraries :: Maybe (Map String (SectionConfig LibrarySection capture cSources jsSources))-, packageConfigExecutable :: Maybe (SectionConfig ExecutableSection capture cSources jsSources)-, packageConfigExecutables :: Maybe (Map String (SectionConfig ExecutableSection capture cSources jsSources))-, packageConfigTests :: Maybe (Map String (SectionConfig ExecutableSection capture cSources jsSources))-, packageConfigBenchmarks :: Maybe (Map String (SectionConfig ExecutableSection capture cSources jsSources))+, packageConfigLibrary :: Maybe library+, packageConfigInternalLibraries :: Maybe (Map String library)+, packageConfigExecutable :: Maybe executable+, packageConfigExecutables :: Maybe (Map String executable)+, packageConfigTests :: Maybe (Map String executable)+, packageConfigBenchmarks :: Maybe (Map String executable) } deriving Generic +data DefaultsConfig capture = DefaultsConfig {+  defaultsConfigDefaults :: Maybe (List (capture Defaults))+} deriving Generic++instance HasFieldNames (DefaultsConfig a)++instance FromJSON (DefaultsConfig CaptureUnknownFields) where+  parseJSON = genericParseJSON+ traversePackageConfig :: Traversal PackageConfig traversePackageConfig t@Traverse{..} p@PackageConfig{..} = do   flags <- traverse (traverse traverseCapture) packageConfigFlags@@ -405,16 +519,20 @@   where     traverseNamedConfigs = traverse . traverse . traverseSectionConfig -traverseSectionConfig :: Traversal (SectionConfig p)+traverseSectionConfig :: Traversal_ SectionConfig traverseSectionConfig t = traverseCapture t >=> traverse (traverseWithCommonOptions t) -type ParsePackageConfig = PackageConfig CaptureUnknownFields ParseCSources ParseJsSources+traverseSectionConfigWithDefaluts :: Traversal_ SectionConfigWithDefaluts+traverseSectionConfigWithDefaluts t =+  traverseCapture t >=> traverse (bitraverse (traverseDefaultsConfig t) (traverseWithCommonOptions t)) +type ParsePackageConfig = PackageConfigWithDefaults CaptureUnknownFields ParseCSources ParseJsSources+ instance HasFieldNames ParsePackageConfig where   ignoreUnderscoredUnknownFields _ = True  instance FromJSON ParsePackageConfig where-  parseJSON value = handleNullValues <$> genericParseJSON_ value+  parseJSON value = handleNullValues <$> genericParseJSON value     where       handleNullValues :: ParsePackageConfig -> ParsePackageConfig       handleNullValues =@@ -433,15 +551,18 @@   where     p = parseJSON >=> (.: fromString name) -readPackageConfig :: FilePath -> IO (Either String ([String], Package))-readPackageConfig file = do-  r <- decodeYaml file-  case r of-    Left err -> return (Left err)-    Right config -> do-      dir <- takeDirectory <$> canonicalizePath file-      Right <$> toPackage dir config+type Warnings m = WriterT [String] m+type Errors = ExceptT String +decodeYaml :: FromJSON a => FilePath -> Warnings (Errors IO) a+decodeYaml = lift . ExceptT . Yaml.decodeYaml++readPackageConfig :: FilePath -> FilePath -> IO (Either String (Package, [String]))+readPackageConfig userDataDir file = runExceptT $ runWriterT $ do+  config <- decodeYaml file+  dir <- liftIO $ takeDirectory <$> canonicalizePath file+  toPackage userDataDir dir config+ data Package = Package {   packageName :: String , packageVersion :: String@@ -480,6 +601,7 @@ , libraryExposedModules :: [String] , libraryOtherModules :: [String] , libraryReexportedModules :: [String]+, librarySignatures :: [String] } deriving (Eq, Show)  data Executable = Executable {@@ -528,7 +650,7 @@ instance HasFieldNames FlagSection  instance FromJSON FlagSection where-  parseJSON = genericParseJSON_+  parseJSON = genericParseJSON  data Flag = Flag {   flagName :: String@@ -546,46 +668,123 @@ } deriving (Eq, Show)  type Config capture cSources jsSources =-  Product (CommonOptions Empty capture cSources jsSources) (PackageConfig capture cSources jsSources)+  Product (CommonOptions capture cSources jsSources Empty) (PackageConfig capture cSources jsSources)  traverseConfig :: Traversal Config traverseConfig t = bitraverse (traverseCommonOptions t) (traversePackageConfig t) -type ParseConfig = CaptureUnknownFields (Config CaptureUnknownFields ParseCSources ParseJsSources)+type ConfigWithDefaults capture = Product+  (CommonOptionsWithDefaults capture Empty)+  (PackageConfigWithDefaults capture ParseCSources ParseJsSources) -toPackage :: FilePath -> ParseConfig -> IO ([String], Package)-toPackage dir = runWriterT . (extractUnknownFieldWarnings >=> expandForeignSources dir) >=> toPackage_ dir+type CommonOptionsWithDefaults capture a = Product+  (DefaultsConfig capture)+  (CommonOptions capture ParseCSources ParseJsSources a) -toPackage_ :: FilePath -> (Config Identity CSources JsSources, [String]) -> IO ([String], Package)-toPackage_ dir (Product (toSection . (`Product` Empty) -> globalOptions) PackageConfig{..}, packageWarnings) = do-  mLibrary <- mapM (toLibrary dir packageName_ globalOptions) mLibrarySection+type WithCommonOptionsWithDefaults capture a = Product+  (DefaultsConfig capture)+  (WithCommonOptions capture ParseCSources ParseJsSources a) -  let-    executableSections :: Map String (Section ExecutableSection)-    (executableWarning, executableSections) = (warning, sections)-      where-        sections :: Map String (Section ExecutableSection)-        sections = case mExecutable of-          Just executable -> Map.fromList [(packageName_, executable)]-          Nothing -> executables+type ParseConfig = CaptureUnknownFields (ConfigWithDefaults CaptureUnknownFields) -        warning = case mExecutable of-          Just _ | not (null executables) -> ["Ignoring field \"executables\" in favor of \"executable\""]-          _ -> []+toPackage :: FilePath -> FilePath -> ParseConfig -> Warnings (Errors IO) Package+toPackage userDataDir dir =+      warnUnknownFieldsInConfig+  >=> expandDefaultsInConfig userDataDir+  >=> traverseConfig (expandForeignSources dir)+  >=> toPackage_ dir -        executables = toSections packageConfigExecutables+expandDefaultsInConfig+  :: FilePath+  -> ConfigWithDefaults Identity+  -> Warnings (Errors IO) (Config Identity ParseCSources ParseJsSources)+expandDefaultsInConfig userDataDir = bitraverse (expandGlobalDefaults userDataDir) (expandSectionDefaults userDataDir) -        mExecutable :: Maybe (Section ExecutableSection)-        mExecutable = toSectionI <$> packageConfigExecutable+expandGlobalDefaults+  :: FilePath+  -> CommonOptionsWithDefaults Identity Empty+  -> Warnings (Errors IO) (CommonOptions Identity ParseCSources ParseJsSources Empty)+expandGlobalDefaults userDataDir = do+  fmap (`Product` Empty) >>> expandDefaults userDataDir >=> \ (Product c Empty) -> return c -  internalLibraries <- toInternalLibraries dir packageName_ globalOptions internalLibrariesSections-  executables <- toExecutables dir packageName_ globalOptions executableSections-  tests <- toExecutables dir packageName_ globalOptions testSections-  benchmarks <- toExecutables dir packageName_ globalOptions benchmarkSections+expandSectionDefaults+  :: FilePath+  -> PackageConfigWithDefaults Identity ParseCSources ParseJsSources+  -> Warnings (Errors IO) (PackageConfig Identity ParseCSources ParseJsSources)+expandSectionDefaults userDataDir p@PackageConfig{..} = do+  library <- traverse (traverse (expandDefaults userDataDir)) packageConfigLibrary+  internalLibraries <- traverse (traverse (traverse (expandDefaults userDataDir))) packageConfigInternalLibraries+  executable <- traverse (traverse (expandDefaults userDataDir)) packageConfigExecutable+  executables <- traverse (traverse (traverse (expandDefaults userDataDir))) packageConfigExecutables+  tests <- traverse (traverse (traverse (expandDefaults userDataDir))) packageConfigTests+  benchmarks <- traverse (traverse (traverse (expandDefaults userDataDir))) packageConfigBenchmarks+  return p{+      packageConfigLibrary = library+    , packageConfigInternalLibraries = internalLibraries+    , packageConfigExecutable = executable+    , packageConfigExecutables = executables+    , packageConfigTests = tests+    , packageConfigBenchmarks = benchmarks+    } -  licenseFileExists <- doesFileExist (dir </> "LICENSE")+expandDefaults+  :: (HasFieldNames a, FromJSON a, Monoid a)+  => FilePath+  -> WithCommonOptionsWithDefaults Identity a+  -> Warnings (Errors IO) (WithCommonOptions Identity ParseCSources ParseJsSources a)+expandDefaults userDataDir = expand []+  where+    expand :: (HasFieldNames a, FromJSON a, Monoid a) =>+         [FilePath]+      -> WithCommonOptionsWithDefaults Identity a+      -> Warnings (Errors IO) (WithCommonOptions Identity ParseCSources ParseJsSources a)+    expand seen (Product DefaultsConfig{..} c) = do+      d <- mconcat <$> mapM (get seen . runIdentity) (fromMaybeList defaultsConfigDefaults)+      return (d <> c) -  missingSourceDirs <- nub . sort <$> filterM (fmap not <$> doesDirectoryExist . (dir </>)) (+    get :: (HasFieldNames a, FromJSON a, Monoid a) =>+         [FilePath]+      -> Defaults+      -> Warnings (Errors IO) (WithCommonOptions Identity ParseCSources ParseJsSources a)+    get seen defaults = do+      file <- lift $ ExceptT (ensure userDataDir defaults)+      seen_ <- lift (checkCycle seen file)+      decodeYaml file >>= warnUnknownFieldsInDefaults file >>= expand seen_++    checkCycle :: [FilePath] -> FilePath -> Errors IO [FilePath]+    checkCycle seen file = do+      canonic <- liftIO $ canonicalizePath file+      let seen_ = canonic : seen+      when (canonic `elem` seen) $ do+        throwE ("cycle in defaults (" ++ intercalate " -> " (reverse seen_) ++ ")")+      return seen_++toExecutableMap :: Monad m => String -> Maybe (Map String a) -> Maybe a -> Warnings m (Maybe (Map String a))+toExecutableMap name executables mExecutable = do+  case mExecutable of+    Just executable -> do+      when (isJust executables) $ do+        tell ["Ignoring field \"executables\" in favor of \"executable\""]+      return $ Just (Map.fromList [(name, executable)])+    Nothing -> return executables++type GlobalOptions = CommonOptions Identity CSources JsSources Empty++toPackage_ :: MonadIO m => FilePath -> Product GlobalOptions (PackageConfig Identity CSources JsSources) -> Warnings m Package+toPackage_ dir (Product globalOptions PackageConfig{..}) = do+  mLibrary <- liftIO $ traverse (toLibrary dir packageName_ globalOptions) packageConfigLibrary++  internalLibraries <- liftIO $ toInternalLibraries dir packageName_ globalOptions packageConfigInternalLibraries++  executables <- toExecutableMap packageName_ packageConfigExecutables packageConfigExecutable+    >>= liftIO . toExecutables dir packageName_ globalOptions++  tests <- liftIO $ toExecutables dir packageName_ globalOptions packageConfigTests+  benchmarks <- liftIO $ toExecutables dir packageName_ globalOptions packageConfigBenchmarks++  licenseFileExists <- liftIO $ doesFileExist (dir </> "LICENSE")++  missingSourceDirs <- liftIO $ nub . sort <$> filterM (fmap not <$> doesDirectoryExist . (dir </>)) (        maybe [] sectionSourceDirs mLibrary     ++ concatMap sectionSourceDirs internalLibraries     ++ concatMap sectionSourceDirs executables@@ -593,14 +792,9 @@     ++ concatMap sectionSourceDirs benchmarks     ) -  (extraSourceFilesWarnings, extraSourceFiles) <--    expandGlobs "extra-source-files" dir (fromMaybeList packageConfigExtraSourceFiles)--  (extraDocFilesWarnings, extraDocFiles) <--    expandGlobs "extra-doc-files" dir (fromMaybeList packageConfigExtraDocFiles)--  (dataFilesWarnings, dataFiles) <--    expandGlobs "data-files" dir (fromMaybeList packageConfigDataFiles)+  extraSourceFiles <- expandGlobs "extra-source-files" dir (fromMaybeList packageConfigExtraSourceFiles)+  extraDocFiles <- expandGlobs "extra-doc-files" dir (fromMaybeList packageConfigExtraDocFiles)+  dataFiles <- expandGlobs "data-files" dir (fromMaybeList packageConfigDataFiles)    let defaultBuildType :: BuildType       defaultBuildType = maybe Simple (const Custom) mCustomSetup@@ -639,16 +833,9 @@       , packageBenchmarks = benchmarks       } -      warnings =-           packageWarnings-        ++ nameWarnings-        ++ formatMissingSourceDirs missingSourceDirs-        ++ executableWarning-        ++ extraSourceFilesWarnings-        ++ extraDocFilesWarnings-        ++ dataFilesWarnings--  return (warnings, pkg)+  tell nameWarnings+  tell (formatMissingSourceDirs missingSourceDirs)+  return pkg   where     nameWarnings :: [String]     packageName_ :: String@@ -660,21 +847,6 @@     mCustomSetup :: Maybe CustomSetup     mCustomSetup = toCustomSetup . runIdentity <$> packageConfigCustomSetup -    mLibrarySection :: Maybe (Section LibrarySection)-    mLibrarySection = toSectionI <$> packageConfigLibrary--    toSections :: Maybe (Map String (Identity (WithCommonOptions a Identity CSources JsSources))) -> Map String (Section a)-    toSections = fmap toSectionI . fromMaybe mempty--    internalLibrariesSections :: Map String (Section LibrarySection)-    internalLibrariesSections = toSections packageConfigInternalLibraries--    testSections :: Map String (Section ExecutableSection)-    testSections = toSections packageConfigTests--    benchmarkSections :: Map String (Section ExecutableSection)-    benchmarkSections = toSections packageConfigBenchmarks-     flags = map (toFlag . fmap runIdentity) $ toList packageConfigFlags      toList :: Maybe (Map String a) -> [(String, a)]@@ -710,23 +882,47 @@       where         fromGithub = (++ "/issues") . sourceRepositoryUrl <$> github -type Warnings m = WriterT [String] m+sequenceUnknownFields :: Applicative capture => Traverse capture capture Identity cSources cSources jsSources jsSources+sequenceUnknownFields = defaultTraverse{traverseCapture = fmap Identity} -extractUnknownFieldWarnings :: forall m. Monad m => ParseConfig -> Warnings m (Config Identity ParseCSources ParseJsSources)-extractUnknownFieldWarnings = warnGlobal >=> bitraverse return warnSections+warnUnknownFieldsInDefaults+  :: Monad m+  => String+  -> CaptureUnknownFields (WithCommonOptionsWithDefaults CaptureUnknownFields a)+  -> Warnings m (WithCommonOptionsWithDefaults Identity a)+warnUnknownFieldsInDefaults name =+  (warnUnknownFields In name . (>>= bitraverse sequenceDefaults (traverseWithCommonOptions sequenceUnknownFields)))++traverseDefaultsConfig+  :: Applicative m+  => Traverse m capture capture_ cSources cSources_ jsSources jsSources_+  -> DefaultsConfig capture -> m (DefaultsConfig capture_)+traverseDefaultsConfig Traverse{..} (DefaultsConfig defaults) = do+  DefaultsConfig <$> traverse (traverse $ traverseCapture) defaults++sequenceDefaults :: Applicative capture => DefaultsConfig capture -> capture (DefaultsConfig Identity)+sequenceDefaults = traverseDefaultsConfig sequenceUnknownFields++warnUnknownFieldsInConfig :: forall m. Monad m => ParseConfig -> Warnings m (ConfigWithDefaults Identity)+warnUnknownFieldsInConfig =+      warnGlobal+  >=> bitraverse (bitraverse warnDefaults return) return+  >=> traverse warnSections   where-    t :: Monad capture => Traverse capture capture Identity cSources cSources jsSources jsSources-    t = Traverse (fmap Identity) return return+    t = sequenceUnknownFields -    warnGlobal c = warnUnknownFields In "package description" (c >>= bitraverse (traverseCommonOptions t) return)+    warnGlobal c = warnUnknownFields In "package description" (c >>= bitraverse (traverse (traverseCommonOptions t)) return) -    warnSections :: ParsePackageConfig -> Warnings m (PackageConfig Identity ParseCSources ParseJsSources)+    warnDefaults :: DefaultsConfig CaptureUnknownFields -> Warnings m (DefaultsConfig Identity)+    warnDefaults = warnUnknownFields In "defaults section" . sequenceDefaults++    warnSections :: ParsePackageConfig -> Warnings m (PackageConfigWithDefaults Identity ParseCSources ParseJsSources)     warnSections p@PackageConfig{..} = do       flags <- traverse (warnNamed For "flag" . fmap (traverseCapture t)) packageConfigFlags       customSetup <- warnUnknownFields In "custom-setup section" (traverse (traverseCapture t) packageConfigCustomSetup)-      library <- warnUnknownFields In "library section" (traverse (traverseSectionConfig t) packageConfigLibrary)+      library <- warnUnknownFields In "library section" (traverse (traverseSectionConfigWithDefaluts t) packageConfigLibrary)       internalLibraries <- warnNamedSection "internal-libraries" packageConfigInternalLibraries-      executable <- warnUnknownFields In "executable section" (traverse (traverseSectionConfig t) packageConfigExecutable)+      executable <- warnUnknownFields In "executable section" (traverse (traverseSectionConfigWithDefaluts t) packageConfigExecutable)       executables <- warnNamedSection "executable" packageConfigExecutables       tests <- warnNamedSection "test" packageConfigTests       benchmarks <- warnNamedSection "benchmark" packageConfigBenchmarks@@ -743,35 +939,36 @@      warnNamedSection       :: String-      -> Maybe (Map String (SectionConfig a CaptureUnknownFields cSources jsSources))-      -> Warnings m (Maybe (Map String (SectionConfig a Identity cSources jsSources)))-    warnNamedSection sectionType = traverse (warnNamed In (sectionType ++ " section") . fmap (traverseSectionConfig t))+      -> Maybe (Map String (SectionConfigWithDefaluts CaptureUnknownFields cSources jsSources a))+      -> Warnings m (Maybe (Map String (SectionConfigWithDefaluts Identity cSources jsSources a)))+    warnNamedSection sectionType = traverse (warnNamed In (sectionType ++ " section") . fmap (traverseSectionConfigWithDefaluts t))      warnNamed :: Preposition -> String -> Map String (CaptureUnknownFields a) -> Warnings m (Map String a)     warnNamed preposition sect = fmap Map.fromList . mapM f . Map.toList       where         f (name, fields) = (,) name <$> (warnUnknownFields preposition (sect ++ " " ++ show name) fields) -    warnUnknownFields :: Preposition -> String -> CaptureUnknownFields a -> Warnings m a-    warnUnknownFields preposition name = fmap snd . bitraverse tell return . formatUnknownFields preposition name+warnUnknownFields :: forall m a. Monad m => Preposition -> String -> CaptureUnknownFields a -> Warnings m a+warnUnknownFields preposition name = fmap snd . bitraverse tell return . formatUnknownFields preposition name  expandForeignSources-  :: FilePath-  -> Config Identity ParseCSources ParseJsSources-  -> Warnings IO (Config Identity CSources JsSources)-expandForeignSources dir = traverseConfig t+  :: MonadIO m+  => FilePath+  -> Traverse (Warnings m) capture capture ParseCSources CSources ParseJsSources JsSources+expandForeignSources dir = defaultTraverse {+    traverseCSources = expand "c-sources"+  , traverseJsSources = expand "js-sources"+  }   where-    t = Traverse {-      traverseCapture = return-    , traverseCSources = expand "c-sources"-    , traverseJsSources = expand "js-sources"-    }-     expand fieldName xs = do-      (warnings, files) <- liftIO $ expandGlobs fieldName dir (fromMaybeList xs)-      tell warnings-      return files+      expandGlobs fieldName dir (fromMaybeList xs) +expandGlobs :: MonadIO m => String -> FilePath -> [String] -> Warnings m [FilePath]+expandGlobs name dir patterns = do+  (warnings, files) <- liftIO $ Util.expandGlobs name dir patterns+  tell warnings+  return files+ toCustomSetup :: CustomSetupSection -> CustomSetup toCustomSetup CustomSetupSection{..} = CustomSetup   { customSetupDependencies = fromMaybe mempty customSetupSectionDependencies }@@ -819,20 +1016,21 @@         r = fromConfig pathsModule inferableModules conf       return (outerModules ++ getInferredModules r, r) -toLibrary :: FilePath -> String -> Section global -> Section LibrarySection -> IO (Section Library)+toLibrary :: FilePath -> String -> GlobalOptions -> SectionConfig Identity CSources JsSources LibrarySection -> IO (Section Library) toLibrary dir name globalOptions =     inferModules dir name getMentionedLibraryModules getLibraryModules fromLibrarySectionTopLevel fromLibrarySectionInConditional-  . mergeSections emptyLibrarySection globalOptions+  . toSectionI (mempty <$ globalOptions)   where     getLibraryModules :: Library -> [String]     getLibraryModules Library{..} = libraryExposedModules ++ libraryOtherModules      fromLibrarySectionTopLevel pathsModule inferableModules LibrarySection{..} =-      Library librarySectionExposed exposedModules otherModules reexportedModules+      Library librarySectionExposed exposedModules otherModules reexportedModules signatures       where         (exposedModules, otherModules) =           determineModules pathsModule inferableModules librarySectionExposedModules librarySectionOtherModules         reexportedModules = fromMaybeList librarySectionReexportedModules+        signatures = fromMaybeList librarySectionSignatures  determineModules :: [String] -> [String] -> Maybe (List String) -> Maybe (List String) -> ([String], [String]) determineModules pathsModule inferableModules mExposedModules mOtherModules = case (mExposedModules, mOtherModules) of@@ -843,7 +1041,7 @@       otherModules   = maybe ((inferableModules ++ pathsModule) \\ exposedModules) fromList mOtherModules  fromLibrarySectionInConditional :: [String] -> LibrarySection -> Library-fromLibrarySectionInConditional inferableModules lib@(LibrarySection _ exposedModules otherModules _) = do+fromLibrarySectionInConditional inferableModules lib@(LibrarySection _ exposedModules otherModules _ _) = do   case (exposedModules, otherModules) of     (Nothing, Nothing) -> (fromLibrarySectionPlain lib) {libraryOtherModules = inferableModules}     _ -> fromLibrarySectionPlain lib@@ -854,23 +1052,24 @@   , libraryExposedModules = fromMaybeList librarySectionExposedModules   , libraryOtherModules = fromMaybeList librarySectionOtherModules   , libraryReexportedModules = fromMaybeList librarySectionReexportedModules+  , librarySignatures = fromMaybeList librarySectionSignatures   } -toInternalLibraries :: FilePath -> String -> Section global -> Map String (Section LibrarySection) -> IO (Map String (Section Library))-toInternalLibraries dir packageName_ globalOptions = traverse (toLibrary dir packageName_ globalOptions)+toInternalLibraries :: FilePath -> String -> GlobalOptions -> Maybe (Map String (SectionConfig Identity CSources JsSources LibrarySection)) -> IO (Map String (Section Library))+toInternalLibraries dir packageName_ globalOptions = traverse (toLibrary dir packageName_ globalOptions) . fromMaybe mempty -toExecutables :: FilePath -> String -> Section global -> Map String (Section ExecutableSection) -> IO (Map String (Section Executable))-toExecutables dir packageName_ globalOptions = traverse (toExecutable dir packageName_ globalOptions)+toExecutables :: FilePath -> String -> GlobalOptions -> Maybe (Map String (SectionConfig Identity CSources JsSources ExecutableSection)) -> IO (Map String (Section Executable))+toExecutables dir packageName_ globalOptions = traverse (toExecutable dir packageName_ globalOptions) . fromMaybe mempty  getMentionedExecutableModules :: ExecutableSection -> [String] getMentionedExecutableModules ExecutableSection{..} =   fromMaybeList executableSectionOtherModules ++ maybe [] return (executableSectionMain >>= toModule . splitDirectories) -toExecutable :: FilePath -> String -> Section global -> Section ExecutableSection -> IO (Section Executable)+toExecutable :: FilePath -> String -> GlobalOptions -> SectionConfig Identity CSources JsSources ExecutableSection -> IO (Section Executable) toExecutable dir packageName_ globalOptions =     inferModules dir packageName_ getMentionedExecutableModules executableOtherModules fromExecutableSection (fromExecutableSection [])   . expandMain-  . mergeSections emptyExecutableSection globalOptions+  . toSectionI (mempty <$ globalOptions)   where     fromExecutableSection :: [String] -> [String] -> ExecutableSection -> Executable     fromExecutableSection pathsModule inferableModules ExecutableSection{..} =@@ -897,39 +1096,14 @@       , sectionConditionals = map (fmap flatten) sectionConditionals       } -mergeSections :: a -> Section global -> Section a -> Section a-mergeSections a globalOptions options-  = Section {-    sectionData = sectionData options-  , sectionSourceDirs = sectionSourceDirs globalOptions ++ sectionSourceDirs options-  , sectionDefaultExtensions = sectionDefaultExtensions globalOptions ++ sectionDefaultExtensions options-  , sectionOtherExtensions = sectionOtherExtensions globalOptions ++ sectionOtherExtensions options-  , sectionGhcOptions = sectionGhcOptions globalOptions ++ sectionGhcOptions options-  , sectionGhcProfOptions = sectionGhcProfOptions globalOptions ++ sectionGhcProfOptions options-  , sectionGhcjsOptions = sectionGhcjsOptions globalOptions ++ sectionGhcjsOptions options-  , sectionCppOptions = sectionCppOptions globalOptions ++ sectionCppOptions options-  , sectionCcOptions = sectionCcOptions globalOptions ++ sectionCcOptions options-  , sectionCSources = sectionCSources globalOptions ++ sectionCSources options-  , sectionJsSources = sectionJsSources globalOptions ++ sectionJsSources options-  , sectionExtraLibDirs = sectionExtraLibDirs globalOptions ++ sectionExtraLibDirs options-  , sectionExtraLibraries = sectionExtraLibraries globalOptions ++ sectionExtraLibraries options-  , sectionExtraFrameworksDirs = sectionExtraFrameworksDirs globalOptions ++ sectionExtraFrameworksDirs options-  , sectionFrameworks = sectionFrameworks globalOptions ++ sectionFrameworks options-  , sectionIncludeDirs = sectionIncludeDirs globalOptions ++ sectionIncludeDirs options-  , sectionInstallIncludes = sectionInstallIncludes globalOptions ++ sectionInstallIncludes options-  , sectionLdOptions = sectionLdOptions globalOptions ++ sectionLdOptions options-  , sectionBuildable = sectionBuildable options <|> sectionBuildable globalOptions-  , sectionDependencies = sectionDependencies options <> sectionDependencies globalOptions-  , sectionPkgConfigDependencies = sectionPkgConfigDependencies globalOptions ++ sectionPkgConfigDependencies options-  , sectionConditionals = map (fmap (a <$)) (sectionConditionals globalOptions) ++ sectionConditionals options-  , sectionBuildTools = sectionBuildTools options <> sectionBuildTools globalOptions-  }+toSectionI :: CommonOptions Identity CSources JsSources a -> Identity (WithCommonOptions Identity CSources JsSources a) -> Section a+toSectionI globalOptions = toSection globalOptions . runIdentity -toSectionI :: Identity (WithCommonOptions a Identity CSources JsSources) -> Section a-toSectionI = toSection . runIdentity+toSection :: CommonOptions Identity CSources JsSources a -> WithCommonOptions Identity CSources JsSources a -> Section a+toSection globalOptions (Product options a) = toSection_ (Product (globalOptions <> options) a) -toSection :: WithCommonOptions a Identity CSources JsSources -> Section a-toSection (Product CommonOptions{..} a) = Section {+toSection_ :: WithCommonOptions Identity CSources JsSources a -> Section a+toSection_ (Product CommonOptions{..} a) = Section {         sectionData = a       , sectionSourceDirs = fromMaybeList commonOptionsSourceDirs       , sectionDefaultExtensions = fromMaybeList commonOptionsDefaultExtensions@@ -955,12 +1129,17 @@       , sectionBuildTools = fromMaybe mempty commonOptionsBuildTools       }   where+    toSectionI_ :: Identity (WithCommonOptions Identity CSources JsSources a) -> Section a+    toSectionI_ = toSection_ . runIdentity+     conditionals = map toConditional (fromMaybeList commonOptionsWhen) -    toConditional :: ConditionalSection a Identity CSources JsSources -> Conditional (Section a)+    toConditional :: ConditionalSection Identity CSources JsSources a -> Conditional (Section a)     toConditional x = case x of-      FlatConditional (Identity (Product sect c)) -> Conditional (conditionCondition c) (toSection sect) Nothing-      ThenElseConditional (Identity (ThenElse condition then_ else_)) -> Conditional condition (toSectionI then_) (Just $ toSectionI else_)+      FlatConditional (Identity (Product sect c)) -> conditional c (toSection_ sect) Nothing+      ThenElseConditional (Identity (Product (ThenElse then_ else_) c)) -> conditional c (toSectionI_ then_) (Just $ toSectionI_ else_)+      where+        conditional (Condition (Cond c)) = Conditional c  pathsModuleFromPackageName :: String -> String pathsModuleFromPackageName name = "Paths_" ++ map f name

@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE LambdaCase #-}+module Hpack.Defaults (+  ensure+, Defaults(..)+#ifdef TEST+, Result(..)+, ensureFile+#endif+) where++import           Network.HTTP.Types+import           Network.HTTP.Client+import           Network.HTTP.Client.TLS+import           Data.List+import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString.Char8 as B+import           System.FilePath+import           System.Directory++import           Hpack.Syntax++type URL = String++defaultsUrl :: Defaults -> URL+defaultsUrl Defaults{..} = "https://raw.githubusercontent.com/" ++ defaultsGithubUser ++ "/" ++ defaultsGithubRepo ++ "/" ++ defaultsRef ++ "/" ++ intercalate "/" defaultsPath++defaultsCachePath :: FilePath -> Defaults -> FilePath+defaultsCachePath dir Defaults{..} = joinPath $+  dir : "defaults" : defaultsGithubUser : defaultsGithubRepo : defaultsRef : defaultsPath++data Result = Found | NotFound | Failed String+  deriving (Eq, Show)++get :: URL -> FilePath -> IO Result+get url file = do+  manager <- newManager tlsManagerSettings+  request <- parseRequest url+  response <- httpLbs request manager+  case responseStatus response of+    Status 200 _ -> do+      createDirectoryIfMissing True (takeDirectory file)+      LB.writeFile file (responseBody response)+      return Found+    Status 404 _ -> return NotFound+    status -> return (Failed $ "Error while downloading " ++ url ++ " (" ++ formatStatus status ++ ")")++formatStatus :: Status -> String+formatStatus (Status code message) = show code ++ " " ++ B.unpack message++ensure :: FilePath -> Defaults -> IO (Either String FilePath)+ensure dir defaults =+  ensureFile file url >>= \ case+    Found -> return (Right file)+    NotFound -> return (Left notFound)+    Failed err -> return (Left err)+  where+    url = defaultsUrl defaults+    file = defaultsCachePath dir defaults+    notFound = "Invalid value for \"defaults\"! File " ++ url ++ " does not exist!"++ensureFile :: FilePath -> URL -> IO Result+ensureFile file url = do+  doesFileExist file >>= \ case+    True -> return Found+    False -> get url file

@@ -1,45 +0,0 @@-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ConstraintKinds #-}-module Hpack.GenericsUtil (-  HasTypeName-, typeName-, Selectors-, selectors-) where--import           Data.Proxy-import           GHC.Generics--type HasTypeName a d m = (Datatype d, Generic a, Rep a ~ M1 D d m)--typeName :: forall a d m. (Datatype d, Generic a, Rep a ~ M1 D d m) => Proxy a -> String-typeName _ = datatypeName (undefined :: M1 D d x y)--selectors :: (Selectors (Rep a)) => Proxy a -> [String]-selectors = f-  where-    f :: forall a. (Selectors (Rep a)) => Proxy a -> [String]-    f _ = selNames (Proxy :: Proxy (Rep a))--class Selectors a where-  selNames :: Proxy a -> [String]--instance Selectors f => Selectors (M1 D x f) where-  selNames _ = selNames (Proxy :: Proxy f)--instance Selectors f => Selectors (M1 C x f) where-  selNames _ = selNames (Proxy :: Proxy f)--instance Selector s => Selectors (M1 S s (K1 R t)) where-  selNames _ = [selName (undefined :: M1 S s (K1 R t) ())]--instance (Selectors a, Selectors b) => Selectors (a :*: b) where-  selNames _ = selNames (Proxy :: Proxy a) ++ selNames (Proxy :: Proxy b)--instance Selectors U1 where-  selNames _ = []

@@ -1,6 +1,6 @@ module Hpack.Options where -data ParseResult = Help | PrintVersion | Run Options | ParseError+data ParseResult = Help | PrintVersion | PrintNumericVersion | Run Options | ParseError   deriving (Eq, Show)  data Verbose = Verbose | NoVerbose@@ -19,6 +19,7 @@ parseOptions :: [String] -> ParseResult parseOptions xs = case xs of   ["--version"] -> PrintVersion+  ["--numeric-version"] -> PrintNumericVersion   ["--help"] -> Help   _ -> case targets of     Just (target, toStdout) -> Run (Options verbose force toStdout target)

@@ -27,6 +27,8 @@ import           Data.List import           System.Exit import           System.FilePath+import           System.Directory+import           Data.Version import           Data.Map.Lazy (Map) import qualified Data.Map.Lazy as Map @@ -38,9 +40,10 @@ run :: Maybe FilePath -> FilePath -> IO ([String], FilePath, String) run mDir c = do   let dir = fromMaybe "" mDir-  mPackage <- readPackageConfig (dir </> c)+  userDataDir <- getAppUserDataDirectory "hpack"+  mPackage <- readPackageConfig userDataDir (dir </> c)   case mPackage of-    Right (warnings, pkg) -> do+    Right (pkg, warnings) -> do       let cabalFile = dir </> (packageName pkg ++ ".cabal")        old <- tryReadFile cabalFile@@ -126,26 +129,31 @@         separator = let Alignment n = alignment in ",\n" ++ replicate n ' '      cabalVersion :: Maybe String-    cabalVersion = maximum [-        Just ">= 1.10"+    cabalVersion = (">= " ++) . showVersion <$> maximum [+        Just (makeVersion [1,10])       , packageCabalVersion-      , packageLibrary >>= libraryCabalVersion+      , packageLibrary >>= libraryCabalVersion . sectionData       , internalLibsCabalVersion packageInternalLibraries       ]      where-      packageCabalVersion :: Maybe String-      packageCabalVersion-        | isJust packageCustomSetup = Just ">= 1.24"-        | otherwise = Nothing--      libraryCabalVersion :: Section Library -> Maybe String-      libraryCabalVersion sect = ">= 1.22" <$ guard (hasReexportedModules sect)+      packageCabalVersion :: Maybe Version+      packageCabalVersion = maximum [+          Nothing+        , makeVersion [1,24] <$ packageCustomSetup+        , makeVersion [1,18] <$ guard (not (null packageExtraDocFiles))+        ] -      hasReexportedModules :: Section Library -> Bool-      hasReexportedModules = not . null . libraryReexportedModules . sectionData+      libraryCabalVersion :: Library -> Maybe Version+      libraryCabalVersion Library{..} = maximum [+          makeVersion [1,22] <$ guard hasReexportedModules+        , makeVersion [2,0]  <$ guard hasSignatures+        ]+        where+          hasReexportedModules = (not . null) libraryReexportedModules+          hasSignatures = (not . null) librarySignatures -      internalLibsCabalVersion :: Map String (Section Library) -> Maybe String-      internalLibsCabalVersion internalLibraries = ">= 2.0" <$ guard (not (Map.null internalLibraries))+      internalLibsCabalVersion :: Map String (Section Library) -> Maybe Version+      internalLibsCabalVersion internalLibraries = makeVersion [2,0] <$ guard (not (Map.null internalLibraries))  sortSectionFields :: [(String, [String])] -> [Element] -> [Element] sortSectionFields sectionsFieldOrder = go@@ -239,6 +247,7 @@     renderExposedModules libraryExposedModules   , renderOtherModules libraryOtherModules   , renderReexportedModules libraryReexportedModules+  , renderSignatures librarySignatures   ]  renderExposed :: Bool -> Element@@ -297,6 +306,9 @@  renderReexportedModules :: [String] -> Element renderReexportedModules = Field "reexported-modules" . LineSeparatedList++renderSignatures :: [String] -> Element+renderSignatures = Field "signatures" . CommaSeparatedList  renderDependencies :: String -> Dependencies -> Element renderDependencies name = Field name . CommaSeparatedList . map renderDependency . Map.toList . unDependencies

@@ -0,0 +1,122 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+module Hpack.Syntax (+  Defaults(..)+#ifdef TEST+, isValidUser+, isValidRepo+#endif+) where++import           Data.List+import           Data.Data+import           System.FilePath.Posix (splitDirectories)++import           Hpack.Syntax.Util+import           Hpack.Syntax.UnknownFields+import           Hpack.Syntax.Git++data ParseDefaults = ParseDefaults {+  parseDefaultsGithub :: Github+, parseDefaultsRef :: Ref+, parseDefaultsPath :: Maybe Path+} deriving Generic++instance HasFieldNames ParseDefaults++instance FromJSON ParseDefaults where+  parseJSON = genericParseJSON++data Github = Github {+  githubUser :: String+, githubRepo :: String+}++instance FromJSON Github where+  parseJSON v = parseJSON v >>= parseGithub++parseGithub :: String -> Parser Github+parseGithub github+  | not (isValidUser user) = fail ("invalid user name " ++ show user)+  | not (isValidRepo repo) = fail ("invalid repository name " ++ show repo)+  | otherwise = return (Github user repo)+  where+    (user, repo) = drop 1 <$> break (== '/') github++isValidUser :: String -> Bool+isValidUser user =+     not (null user)+  && all isAlphaNumOrHyphen user+  && doesNotHaveConsecutiveHyphens user+  && doesNotBeginWithHyphen user+  && doesNotEndWithHyphen user+  where+    isAlphaNumOrHyphen = (`elem` '-' : alphaNum)+    doesNotHaveConsecutiveHyphens = not . isInfixOf "--"+    doesNotBeginWithHyphen = not . isPrefixOf "-"+    doesNotEndWithHyphen = not . isSuffixOf "-"++isValidRepo :: String -> Bool+isValidRepo repo =+     not (null repo)+  && repo `notElem` [".", ".."]+  && all isValid repo+  where+    isValid = (`elem` '_' : '.' : '-' : alphaNum)++alphaNum :: [Char]+alphaNum = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9']++data Ref = Ref {unRef :: String}++instance FromJSON Ref where+  parseJSON v = parseJSON v >>= parseRef++parseRef :: String -> Parser Ref+parseRef ref+  | isValidRef ref = return (Ref ref)+  | otherwise = fail ("invalid Git reference " ++ show ref)++data Path = Path {unPath :: [FilePath]}++instance FromJSON Path where+  parseJSON v = parseJSON v >>= parsePath+    where+      parsePath path+        | '\\' `elem` path = fail ("rejecting '\\' in " ++ show path ++ ", please use '/' to separate path components")+        | ':' `elem` path = fail ("rejecting ':' in " ++ show path)+        | "/" `elem` p = fail ("rejecting absolute path " ++ show path)+        | ".." `elem` p = fail ("rejecting \"..\" in " ++ show path)+        | otherwise = return (Path p)+        where+          p = splitDirectories path++data Defaults = Defaults {+  defaultsGithubUser :: String+, defaultsGithubRepo :: String+, defaultsRef :: String+, defaultsPath :: [FilePath]+} deriving (Eq, Show)++instance FromJSON Defaults where+  parseJSON v = toDefaults <$> case v of+    String _ -> parseJSON v >>= parseDefaultsFromString+    Object _ -> parseJSON v+    _ -> typeMismatch "Object or String" v+    where+      toDefaults :: ParseDefaults -> Defaults+      toDefaults ParseDefaults{..} = Defaults {+          defaultsGithubUser = githubUser parseDefaultsGithub+        , defaultsGithubRepo = githubRepo parseDefaultsGithub+        , defaultsRef = unRef parseDefaultsRef+        , defaultsPath = maybe [".hpack", "defaults.yaml"] unPath parseDefaultsPath+        }++parseDefaultsFromString :: String -> Parser ParseDefaults+parseDefaultsFromString xs = case break (== '@') xs of+  (github, '@' : ref) -> ParseDefaults <$> parseGithub github <*> parseRef ref <*> pure Nothing+  _ -> fail ("missing Git reference for " ++ show xs ++ ", the expected format is user/repo@ref")++instance HasFieldNames Defaults where+  fieldNames Proxy = fieldNames (Proxy :: Proxy ParseDefaults)

@@ -0,0 +1,45 @@+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ConstraintKinds #-}+module Hpack.Syntax.GenericsUtil (+  HasTypeName+, typeName+, Selectors+, selectors+) where++import           Data.Proxy+import           GHC.Generics++type HasTypeName a d m = (Datatype d, Generic a, Rep a ~ M1 D d m)++typeName :: forall a d m. (Datatype d, Generic a, Rep a ~ M1 D d m) => Proxy a -> String+typeName _ = datatypeName (undefined :: M1 D d x y)++selectors :: (Selectors (Rep a)) => Proxy a -> [String]+selectors = f+  where+    f :: forall a. (Selectors (Rep a)) => Proxy a -> [String]+    f _ = selNames (Proxy :: Proxy (Rep a))++class Selectors a where+  selNames :: Proxy a -> [String]++instance Selectors f => Selectors (M1 D x f) where+  selNames _ = selNames (Proxy :: Proxy f)++instance Selectors f => Selectors (M1 C x f) where+  selNames _ = selNames (Proxy :: Proxy f)++instance Selector s => Selectors (M1 S s (K1 R t)) where+  selNames _ = [selName (undefined :: M1 S s (K1 R t) ())]++instance (Selectors a, Selectors b) => Selectors (a :*: b) where+  selNames _ = selNames (Proxy :: Proxy a) ++ selNames (Proxy :: Proxy b)++instance Selectors U1 where+  selNames _ = []

@@ -0,0 +1,28 @@+module Hpack.Syntax.Git (+  isValidRef+) where++import           Data.Char (chr)+import           Data.List+import           System.FilePath.Posix++-- https://git-scm.com/docs/git-check-ref-format+isValidRef :: String -> Bool+isValidRef ref =+     not (null ref)+  && not (any (isSuffixOf ".lock") components)+  && not (any (isPrefixOf ".") components)+  && not (".." `isInfixOf` ref)+  && not (any isControl ref)+  && all (`notElem` " ~^:?*[\\") ref+  && not ("//" `isInfixOf` ref)+  && not ("/" `isPrefixOf` ref)+  && not ("/" `isSuffixOf` ref)+  && not ("." `isSuffixOf` ref)+  && not ("@{" `isInfixOf` ref)+  && not (ref == "@")+  where+    components = splitDirectories ref++isControl :: Char -> Bool+isControl c = c < chr 0o040 || c == chr 0o177

@@ -0,0 +1,83 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+module Hpack.Syntax.UnknownFields (+  FieldName+, HasFieldNames(..)+, hyphenize++, CaptureUnknownFields+, Preposition(..)+, formatUnknownFields+) where++import           Control.Monad+import           Data.Data+import qualified Data.HashMap.Lazy as HashMap+import           Data.List+import qualified Data.Text as T+import           GHC.Generics++import           Hpack.Syntax.GenericsUtil+import           Hpack.Syntax.Util++newtype FieldName = FieldName {unFieldName :: String}++class HasFieldNames a where+  fieldNames :: Proxy a -> [FieldName]++  default fieldNames :: (HasTypeName a d m, Selectors (Rep a)) => Proxy a -> [FieldName]+  fieldNames proxy = map (FieldName . hyphenize (typeName proxy)) (selectors proxy)++  ignoreUnderscoredUnknownFields :: Proxy a -> Bool+  ignoreUnderscoredUnknownFields _ = False++data CaptureUnknownFields a = CaptureUnknownFields [FieldName] a+  deriving Functor++instance Applicative CaptureUnknownFields where+  pure = return+  (<*>) = ap++instance Monad CaptureUnknownFields where+  return = CaptureUnknownFields mempty+  (CaptureUnknownFields xs x) >>= f = CaptureUnknownFields (xs `mappend` ys) y+    where+      CaptureUnknownFields ys y = f x++captureUnknownFields :: forall a. (HasFieldNames a, FromJSON a) => Value -> Parser (CaptureUnknownFields a)+captureUnknownFields v = CaptureUnknownFields unknown <$> parseJSON v+  where+    unknown = getUnknownFields v (Proxy :: Proxy a)++instance (HasFieldNames a, FromJSON a) => FromJSON (CaptureUnknownFields a) where+  parseJSON = captureUnknownFields++getUnknownFields :: forall a. HasFieldNames a => Value -> Proxy a -> [FieldName]+getUnknownFields v _ = case v of+  Object o -> map FieldName (ignoreUnderscored unknown)+    where+      unknown = keys \\ fields+      keys = map T.unpack (HashMap.keys o)+      fields = map unFieldName $ fieldNames (Proxy :: Proxy a)+      ignoreUnderscored+        | ignoreUnderscoredUnknownFields (Proxy :: Proxy a) = filter (not . isPrefixOf "_")+        | otherwise = id+  _ -> []++data Preposition = In | For++formatUnknownFields :: Preposition -> String -> CaptureUnknownFields a -> ([String], a)+formatUnknownFields p name (CaptureUnknownFields unknownFields a) = (formatUnknownFields_ preposition name unknownFields, a)+  where+    preposition = case p of+      In -> "in"+      For -> "for"++formatUnknownFields_ :: String -> String -> [FieldName] -> [String]+formatUnknownFields_ preposition name = map f+  where+    f (FieldName field) = "Ignoring unknown field " ++ show field ++ " " ++ preposition ++ " " ++ name

@@ -0,0 +1,36 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+module Hpack.Syntax.Util (+  Generic+, genericParseJSON+, hyphenize+, module Data.Aeson.Types+) where++import qualified Data.Aeson.Types as Aeson+import           Data.Aeson.Types hiding (genericParseJSON)+import           Data.Data+import           GHC.Generics++import           Hpack.Syntax.GenericsUtil++#if MIN_VERSION_aeson(1,0,0)+genericParseJSON :: forall a d m. (GFromJSON Zero (Rep a), HasTypeName a d m) => Value -> Parser a+#else+genericParseJSON :: forall a d m. (GFromJSON (Rep a), HasTypeName a d m) => Value -> Parser a+#endif+genericParseJSON = Aeson.genericParseJSON defaultOptions {fieldLabelModifier = hyphenize name}+  where+    name :: String+    name = typeName (Proxy :: Proxy a)++hyphenize :: String -> String -> String+hyphenize name =+#if MIN_VERSION_aeson(0,10,0)+  camelTo2+#else+  camelTo+#endif+  '-' . drop (length (dropWhile (== '_') $ reverse name)) . dropWhile (== '_')

@@ -1,92 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE FlexibleContexts #-}-module Hpack.UnknownFields (-  FieldName-, HasFieldNames(..)-, hyphenize--, CaptureUnknownFields-, Preposition(..)-, formatUnknownFields-) where--import           Control.Monad-import           Data.Aeson.Types-import           Data.Data-import qualified Data.HashMap.Lazy as HashMap-import           Data.List-import qualified Data.Text as T-import           GHC.Generics--import           Hpack.GenericsUtil--newtype FieldName = FieldName {unFieldName :: String}--class HasFieldNames a where-  fieldNames :: Proxy a -> [FieldName]--  default fieldNames :: (HasTypeName a d m, Selectors (Rep a)) => Proxy a -> [FieldName]-  fieldNames proxy = map (FieldName . hyphenize (typeName proxy)) (selectors proxy)--  ignoreUnderscoredUnknownFields :: Proxy a -> Bool-  ignoreUnderscoredUnknownFields _ = False--hyphenize :: String -> String -> String-hyphenize name =-#if MIN_VERSION_aeson(0,10,0)-  camelTo2-#else-  camelTo-#endif-  '-' . drop (length name) . dropWhile (== '_')--data CaptureUnknownFields a = CaptureUnknownFields [FieldName] a-  deriving Functor--instance Applicative CaptureUnknownFields where-  pure = return-  (<*>) = ap--instance Monad CaptureUnknownFields where-  return = CaptureUnknownFields mempty-  (CaptureUnknownFields xs x) >>= f = CaptureUnknownFields (xs `mappend` ys) y-    where-      CaptureUnknownFields ys y = f x--captureUnknownFields :: forall a. (HasFieldNames a, FromJSON a) => Value -> Parser (CaptureUnknownFields a)-captureUnknownFields v = CaptureUnknownFields unknown <$> parseJSON v-  where-    unknown = getUnknownFields v (Proxy :: Proxy a)--instance (HasFieldNames a, FromJSON a) => FromJSON (CaptureUnknownFields a) where-  parseJSON = captureUnknownFields--getUnknownFields :: forall a. HasFieldNames a => Value -> Proxy a -> [FieldName]-getUnknownFields v _ = case v of-  Object o -> map FieldName (ignoreUnderscored unknown)-    where-      unknown = keys \\ fields-      keys = map T.unpack (HashMap.keys o)-      fields = map unFieldName $ fieldNames (Proxy :: Proxy a)-      ignoreUnderscored-        | ignoreUnderscoredUnknownFields (Proxy :: Proxy a) = filter (not . isPrefixOf "_")-        | otherwise = id-  _ -> []--data Preposition = In | For--formatUnknownFields :: Preposition -> String -> CaptureUnknownFields a -> ([String], a)-formatUnknownFields p name (CaptureUnknownFields unknownFields a) = (formatUnknownFields_ preposition name unknownFields, a)-  where-    preposition = case p of-      In -> "in"-      For -> "for"--formatUnknownFields_ :: String -> String -> [FieldName] -> [String]-formatUnknownFields_ preposition name = map f-  where-    f (FieldName field) = "Ignoring unknown field " ++ show field ++ " " ++ preposition ++ " " ++ name

@@ -2,6 +2,7 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Hpack.Util (   List(..) , GhcOption@@ -44,7 +45,7 @@ lexicographically x = (map toLower x, x)  newtype List a = List {fromList :: [a]}-  deriving (Eq, Show, Functor, Foldable, Traversable)+  deriving (Eq, Show, Functor, Foldable, Traversable, Monoid)  instance FromJSON a => FromJSON (List a) where   parseJSON v = List <$> case v of

@@ -5,9 +5,13 @@ {-# LANGUAGE ConstraintKinds #-} module EndToEndSpec (spec) where +import           Prelude hiding (writeFile)+import qualified Prelude+ import           Helper -import           System.Exit+import           System.Directory (canonicalizePath)+import           Control.Exception import           Data.Maybe import           Data.List import           Data.String.Interpolate@@ -17,9 +21,125 @@ import           Hpack.Config (packageConfig, readPackageConfig) import           Hpack.FormattingHints (FormattingHints(..), sniffFormattingHints) +writeFile :: FilePath -> String -> IO ()+writeFile file c = touch file >> Prelude.writeFile file c+ spec :: Spec spec = around_ (inTempDirectoryNamed "foo") $ do   describe "hpack" $ do+    context "with defaults" $ do+      it "accepts global defaults" $ do+        writeFile "defaults/sol/hpack-template/2017/defaults.yaml" [i|+        default-extensions:+          - RecordWildCards+          - DeriveFunctor+        |]++        [i|+        defaults:+          github: sol/hpack-template+          path: defaults.yaml+          ref: "2017"+        library: {}+        |] `shouldRenderTo` library [i|+        other-modules:+            Paths_foo+        default-extensions: RecordWildCards DeriveFunctor+        |]++      it "accepts library defaults" $ do+        writeFile "defaults/sol/hpack-template/2017/defaults.yaml" [i|+        exposed-modules: Foo+        |]++        [i|+        library:+          defaults:+            github: sol/hpack-template+            path: defaults.yaml+            ref: "2017"+        |] `shouldRenderTo` library [i|+        exposed-modules:+            Foo+        other-modules:+            Paths_foo+        |]++      it "accepts a list of defaults" $ do+        writeFile "defaults/foo/bar/v1/.hpack/defaults.yaml" "default-extensions: RecordWildCards"+        writeFile "defaults/foo/bar/v2/.hpack/defaults.yaml" "default-extensions: DeriveFunctor"+        [i|+        defaults:+          - foo/bar@v1+          - foo/bar@v2+        library: {}+        |] `shouldRenderTo` library [i|+        other-modules:+            Paths_foo+        default-extensions: RecordWildCards DeriveFunctor+        |]++      it "accepts defaults recursively" $ do+        writeFile "defaults/foo/bar/v1/.hpack/defaults.yaml" "defaults: foo/bar@v2"+        writeFile "defaults/foo/bar/v2/.hpack/defaults.yaml" "default-extensions: DeriveFunctor"+        [i|+        defaults: foo/bar@v1+        library: {}+        |] `shouldRenderTo` library [i|+        other-modules:+            Paths_foo+        default-extensions: DeriveFunctor+        |]++      it "fails on cyclic defaults" $ do+        let+          file1 = "defaults/foo/bar/v1/.hpack/defaults.yaml"+          file2 = "defaults/foo/bar/v2/.hpack/defaults.yaml"+        writeFile file1 "defaults: foo/bar@v2"+        writeFile file2 "defaults: foo/bar@v1"+        canonic1 <- canonicalizePath file1+        canonic2 <- canonicalizePath file2+        [i|+        defaults: foo/bar@v1+        library: {}+        |] `shouldFailWith` [i|cycle in defaults (#{canonic1} -> #{canonic2} -> #{canonic1})|]++      it "fails if defaults don't exist" $ do+        pending+        [i|+        defaults:+          github: sol/foo+          ref: bar+        library: {}+        |] `shouldFailWith` "Invalid value for \"defaults\"! File https://raw.githubusercontent.com/sol/foo/bar/.hpack/defaults.yaml does not exist!"++      it "fails on parse error" $ do+        let file = joinPath ["defaults", "sol", "hpack-template", "2017", "defaults.yaml"]+        writeFile file "[]"+        [i|+        defaults:+          github: sol/hpack-template+          path: defaults.yaml+          ref: "2017"+        library: {}+        |] `shouldFailWith` (file ++ ": Error in $: expected record (:*:), encountered Array")++      it "warns on unknown fields" $ do+        let file = joinPath ["defaults", "sol", "hpack-template", "2017", "defaults.yaml"]+        writeFile file "foo: bar"+        [i|+        defaults:+          github: sol/hpack-template+          path: defaults.yaml+          ref: "2017"+          bar: baz+        name: foo+        library: {}+        |] `shouldWarn` [+            "Ignoring unknown field \"bar\" in defaults section"+          , "Ignoring unknown field \"foo\" in " ++ file+          ]+     describe "extra-doc-files" $ do       it "accepts a list of files" $ do         touch "CHANGES.markdown"@@ -28,11 +148,11 @@         extra-doc-files:           - CHANGES.markdown           - README.markdown-        |] `shouldRenderTo` package [i|+        |] `shouldRenderTo` (package [i|         extra-doc-files:             CHANGES.markdown             README.markdown-        |]+        |]) {packageCabalVersion = ">= 1.18"}        it "accepts glob patterns" $ do         touch "CHANGES.markdown"@@ -40,11 +160,11 @@         [i|         extra-doc-files:           - "*.markdown"-        |] `shouldRenderTo` package [i|+        |] `shouldRenderTo` (package [i|         extra-doc-files:             CHANGES.markdown             README.markdown-        |]+        |]) {packageCabalVersion = ">= 1.18"}        it "warns if a glob pattern does not match anything" $ do         [i|@@ -225,6 +345,17 @@           |] `shouldWarn` pure "Specified pattern \"foo/*.c\" for c-sources does not match any files"        context "with library" $ do+        it "accepts signatures" $ do+          [i|+          library:+            signatures: Foo+          |] `shouldRenderTo` (library [i|+          other-modules:+              Paths_foo+          signatures:+              Foo+          |]) {packageCabalVersion = ">= 2.0"}+         it "accepts global c-sources" $ do           [i|           c-sources: cbits/*.c@@ -709,13 +840,13 @@             ]  run :: FilePath -> String -> IO ([String], String)-run c old = run_ c old >>= either die return+run c old = run_ c old >>= either (throwIO . ErrorCall) return  run_ :: FilePath -> String -> IO (Either String ([String], String)) run_ c old = do-  mPackage <- readPackageConfig c+  mPackage <- readPackageConfig "" c   return $ case mPackage of-    Right (warnings, pkg) ->+    Right (pkg, warnings) ->       let         FormattingHints{..} = sniffFormattingHints old         alignment = fromMaybe 0 formattingHintsAlignment

@@ -1,3 +1,5 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-} module Helper (   module Test.Hspec , module Test.Mockery.Directory@@ -5,7 +7,10 @@ , withTempDirectory , module System.FilePath , withCurrentDirectory+, shouldParseAs ) where+import           Data.Yaml+import           Data.ByteString (ByteString)  import           Test.Hspec import           Test.Mockery.Directory@@ -24,3 +29,7 @@ withTempDirectory :: (FilePath -> IO a) -> IO a withTempDirectory action = Temp.withSystemTempDirectory "hspec" $ \dir -> do   canonicalizePath dir >>= action++shouldParseAs :: (HasCallStack, Show a, Eq a, FromJSON a) => ByteString -> Either String a -> Expectation+shouldParseAs input expected = do+  decodeEither input `shouldBe` expected

@@ -41,25 +41,25 @@ executable main_ = Executable (Just main_) ["Paths_foo"]  library :: Library-library = Library Nothing [] ["Paths_foo"] []+library = Library Nothing [] ["Paths_foo"] [] [] -withPackage :: String -> IO () -> (([String], Package) -> Expectation) -> Expectation+withPackage :: String -> IO () -> ((Package, [String]) -> Expectation) -> Expectation withPackage content beforeAction expectation = withTempDirectory $ \dir_ -> do   let dir = dir_ </> "foo"   createDirectory dir   writeFile (dir </> "package.yaml") content   withCurrentDirectory dir beforeAction-  r <- readPackageConfig (dir </> "package.yaml")+  r <- readPackageConfig undefined (dir </> "package.yaml")   either expectationFailure expectation r  withPackageConfig :: String -> IO () -> (Package -> Expectation) -> Expectation-withPackageConfig content beforeAction expectation = withPackage content beforeAction (expectation . snd)+withPackageConfig content beforeAction expectation = withPackage content beforeAction (expectation . fst)  withPackageConfig_ :: String -> (Package -> Expectation) -> Expectation withPackageConfig_ content = withPackageConfig content (return ())  withPackageWarnings :: String -> IO () -> ([String] -> Expectation) -> Expectation-withPackageWarnings content beforeAction expectation = withPackage content beforeAction (expectation . fst)+withPackageWarnings content beforeAction expectation = withPackage content beforeAction (expectation . snd)  withPackageWarnings_ :: String -> ([String] -> Expectation) -> Expectation withPackageWarnings_ content = withPackageWarnings content (return ())@@ -88,12 +88,14 @@       , librarySectionExposedModules = Nothing       , librarySectionOtherModules = Nothing       , librarySectionReexportedModules = Nothing+      , librarySectionSignatures = Nothing       }       lib = Library {         libraryExposed = Nothing       , libraryExposedModules = []       , libraryOtherModules = []       , libraryReexportedModules = []+      , librarySignatures = []       }       inferableModules = ["Foo", "Bar"]       from = fromLibrarySectionInConditional inferableModules@@ -881,7 +883,7 @@             foo: bar             foo baz             |]-          readPackageConfig file `shouldReturn` Left (file ++ ":3:12: could not find expected ':' while scanning a simple key")+          readPackageConfig undefined file `shouldReturn` Left (file ++ ":3:12: could not find expected ':' while scanning a simple key")        context "when package.yaml is invalid" $ do         it "returns an error" $ \dir -> do@@ -890,9 +892,31 @@             - one             - two             |]-          readPackageConfig file >>= (`shouldSatisfy` isLeft)+          readPackageConfig undefined file >>= (`shouldSatisfy` isLeft)        context "when package.yaml does not exist" $ do         it "returns an error" $ \dir -> do           let file = dir </> "package.yaml"-          readPackageConfig file `shouldReturn` Left [i|#{file}: Yaml file not found: #{file}|]+          readPackageConfig undefined file `shouldReturn` Left [i|#{file}: Yaml file not found: #{file}|]++  describe "parseJSON" $ do+    context "when parsing Cond" $ do+      it "accepts Strings" $ do+        [i|+        os(windows)+        |] `shouldParseAs` Right (Cond "os(windows)")++      it "accepts True" $ do+        [i|+        yes+        |] `shouldParseAs` Right (Cond "true")++      it "accepts False" $ do+        [i|+        no+        |] `shouldParseAs` Right (Cond "false")++      it "rejects other values" $ do+        [i|+        23+        |] `shouldParseAs` (Left "Error in $: expected Boolean or String, encountered Number" :: Either String Cond)

@@ -0,0 +1,39 @@+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+module Hpack.DefaultsSpec (spec) where++import           Helper+import           System.Directory++import           Hpack.Defaults++spec :: Spec+spec = do+  describe "ensureFile" $ do+    let+      file = "foo"+      url = "https://raw.githubusercontent.com/sol/hpack/master/Setup.lhs"++    it "downloads file if missing" $ do+      pending+      expected <- readFile "Setup.lhs"+      inTempDirectory $ do+        Found <- ensureFile file url+        readFile file `shouldReturn` expected++    context "with existing file" $ do+      it "does nothing" $ do+        let expected = "contents of existing file"+        inTempDirectory $ do+          writeFile file expected+          Found <- ensureFile file url+          readFile file `shouldReturn` expected++    context "with 404" $ do+      let+        url = "https://raw.githubusercontent.com/sol/hpack/master/Setup.foo"++      it "does not create any files" $ do+        pending+        inTempDirectory $ do+          NotFound <- ensureFile file url+          doesFileExist file `shouldReturn` False

@@ -5,21 +5,14 @@ module Hpack.DependencySpec (spec) where  import           Helper-import           Test.HUnit -import           Data.Aeson.Types-import qualified Data.Map.Lazy as Map import           Data.String.Interpolate.IsString-import           Data.Yaml import           Data.ByteString (ByteString)  import           Hpack.Dependency -parsesAs :: HasCallStack => ByteString -> Either String [(String, DependencyVersion)] -> Expectation-parsesAs input expected = do-  value <- either assertFailure return (decodeEither input)-  parseEither parseJSON value `shouldBe` (Dependencies . Map.fromList <$> expected)-+parsesAs :: HasCallStack => ByteString -> Either String Dependencies -> Expectation+parsesAs = shouldParseAs  spec :: Spec spec = do

@@ -1,24 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-module Hpack.GenericsUtilSpec (spec) where--import           Test.Hspec--import           Data.Proxy-import           GHC.Generics--import           Hpack.GenericsUtil--data Person = Person {-  _personName :: String-, _personAge :: Int-} deriving Generic--spec :: Spec-spec = do-  describe "selectors" $ do-    it "returns a list of record selectors" $ do-      selectors (Proxy :: Proxy Person) `shouldBe` ["_personName", "_personAge"]--  describe "typeName" $ do-    it "gets datatype name" $ do-      typeName (Proxy :: Proxy Person) `shouldBe` "Person"

@@ -11,7 +11,7 @@ import           Hpack.Run  library :: Library-library = Library Nothing [] [] []+library = Library Nothing [] [] [] []  renderEmptySection :: Empty -> [Element] renderEmptySection Empty = []

@@ -0,0 +1,24 @@+{-# LANGUAGE DeriveGeneric #-}+module Hpack.Syntax.GenericsUtilSpec (spec) where++import           Test.Hspec++import           Data.Proxy+import           GHC.Generics++import           Hpack.Syntax.GenericsUtil++data Person = Person {+  _personName :: String+, _personAge :: Int+} deriving Generic++spec :: Spec+spec = do+  describe "selectors" $ do+    it "returns a list of record selectors" $ do+      selectors (Proxy :: Proxy Person) `shouldBe` ["_personName", "_personAge"]++  describe "typeName" $ do+    it "gets datatype name" $ do+      typeName (Proxy :: Proxy Person) `shouldBe` "Person"

@@ -0,0 +1,57 @@+{-# LANGUAGE QuasiQuotes #-}+module Hpack.Syntax.GitSpec (spec) where++import           Helper+import           Data.String.Interpolate+import           Control.Monad++import           Hpack.Syntax.Git++spec :: Spec+spec = do+  describe "isValidRef" $ do+    it "accepts slashes" $ do+      isValidRef "foo/bar" `shouldBe` True++    it "rejects the empty string" $ do+      isValidRef "" `shouldBe` False++    it "accepts .lock as a substring" $ do+      isValidRef "foo.locking" `shouldBe` True++    it "rejects .lock at the end of a component" $ do+      isValidRef "foo/bar.lock/baz" `shouldBe` False++    it "rejects . at the biginning of a component" $ do+      isValidRef "foo/.bar/baz" `shouldBe` False++    it "rejects two consecutive dots .." $ do+      isValidRef "foo..bar" `shouldBe` False++    it "rejects ASCII control characters" $ do+      isValidRef "foo\10bar" `shouldBe` False++    it "rejects space" $ do+      isValidRef "foo bar" `shouldBe` False++    forM_ ["~", "^", ":", "?", "*", "[", "\\"] $ \ xs -> do+      it [i|rejects #{xs}|] $ do+        isValidRef [i|foo#{xs}bar|] `shouldBe` False++    it "rejects multiple consecutive slashes" $ do+      isValidRef "foo//bar" `shouldBe` False++    it "rejects slash at beginning" $ do+      isValidRef "/foo" `shouldBe` False++    it "rejects slash at end" $ do+      isValidRef "foo/" `shouldBe` False++    it "rejects . at end" $ do+      isValidRef "foo." `shouldBe` False++    it "rejects @{" $ do+      isValidRef "foo@{bar" `shouldBe` False++    it "rejects the single character @" $ do+      isValidRef "@" `shouldBe` False

@@ -0,0 +1,21 @@+module Hpack.Syntax.UtilSpec (spec) where++import           Test.Hspec++import           Hpack.Syntax.Util++spec :: Spec+spec = do+  describe "hyphenize" $ do+    it "hyphenizes" $ do+      hyphenize "" "personFirstName" `shouldBe` "person-first-name"++    it "ignores leading underscores" $ do+      hyphenize "" "__personFirstName" `shouldBe` "person-first-name"++    context "when given a type name" $ do+      it "strips type name" $ do+        hyphenize "Person" "personFirstName" `shouldBe` "first-name"++      it "ignores trailing underscores in type name" $ do+        hyphenize "Person__" "personFirstName" `shouldBe` "first-name"

@@ -0,0 +1,148 @@+{-# LANGUAGE QuasiQuotes #-}+module Hpack.SyntaxSpec (spec) where++import           Helper+import           Data.String.Interpolate.IsString++import           Hpack.Syntax++spec :: Spec+spec = do+  describe "isValidUser" $ do+    it "rejects the empty string" $ do+      isValidUser "" `shouldBe` False++    it "accepts valid user names" $ do+      isValidUser "Foo-Bar-23" `shouldBe` True++    it "rejects dots" $ do+      isValidUser "foo.bar" `shouldBe` False++    it "rejects multiple consecutive hyphens" $ do+      isValidUser "foo--bar" `shouldBe` False++    it "rejects hyphens at the beginning" $ do+      isValidUser "-foo" `shouldBe` False++    it "rejects hyphens at the end" $ do+      isValidUser "foo-" `shouldBe` False++  describe "isValidRepo" $ do+    it "rejects the empty string" $ do+      isValidRepo "" `shouldBe` False++    it "rejects ." $ do+      isValidRepo "." `shouldBe` False++    it "rejects .." $ do+      isValidRepo ".." `shouldBe` False++    it "accepts underscores" $ do+      isValidRepo "foo_bar" `shouldBe` True++    it "accepts dots" $ do+      isValidRepo "foo.bar" `shouldBe` True++    it "accepts hyphens" $ do+      isValidRepo "foo-bar" `shouldBe` True++  describe "parseJSON" $ do+    context "when parsing Defaults" $ do+      context "with Object" $ do+        it "accepts Defaults from GitHub" $ do+          [i|+          github: sol/hpack+          ref: 0.1.0+          path: defaults.yaml+          |] `shouldParseAs` Right Defaults {+              defaultsGithubUser = "sol"+            , defaultsGithubRepo = "hpack"+            , defaultsRef = "0.1.0"+            , defaultsPath = ["defaults.yaml"]+            }++        it "rejects invalid user names" $ do+          [i|+          github: ../hpack+          ref: 0.1.0+          path: defaults.yaml+          |] `shouldParseAs` (Left "Error in $.github: invalid user name \"..\"" :: Either String Defaults)++        it "rejects invalid repository names" $ do+          [i|+          github: sol/..+          ref: 0.1.0+          path: defaults.yaml+          |] `shouldParseAs` (Left "Error in $.github: invalid repository name \"..\"" :: Either String Defaults)++        it "rejects invalid Git references" $ do+          [i|+          github: sol/hpack+          ref: ../foo/bar+          path: defaults.yaml+          |] `shouldParseAs` (Left "Error in $.ref: invalid Git reference \"../foo/bar\"" :: Either String Defaults)++        it "rejects \\ in path" $ do+          [i|+          github: sol/hpack+          ref: 0.1.0+          path: hpack\\defaults.yaml+          |] `shouldParseAs` (Left "Error in $.path: rejecting '\\' in \"hpack\\\\defaults.yaml\", please use '/' to separate path components" :: Either String Defaults)++        it "rejects : in path" $ do+          [i|+          github: sol/hpack+          ref: 0.1.0+          path: foo:bar.yaml+          |] `shouldParseAs` (Left "Error in $.path: rejecting ':' in \"foo:bar.yaml\"" :: Either String Defaults)++        it "rejects absolute paths" $ do+          [i|+          github: sol/hpack+          ref: 0.1.0+          path: /defaults.yaml+          |] `shouldParseAs` (Left "Error in $.path: rejecting absolute path \"/defaults.yaml\"" :: Either String Defaults)++        it "rejects .. in path" $ do+          [i|+          github: sol/hpack+          ref: 0.1.0+          path: ../../defaults.yaml+          |] `shouldParseAs` (Left "Error in $.path: rejecting \"..\" in \"../../defaults.yaml\"" :: Either String Defaults)++      context "with String" $ do+        it "accepts Defaults from GitHub" $ do+          [i|+          sol/hpack@0.1.0+          |] `shouldParseAs` Right Defaults {+              defaultsGithubUser = "sol"+            , defaultsGithubRepo = "hpack"+            , defaultsRef = "0.1.0"+            , defaultsPath = [".hpack", "defaults.yaml"]+            }++        it "rejects invalid user names" $ do+          [i|+          ../hpack@0.1.0+          |] `shouldParseAs` (Left "Error in $: invalid user name \"..\"" :: Either String Defaults)++        it "rejects invalid repository names" $ do+          [i|+          sol/..@0.1.0+          |] `shouldParseAs` (Left "Error in $: invalid repository name \"..\"" :: Either String Defaults)++        it "rejects invalid Git references" $ do+          [i|+          sol/pack@../foo/bar+          |] `shouldParseAs` (Left "Error in $: invalid Git reference \"../foo/bar\"" :: Either String Defaults)++        it "rejects missing Git reference" $ do+          [i|+          sol/hpack+          |] `shouldParseAs` (Left "Error in $: missing Git reference for \"sol/hpack\", the expected format is user/repo@ref" :: Either String Defaults)++      context "with neither Object nor String" $ do+        it "fails" $ do+          [i|+          10+          |] `shouldParseAs` (Left "Error in $: expected Object or String, encountered Number" :: Either String Defaults)