hpack 0.20.0 → 0.21.0

raw patch · 21 files changed

+1534/−898 lines, 21 filesdep +bifunctorsdep +transformersdep −base-compatdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: bifunctors, transformers

Dependencies removed: base-compat

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• hpack.cabal +19/−8
• src/Hpack.hs +7/−10
• src/Hpack/CabalFile.hs +2/−5
• src/Hpack/Config.hs +382/−243
• src/Hpack/Dependency.hs +0/−3
• src/Hpack/FormattingHints.hs +1/−5
• src/Hpack/Options.hs +0/−3
• src/Hpack/Render.hs +1/−4
• src/Hpack/Run.hs +61/−36
• src/Hpack/UnknownFields.hs +92/−0
• src/Hpack/Utf8.hs +61/−0
• src/Hpack/Util.hs +10/−19
• test/EndToEndSpec.hs +737/−0
• test/Hpack/CabalFileSpec.hs +1/−1
• test/Hpack/ConfigSpec.hs +102/−481
• test/Hpack/OptionsSpec.hs +0/−3
• test/Hpack/RenderSpec.hs +1/−4
• test/Hpack/RunSpec.hs +18/−70
• test/Hpack/Utf8Spec.hs +32/−0
• test/HpackSpec.hs +2/−3

@@ -1,3 +1,8 @@+## Changes in 0.21.0+  - Accept section-specific fields in conditionals (see #175, thanks to Scott+    Fleischman)+  - New section: `internal-libraries`, for Cabal 2's internal libraries (see #200).+ ## Changes in 0.20.0   - Do not overwrite any existing cabal file if it has been modified manually 

@@ -1,9 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.19.3.+-- This file has been generated from package.yaml by hpack version 0.20.0. -- -- see: https://github.com/sol/hpack+--+-- hash: db045f3697ddf50f10677f67652465713155419437cab6c893deede5a3330f31  name:           hpack-version:        0.20.0+version:        0.21.0 synopsis:       An alternative format for Haskell packages description:    See README at <https://github.com/sol/hpack#readme> category:       Development@@ -30,8 +32,8 @@       Cabal     , Glob     , aeson >=0.11-    , base >=4.7 && <5-    , base-compat >=0.8+    , base >=4.8 && <5+    , bifunctors     , bytestring     , containers     , cryptonite@@ -40,6 +42,7 @@     , filepath     , pretty     , text+    , transformers     , unordered-containers     , yaml   exposed-modules:@@ -55,6 +58,8 @@       Hpack.Haskell       Hpack.Options       Hpack.Render+      Hpack.UnknownFields+      Hpack.Utf8       Hpack.Util       Paths_hpack   default-language: Haskell2010@@ -68,8 +73,8 @@       Cabal     , Glob     , aeson >=0.11-    , base >=4.7 && <5-    , base-compat >=0.8+    , base >=4.8 && <5+    , bifunctors     , bytestring     , containers     , cryptonite@@ -79,6 +84,7 @@     , hpack     , pretty     , text+    , transformers     , unordered-containers     , yaml   other-modules:@@ -99,8 +105,8 @@     , HUnit >=1.6.0.0     , QuickCheck     , aeson >=0.11-    , base >=4.7 && <5-    , base-compat >=0.8+    , base >=4.8 && <5+    , bifunctors     , bytestring     , containers     , cryptonite@@ -113,9 +119,11 @@     , pretty     , temporary     , text+    , transformers     , unordered-containers     , yaml   other-modules:+      EndToEndSpec       Helper       Hpack.CabalFileSpec       Hpack.ConfigSpec@@ -126,6 +134,7 @@       Hpack.OptionsSpec       Hpack.RenderSpec       Hpack.RunSpec+      Hpack.Utf8Spec       Hpack.UtilSpec       HpackSpec       Hpack@@ -138,6 +147,8 @@       Hpack.Options       Hpack.Render       Hpack.Run+      Hpack.UnknownFields+      Hpack.Utf8       Hpack.Util       Hpack.Yaml       Paths_hpack

@@ -15,16 +15,12 @@ #endif ) where -import           Prelude ()-import           Prelude.Compat--import           Control.Monad.Compat-import qualified Data.ByteString as B+import           Control.Monad import           Data.Version (Version) import qualified Data.Version as Version import           System.Environment import           System.Exit-import           System.IO+import           System.IO (stderr) import           System.FilePath import           System.Directory @@ -33,6 +29,7 @@ import           Hpack.Config import           Hpack.Run import           Hpack.Util+import           Hpack.Utf8 as Utf8 import           Hpack.CabalFile  programVersion :: Version -> String@@ -63,7 +60,7 @@  printHelp :: IO () printHelp = do-  hPutStrLn stderr $ unlines [+  Utf8.hPutStrLn stderr $ unlines [       "Usage: hpack [ --silent ] [ --force | -f ] [ PATH ] [ - ]"     , "       hpack --version"     , "       hpack --help"@@ -101,7 +98,7 @@  printWarnings :: [String] -> IO () printWarnings warnings = do-  forM_ warnings $ \warning -> hPutStrLn stderr ("WARNING: " ++ warning)+  forM_ warnings $ \warning -> Utf8.hPutStrLn stderr ("WARNING: " ++ warning)  splitDirectory :: Maybe FilePath -> IO (Maybe FilePath, FilePath) splitDirectory Nothing = return (Nothing, packageConfig)@@ -137,7 +134,7 @@   case status of     Generated -> do       let hash = sha256 new-      B.writeFile cabalFile . encodeUtf8 $ header file v hash ++ new+      Utf8.writeFile cabalFile (header file v hash ++ new)     _ -> return ()   return Result     { resultWarnings = warnings@@ -149,5 +146,5 @@ hpackStdOut p = do   (dir, file) <- splitDirectory p   (warnings, _cabalFile, new) <- run dir file-  B.putStr (encodeUtf8 new)+  Utf8.putStr new   printWarnings warnings

@@ -3,11 +3,8 @@ {-# LANGUAGE ViewPatterns #-} module Hpack.CabalFile where -import           Prelude ()-import           Prelude.Compat--import           Control.Monad.Compat-import           Data.List.Compat+import           Control.Monad+import           Data.List import           Data.Maybe import           Data.Version (Version(..)) import qualified Data.Version as Version

@@ -8,11 +8,12 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE RankNTypes #-} module Hpack.Config (   packageConfig , readPackageConfig@@ -36,36 +37,42 @@ , SourceRepository(..) #ifdef TEST , renameDependencies-, HasFieldNames(..)-, CaptureUnknownFields(..) , Empty(..) , getModules , determineModules , BuildType(..)++, LibrarySection(..)+, fromLibrarySectionInConditional #endif ) where  import           Control.Applicative-import           Control.Monad.Compat+import           Control.Monad import           Data.Aeson.Types import           Data.Data+import           Data.Bifunctor+import           Data.Bifoldable+import           Data.Bitraversable import           Data.Map.Lazy (Map) import qualified Data.Map.Lazy as Map import qualified Data.HashMap.Lazy as HashMap-import           Data.List.Compat (nub, (\\), sortBy, isPrefixOf)+import           Data.List (nub, (\\), sortBy) import           Data.Maybe-import           Data.Monoid+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           Prelude ()-import           Prelude.Compat import           System.Directory import           System.FilePath+import           Data.Functor.Identity+import           Control.Monad.Trans.Writer+import           Control.Monad.IO.Class  import           Hpack.GenericsUtil+import           Hpack.UnknownFields import           Hpack.Util import           Hpack.Yaml import           Hpack.Dependency@@ -93,17 +100,18 @@   , packageSourceRepository = Nothing   , packageCustomSetup = Nothing   , packageLibrary = Nothing-  , packageExecutables = []-  , packageTests = []-  , packageBenchmarks = []+  , packageInternalLibraries = mempty+  , packageExecutables = mempty+  , packageTests = mempty+  , packageBenchmarks = mempty   }  renamePackage :: String -> Package -> Package renamePackage name p@Package{..} = p {     packageName = name-  , packageExecutables = map (renameDependencies packageName name) packageExecutables-  , packageTests = map (renameDependencies packageName name) packageTests-  , packageBenchmarks = map (renameDependencies packageName name) packageBenchmarks+  , packageExecutables = fmap (renameDependencies packageName name) packageExecutables+  , packageTests = fmap (renameDependencies packageName name) packageTests+  , packageBenchmarks = fmap (renameDependencies packageName name) packageBenchmarks   }  renameDependencies :: String -> String -> Section a -> Section a@@ -113,7 +121,7 @@       | name == old = (new, version)       | otherwise = dep -    renameConditional :: Conditional -> Conditional+    renameConditional :: Conditional (Section a) -> Conditional (Section a)     renameConditional (Conditional condition then_ else_) = Conditional condition (renameDependencies old new then_) (renameDependencies old new <$> else_)  packageDependencies :: Package -> [(String, DependencyVersion)]@@ -141,61 +149,6 @@     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 name) . dropWhile (== '_')--type FieldName = String--class HasFieldNames a where-  fieldNames :: Proxy a -> [FieldName]--  default fieldNames :: (HasTypeName a d m, Selectors (Rep a)) => Proxy a -> [String]-  fieldNames proxy = map (hyphenize $ typeName proxy) (selectors proxy)--  ignoreUnderscoredUnknownFields :: Proxy a -> Bool-  ignoreUnderscoredUnknownFields _ = False--data CaptureUnknownFields a = CaptureUnknownFields {-  captureUnknownFieldsFields :: [FieldName]-, captureUnknownFieldsValue :: a-} deriving (Eq, Show, Generic)--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 (Section a)) where-  parseJSON v = do-    (unknownFields, sect) <- toSection <$> parseJSON v <*> parseJSON v-    return (CaptureUnknownFields (unknownSectionFields ++ unknownFields) sect)-    where-      unknownSectionFields = getUnknownFields v (Proxy :: Proxy (Section a))--instance FromJSON (CaptureUnknownFields CustomSetupSection) where-  parseJSON = captureUnknownFields--instance FromJSON (CaptureUnknownFields FlagSection) where-  parseJSON = captureUnknownFields--getUnknownFields :: forall a. HasFieldNames a => Value -> Proxy a -> [FieldName]-getUnknownFields v _ = case v of-  Object o -> ignoreUnderscored unknown-    where-      unknown = keys \\ fields-      keys = map T.unpack (HashMap.keys o)-      fields = fieldNames (Proxy :: Proxy a)-      ignoreUnderscored-        | ignoreUnderscoredUnknownFields (Proxy :: Proxy a) = filter (not . isPrefixOf "_")-        | otherwise = id-  _ -> []- data CustomSetupSection = CustomSetupSection {   customSetupSectionDependencies :: Maybe Dependencies } deriving (Eq, Show, Generic)@@ -212,22 +165,28 @@ , librarySectionReexportedModules :: Maybe (List String) } deriving (Eq, Show, Generic) +emptyLibrarySection :: LibrarySection+emptyLibrarySection = LibrarySection Nothing Nothing Nothing Nothing+ instance HasFieldNames LibrarySection  instance FromJSON LibrarySection where   parseJSON = genericParseJSON_  data ExecutableSection = ExecutableSection {-  executableSectionMain :: FilePath+  executableSectionMain :: Maybe FilePath , executableSectionOtherModules :: Maybe (List String) } deriving (Eq, Show, Generic) +emptyExecutableSection :: ExecutableSection+emptyExecutableSection = ExecutableSection Nothing Nothing+ instance HasFieldNames ExecutableSection  instance FromJSON ExecutableSection where   parseJSON = genericParseJSON_ -data CommonOptions = CommonOptions {+data CommonOptions a capture cSources jsSources = CommonOptions {   commonOptionsSourceDirs :: Maybe (List FilePath) , commonOptionsDependencies :: Maybe Dependencies , commonOptionsDefaultExtensions :: Maybe (List String)@@ -237,8 +196,8 @@ , commonOptionsGhcjsOptions :: Maybe (List GhcjsOption) , commonOptionsCppOptions :: Maybe (List CppOption) , commonOptionsCcOptions :: Maybe (List CcOption)-, commonOptionsCSources :: Maybe (List FilePath)-, commonOptionsJsSources :: Maybe (List FilePath)+, commonOptionsCSources :: cSources+, commonOptionsJsSources :: jsSources , commonOptionsExtraLibDirs :: Maybe (List FilePath) , commonOptionsExtraLibraries :: Maybe (List FilePath) , commonOptionsExtraFrameworksDirs :: Maybe (List FilePath)@@ -247,19 +206,91 @@ , commonOptionsInstallIncludes :: Maybe (List FilePath) , commonOptionsLdOptions :: Maybe (List LdOption) , commonOptionsBuildable :: Maybe Bool-, commonOptionsWhen :: Maybe (List ConditionalSection)+, commonOptionsWhen :: Maybe (List (ConditionalSection a capture cSources jsSources)) , commonOptionsBuildTools :: Maybe Dependencies-} deriving (Eq, Show, Generic)+} deriving Generic -instance HasFieldNames CommonOptions+type ParseCommonOptions a = CommonOptions a CaptureUnknownFields ParseCSources ParseJsSources -instance FromJSON CommonOptions where+instance HasFieldNames (ParseCommonOptions a)++instance (FromJSON a, HasFieldNames a) => FromJSON (ParseCommonOptions a) where   parseJSON = genericParseJSON_ -data ConditionalSection = ThenElseConditional (CaptureUnknownFields ThenElse) | FlatConditional (CaptureUnknownFields (Section Condition))+type ParseCSources = Maybe (List FilePath)+type ParseJsSources = Maybe (List FilePath)++type CSources = [FilePath]+type JsSources = [FilePath]++type WithCommonOptions a capture cSources jsSources = Product (CommonOptions a capture cSources jsSources) a++data Traverse m capture capture_ cSources cSources_ jsSources jsSources_ = Traverse {+  traverseCapture :: forall a. capture a -> m (capture_ a)+, traverseCSources :: cSources -> m cSources_+, traverseJsSources :: jsSources -> m jsSources_+}++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)+traverseCommonOptions t@Traverse{..} c@CommonOptions{..} = do+  cSources <- traverseCSources commonOptionsCSources+  jsSources <- traverseJsSources commonOptionsJsSources+  xs <- traverse (traverse (traverseConditionalSection t)) commonOptionsWhen+  return c {+      commonOptionsCSources = cSources+    , commonOptionsJsSources = jsSources+    , commonOptionsWhen = xs+    }++traverseConditionalSection :: Traversal (ConditionalSection a)+traverseConditionalSection t@Traverse{..} = \ case+  ThenElseConditional c -> ThenElseConditional <$> (traverseCapture c >>= traverse (traverseThenElse t))+  FlatConditional c -> FlatConditional <$> (traverseCapture c >>= traverse (bitraverse (traverseWithCommonOptions t) return))++traverseThenElse :: Traversal (ThenElse a)+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 t = bitraverse (traverseCommonOptions t) return++data Product a b = Product a b   deriving (Eq, Show) -instance FromJSON ConditionalSection where+instance Bifunctor Product where+  bimap fa fb (Product a b) = Product (fa a) (fb b)++instance Bifoldable Product where+  bifoldMap = bifoldMapDefault++instance Bitraversable Product where+  bitraverse fa fb (Product a b) = Product <$> fa a <*> fb b++instance (FromJSON a, FromJSON b) => FromJSON (Product a b) where+  parseJSON value = Product <$> parseJSON value <*> parseJSON value++instance (HasFieldNames a, HasFieldNames b) => HasFieldNames (Product a b) where+  fieldNames Proxy =+       fieldNames (Proxy :: Proxy a)+    ++ fieldNames (Proxy :: Proxy b)+  ignoreUnderscoredUnknownFields Proxy =+       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))++type ParseConditionalSection a = ConditionalSection a CaptureUnknownFields ParseCSources ParseJsSources++instance (FromJSON a, HasFieldNames a) => FromJSON (ParseConditionalSection a) where   parseJSON v     | hasKey "then" v || hasKey "else" v = ThenElseConditional <$> parseJSON v     | otherwise = FlatConditional <$> parseJSON v@@ -277,18 +308,17 @@  instance HasFieldNames Condition -data ThenElse = ThenElse {+data ThenElse a capture cSources jsSources = ThenElse {   _thenElseCondition :: String-, _thenElseThen :: (CaptureUnknownFields (Section Empty))-, _thenElseElse :: (CaptureUnknownFields (Section Empty))-} deriving (Eq, Show, Generic)+, thenElseThen :: capture (WithCommonOptions a capture cSources jsSources)+, thenElseElse :: capture (WithCommonOptions a capture cSources jsSources)+} deriving Generic -instance FromJSON (CaptureUnknownFields ThenElse) where-  parseJSON = captureUnknownFields+type ParseThenElse a = ThenElse a CaptureUnknownFields ParseCSources ParseJsSources -instance HasFieldNames ThenElse+instance HasFieldNames (ParseThenElse a) -instance FromJSON ThenElse where+instance (FromJSON a, HasFieldNames a) => FromJSON (ParseThenElse a) where   parseJSON = genericParseJSON_  data Empty = Empty@@ -316,9 +346,9 @@     "Custom"    -> return Custom     _           -> fail "build-type must be one of: Simple, Configure, Make, Custom" -type ExecutableConfig = CaptureUnknownFields (Section ExecutableSection)+type SectionConfig a capture cSources jsSources = capture (WithCommonOptions a capture cSources jsSources) -data PackageConfig = PackageConfig {+data PackageConfig capture cSources jsSources = PackageConfig {   packageConfigName :: Maybe String , packageConfigVersion :: Maybe String , packageConfigSynopsis :: Maybe String@@ -334,26 +364,55 @@ , packageConfigLicense :: Maybe String , packageConfigLicenseFile :: Maybe (List String) , packageConfigTestedWith :: Maybe String-, packageConfigFlags :: Maybe (Map String (CaptureUnknownFields FlagSection))+, packageConfigFlags :: Maybe (Map String (capture FlagSection)) , packageConfigExtraSourceFiles :: Maybe (List FilePath) , packageConfigDataFiles :: Maybe (List FilePath) , packageConfigGithub :: Maybe Text , packageConfigGit :: Maybe String-, packageConfigCustomSetup :: Maybe (CaptureUnknownFields CustomSetupSection)-, packageConfigLibrary :: Maybe (CaptureUnknownFields (Section LibrarySection))-, packageConfigExecutable :: Maybe ExecutableConfig-, packageConfigExecutables :: Maybe (Map String ExecutableConfig)-, packageConfigTests :: Maybe (Map String (CaptureUnknownFields (Section ExecutableSection)))-, packageConfigBenchmarks :: Maybe (Map String (CaptureUnknownFields (Section ExecutableSection)))-} deriving (Eq, Show, Generic)+, 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))+} deriving Generic -instance HasFieldNames PackageConfig where+traversePackageConfig :: Traversal PackageConfig+traversePackageConfig t@Traverse{..} p@PackageConfig{..} = do+  flags <- traverse (traverse traverseCapture) packageConfigFlags+  customSetup <- traverse traverseCapture packageConfigCustomSetup+  library <- traverse (traverseSectionConfig t) packageConfigLibrary+  internalLibraries <- traverseNamedConfigs t packageConfigInternalLibraries+  executable <- traverse (traverseSectionConfig t) packageConfigExecutable+  executables <- traverseNamedConfigs t packageConfigExecutables+  tests <- traverseNamedConfigs t packageConfigTests+  benchmarks <- traverseNamedConfigs t packageConfigBenchmarks+  return p {+      packageConfigFlags = flags+    , packageConfigCustomSetup = customSetup+    , packageConfigLibrary = library+    , packageConfigInternalLibraries = internalLibraries+    , packageConfigExecutable = executable+    , packageConfigExecutables = executables+    , packageConfigTests = tests+    , packageConfigBenchmarks = benchmarks+    }+  where+    traverseNamedConfigs = traverse . traverse . traverseSectionConfig++traverseSectionConfig :: Traversal (SectionConfig p)+traverseSectionConfig t = traverseCapture t >=> traverse (traverseWithCommonOptions t)++type ParsePackageConfig = PackageConfig CaptureUnknownFields ParseCSources ParseJsSources++instance HasFieldNames ParsePackageConfig where   ignoreUnderscoredUnknownFields _ = True -instance FromJSON PackageConfig where+instance FromJSON ParsePackageConfig where   parseJSON value = handleNullValues <$> genericParseJSON_ value     where-      handleNullValues :: PackageConfig -> PackageConfig+      handleNullValues :: ParsePackageConfig -> ParsePackageConfig       handleNullValues =           ifNull "homepage" (\p -> p {packageConfigHomepage = Just Nothing})         . ifNull "bug-reports" (\p -> p {packageConfigBugReports = Just Nothing})@@ -377,7 +436,7 @@     Left err -> return (Left err)     Right config -> do       dir <- takeDirectory <$> canonicalizePath file-      Right <$> mkPackage dir config+      Right <$> toPackage dir config  data Package = Package {   packageName :: String@@ -401,9 +460,10 @@ , packageSourceRepository :: Maybe SourceRepository , packageCustomSetup :: Maybe CustomSetup , packageLibrary :: Maybe (Section Library)-, packageExecutables :: [Section Executable]-, packageTests :: [Section Executable]-, packageBenchmarks :: [Section Executable]+, packageInternalLibraries :: Map String (Section Library)+, packageExecutables :: Map String (Section Executable)+, packageTests :: Map String (Section Executable)+, packageBenchmarks :: Map String (Section Executable) } deriving (Eq, Show)  data CustomSetup = CustomSetup {@@ -418,8 +478,7 @@ } deriving (Eq, Show)  data Executable = Executable {-  executableName :: String-, executableMain :: FilePath+  executableMain :: Maybe FilePath , executableOtherModules :: [String] } deriving (Eq, Show) @@ -444,19 +503,15 @@ , sectionInstallIncludes :: [FilePath] , sectionLdOptions :: [LdOption] , sectionBuildable :: Maybe Bool-, sectionConditionals :: [Conditional]+, sectionConditionals :: [Conditional (Section a)] , sectionBuildTools :: Dependencies } deriving (Eq, Show, Functor, Foldable, Traversable) -data Conditional = Conditional {+data Conditional a = Conditional {   conditionalCondition :: String-, conditionalThen :: Section ()-, conditionalElse :: Maybe (Section ())-} deriving (Eq, Show)--instance HasFieldNames a => HasFieldNames (Section a) where-  fieldNames Proxy = fieldNames (Proxy :: Proxy a) ++ fieldNames (Proxy :: Proxy CommonOptions)-  ignoreUnderscoredUnknownFields _ = ignoreUnderscoredUnknownFields (Proxy :: Proxy a)+, conditionalThen :: a+, conditionalElse :: Maybe a+} deriving (Eq, Show, Functor, Foldable, Traversable)  data FlagSection = FlagSection {   _flagSectionDescription :: Maybe String@@ -484,39 +539,49 @@ , sourceRepositorySubdir :: Maybe String } deriving (Eq, Show) -mkPackage :: FilePath -> (CaptureUnknownFields (Section PackageConfig)) -> IO ([String], Package)-mkPackage dir (CaptureUnknownFields unknownFields globalOptions@Section{sectionData = PackageConfig{..}}) = do-  libraryResult <- mapM (toLibrary dir packageName_ globalOptions) mLibrarySection+type Config capture cSources jsSources =+  Product (CommonOptions Empty capture cSources jsSources) (PackageConfig capture cSources jsSources)++traverseConfig :: Traversal Config+traverseConfig t = bitraverse (traverseCommonOptions t) (traversePackageConfig t)++type ParseConfig = CaptureUnknownFields (Config CaptureUnknownFields ParseCSources ParseJsSources)++toPackage :: FilePath -> ParseConfig -> IO ([String], Package)+toPackage dir = runWriterT . (extractUnknownFieldWarnings >=> expandForeignSources dir) >=> toPackage_ dir++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+   let-    executableWarnings :: [String]-    executableSections :: [(String, Section ExecutableSection)]-    (executableWarnings, executableSections) = (warnings, map (fmap captureUnknownFieldsValue) sections)+    executableSections :: Map String (Section ExecutableSection)+    (executableWarning, executableSections) = (warning, sections)       where-        sections = case (packageConfigExecutable, packageConfigExecutables) of-          (Nothing, Nothing) -> []-          (Just executable, _) -> [(packageName_, executable)]-          (Nothing, Just executables) -> Map.toList executables+        sections :: Map String (Section ExecutableSection)+        sections = case mExecutable of+          Just executable -> Map.fromList [(packageName_, executable)]+          Nothing -> executables -        warnings = ignoringExecutablesWarning ++ unknownFieldWarnings-        ignoringExecutablesWarning = case (packageConfigExecutable, packageConfigExecutables) of-          (Just _, Just _) -> ["Ignoring field \"executables\" in favor of \"executable\""]+        warning = case mExecutable of+          Just _ | not (null executables) -> ["Ignoring field \"executables\" in favor of \"executable\""]           _ -> []-        unknownFieldWarnings = formatUnknownSectionFields (isJust packageConfigExecutables) "executable" sections -    mLibrary :: Maybe (Section Library)-    mLibrary = fmap snd libraryResult+        executables = toSections packageConfigExecutables -    libraryWarnings :: [String]-    libraryWarnings = maybe [] fst libraryResult+        mExecutable :: Maybe (Section ExecutableSection)+        mExecutable = toSectionI <$> packageConfigExecutable -  (executablesWarnings, executables) <- toExecutables dir packageName_ globalOptions executableSections-  (testsWarnings, tests) <- toExecutables dir packageName_ globalOptions (map (fmap captureUnknownFieldsValue) testsSections)-  (benchmarksWarnings, benchmarks) <- toExecutables dir packageName_ globalOptions  (map (fmap captureUnknownFieldsValue) benchmarkSections)+  internalLibraries <- toInternalLibraries dir packageName_ globalOptions internalLibrariesSections+  executables <- toExecutables dir packageName_ globalOptions executableSections+  tests <- toExecutables dir packageName_ globalOptions testSections+  benchmarks <- toExecutables dir packageName_ globalOptions benchmarkSections    licenseFileExists <- doesFileExist (dir </> "LICENSE")    missingSourceDirs <- nub . sort <$> filterM (fmap not <$> doesDirectoryExist . (dir </>)) (        maybe [] sectionSourceDirs mLibrary+    ++ concatMap sectionSourceDirs internalLibraries     ++ concatMap sectionSourceDirs executables     ++ concatMap sectionSourceDirs tests     ++ concatMap sectionSourceDirs benchmarks@@ -558,25 +623,17 @@       , packageSourceRepository = sourceRepository       , packageCustomSetup = mCustomSetup       , packageLibrary = mLibrary+      , packageInternalLibraries = internalLibraries       , packageExecutables = executables       , packageTests = tests       , packageBenchmarks = benchmarks       }        warnings =-           formatUnknownFields "package description" unknownFields+           packageWarnings         ++ nameWarnings-        ++ flagWarnings-        ++ maybe [] (formatUnknownFields "custom-setup section") (captureUnknownFieldsFields <$> packageConfigCustomSetup)-        ++ maybe [] (formatUnknownFields "library section") (captureUnknownFieldsFields <$> packageConfigLibrary)-        ++ formatUnknownSectionFields True "test" testsSections-        ++ formatUnknownSectionFields True "benchmark" benchmarkSections         ++ formatMissingSourceDirs missingSourceDirs-        ++ libraryWarnings-        ++ executableWarnings-        ++ executablesWarnings-        ++ testsWarnings-        ++ benchmarksWarnings+        ++ executableWarning         ++ extraSourceFilesWarnings         ++ dataFilesWarnings @@ -590,44 +647,27 @@       Just n -> ([], n)      mCustomSetup :: Maybe CustomSetup-    mCustomSetup = toCustomSetup <$> mCustomSetupSection--    testsSections :: [(String, CaptureUnknownFields (Section ExecutableSection))]-    testsSections = toList packageConfigTests--    benchmarkSections :: [(String, CaptureUnknownFields (Section ExecutableSection))]-    benchmarkSections = toList packageConfigBenchmarks+    mCustomSetup = toCustomSetup . runIdentity <$> packageConfigCustomSetup -    (flagWarnings, flags) = (concatMap formatUnknownFlagFields xs, map (toFlag . fmap captureUnknownFieldsValue) xs)-      where-        xs :: [(String, CaptureUnknownFields FlagSection)]-        xs = toList packageConfigFlags+    mLibrarySection :: Maybe (Section LibrarySection)+    mLibrarySection = toSectionI <$> packageConfigLibrary -        formatUnknownFlagFields :: (String, CaptureUnknownFields a) -> [String]-        formatUnknownFlagFields (name, fields) = map f (captureUnknownFieldsFields fields)-          where f field = "Ignoring unknown field " ++ show field ++ " for flag " ++ show name+    toSections :: Maybe (Map String (Identity (WithCommonOptions a Identity CSources JsSources))) -> Map String (Section a)+    toSections = fmap toSectionI . fromMaybe mempty -    toList :: Maybe (Map String a) -> [(String, a)]-    toList = Map.toList . fromMaybe mempty+    internalLibrariesSections :: Map String (Section LibrarySection)+    internalLibrariesSections = toSections packageConfigInternalLibraries -    mCustomSetupSection :: Maybe CustomSetupSection-    mCustomSetupSection = captureUnknownFieldsValue <$> packageConfigCustomSetup+    testSections :: Map String (Section ExecutableSection)+    testSections = toSections packageConfigTests -    mLibrarySection :: Maybe (Section LibrarySection)-    mLibrarySection = captureUnknownFieldsValue <$> packageConfigLibrary+    benchmarkSections :: Map String (Section ExecutableSection)+    benchmarkSections = toSections packageConfigBenchmarks -    formatUnknownFields :: String -> [FieldName] -> [String]-    formatUnknownFields name = map f . sort-      where-        f field = "Ignoring unknown field " ++ show field ++ " in " ++ name+    flags = map (toFlag . fmap runIdentity) $ toList packageConfigFlags -    formatUnknownSectionFields :: Bool -> String -> [(String, CaptureUnknownFields a)] -> [String]-    formatUnknownSectionFields showSect sectionType = concatMap f . map (fmap captureUnknownFieldsFields)-      where-        f :: (String, [String]) -> [String]-        f (sect, fields) = formatUnknownFields-          (sectionType ++ " section" ++ if showSect then " " ++ show sect else "")-          fields+    toList :: Maybe (Map String a) -> [(String, a)]+    toList = Map.toList . fromMaybe mempty      formatMissingSourceDirs = map f       where@@ -659,73 +699,173 @@       where         fromGithub = (++ "/issues") . sourceRepositoryUrl <$> github -expandCSources :: FilePath -> Section a -> IO ([String], Section a)-expandCSources dir sect@Section{..} = do-  (warnings, files) <- expandGlobs "c-sources" dir sectionCSources-  return (warnings, sect {sectionCSources = files})+type Warnings m = WriterT [String] m -expandJsSources :: FilePath -> Section a -> IO ([String], Section a)-expandJsSources dir sect@Section{..} = do-  (warnings, files) <- expandGlobs "js-sources" dir sectionJsSources-  return (warnings, sect {sectionJsSources = files})+extractUnknownFieldWarnings :: forall m. Monad m => ParseConfig -> Warnings m (Config Identity ParseCSources ParseJsSources)+extractUnknownFieldWarnings = warnGlobal >=> bitraverse return warnSections+  where+    t :: Monad capture => Traverse capture capture Identity cSources cSources jsSources jsSources+    t = Traverse (fmap Identity) return return -expandForeignSources :: FilePath -> Section a -> IO ([String], Section a)-expandForeignSources dir sect = do-  (cWarnings, sect_) <- expandCSources dir sect-  (jsWarnings, sect__) <- expandJsSources dir sect_-  return (cWarnings ++ jsWarnings, sect__)+    warnGlobal c = warnUnknownFields In "package description" (c >>= bitraverse (traverseCommonOptions t) return) +    warnSections :: ParsePackageConfig -> Warnings m (PackageConfig 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)+      internalLibraries <- warnNamedSection "internal-libraries" packageConfigInternalLibraries+      executable <- warnUnknownFields In "executable section" (traverse (traverseSectionConfig t) packageConfigExecutable)+      executables <- warnNamedSection "executable" packageConfigExecutables+      tests <- warnNamedSection "test" packageConfigTests+      benchmarks <- warnNamedSection "benchmark" packageConfigBenchmarks+      return p {+          packageConfigFlags = flags+        , packageConfigCustomSetup = customSetup+        , packageConfigLibrary = library+        , packageConfigInternalLibraries = internalLibraries+        , packageConfigExecutable = executable+        , packageConfigExecutables = executables+        , packageConfigTests = tests+        , packageConfigBenchmarks = benchmarks+        }++    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))++    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++expandForeignSources+  :: FilePath+  -> Config Identity ParseCSources ParseJsSources+  -> Warnings IO (Config Identity CSources JsSources)+expandForeignSources dir = traverseConfig t+  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+ toCustomSetup :: CustomSetupSection -> CustomSetup toCustomSetup CustomSetupSection{..} = CustomSetup   { customSetupDependencies = fromMaybe mempty customSetupSectionDependencies } -toLibrary :: FilePath -> String -> Section global -> Section LibrarySection -> IO ([String], Section Library)-toLibrary dir name globalOptions library = traverse fromLibrarySection sect >>= expandForeignSources dir+traverseSectionAndConditionals :: Applicative m => (Section a -> m b) -> (Section a -> m b) -> Section a -> m (Section b)+traverseSectionAndConditionals fData fConditionals sect@Section{..} =+  update <$> fData sect <*> traverseConditionals sectionConditionals   where-    sect :: Section LibrarySection-    sect = mergeSections globalOptions library--    sourceDirs :: [FilePath]-    sourceDirs = sectionSourceDirs sect+    update x xs = sect{sectionData = x, sectionConditionals = xs}+    traverseConditionals = traverse $ traverse $ traverseSectionAndConditionals fConditionals fConditionals -    fromLibrarySection :: LibrarySection -> IO Library-    fromLibrarySection LibrarySection{..} = do-      modules <- concat <$> mapM (getModules dir) sourceDirs-      let (exposedModules, otherModules) = determineModules name modules librarySectionExposedModules librarySectionOtherModules-          reexportedModules = fromMaybeList librarySectionReexportedModules-      return (Library librarySectionExposed exposedModules otherModules reexportedModules)+getMentionedLibraryModules :: Section LibrarySection -> [String]+getMentionedLibraryModules = concatMap $ \ LibrarySection{..} ->+  fromMaybeList librarySectionExposedModules ++ fromMaybeList librarySectionOtherModules -toExecutables :: FilePath -> String -> Section global -> [(String, Section ExecutableSection)] -> IO ([String], [Section Executable])-toExecutables dir packageName_ globalOptions executables = do-  result <- mapM toExecutable sections >>= mapM (expandForeignSources dir)-  let (warnings, xs) = unzip result-  return (concat warnings, xs)+toLibrary :: FilePath -> String -> Section global -> Section LibrarySection -> IO (Section Library)+toLibrary dir name globalOptions =+    traverseSectionAndConditionals (fromLibrarySection True) (fromLibrarySection False)+  . mergeSections emptyLibrarySection globalOptions   where-    sections :: [(String, Section ExecutableSection)]-    sections = map (fmap $ mergeSections globalOptions) executables+    fromLibrarySection topLevel sect@Section{..} = do+      modules <- concat <$> mapM (getModules dir) sectionSourceDirs+      let+        mentionedModules = getMentionedLibraryModules sect+        inferableModules = modules \\ mentionedModules+      return $ action inferableModules sectionData+      where+        action+          | topLevel = fromLibrarySectionTopLevel+          | otherwise = fromLibrarySectionInConditional -    toExecutable :: (String, Section ExecutableSection) -> IO (Section Executable)-    toExecutable (name, sect@Section{..}) = do-      (executable, ghcOptions) <- fromExecutableSection sectionData-      return (sect {sectionData = executable, sectionGhcOptions = sectionGhcOptions ++ ghcOptions})+    fromLibrarySectionTopLevel inferableModules LibrarySection{..} =+      Library librarySectionExposed exposedModules otherModules reexportedModules       where-        fromExecutableSection :: ExecutableSection -> IO (Executable, [GhcOption])-        fromExecutableSection ExecutableSection{..} = do-          modules <- maybe inferModules (return . fromList) executableSectionOtherModules-          return (Executable name mainSrcFile modules, ghcOptions)-          where-            inferModules :: IO [String]-            inferModules = filterMain . (++ [pathsModule]) . concat <$> mapM (getModules dir) sectionSourceDirs+        (exposedModules, otherModules) =+          determineModules name inferableModules librarySectionExposedModules librarySectionOtherModules+        reexportedModules = fromMaybeList librarySectionReexportedModules -            pathsModule = pathsModuleFromPackageName packageName_+fromLibrarySectionInConditional :: [String] -> LibrarySection -> Library+fromLibrarySectionInConditional inferableModules lib@(LibrarySection _ exposedModules otherModules _) = do+  case (exposedModules, otherModules) of+    (Nothing, Nothing) -> (fromLibrarySectionPlain lib) {libraryOtherModules = inferableModules}+    _ -> fromLibrarySectionPlain lib -            filterMain :: [String] -> [String]-            filterMain = maybe id (filter . (/=)) (toModule $ splitDirectories executableSectionMain)+fromLibrarySectionPlain :: LibrarySection -> Library+fromLibrarySectionPlain LibrarySection{..} = Library {+    libraryExposed = librarySectionExposed+  , libraryExposedModules = fromMaybeList librarySectionExposedModules+  , libraryOtherModules = fromMaybeList librarySectionOtherModules+  , libraryReexportedModules = fromMaybeList librarySectionReexportedModules+  } -            (mainSrcFile, ghcOptions) = parseMain executableSectionMain+toInternalLibraries :: FilePath -> String -> Section global -> Map String (Section LibrarySection) -> IO (Map String (Section Library))+toInternalLibraries dir packageName_ globalOptions = traverse (toLibrary dir packageName_ globalOptions) -mergeSections :: Section global -> Section a -> Section a-mergeSections globalOptions options+toExecutables :: FilePath -> String -> Section global -> Map String (Section ExecutableSection) -> IO (Map String (Section Executable))+toExecutables dir packageName_ globalOptions = traverse (toExecutable dir packageName_ globalOptions)++getMentionedExecutableModules :: Section ExecutableSection -> [String]+getMentionedExecutableModules = concatMap $ \ ExecutableSection{..} ->+  fromMaybeList executableSectionOtherModules ++ maybe [] return (executableSectionMain >>= toModule . splitDirectories)++toExecutable :: FilePath -> String -> Section global -> Section ExecutableSection -> IO (Section Executable)+toExecutable dir packageName_ globalOptions =+    traverseSectionAndConditionals (fromExecutableSection True) (fromExecutableSection False)+  . expandMain+  . mergeSections emptyExecutableSection globalOptions+  where+    fromExecutableSection :: Bool -> Section ExecutableSection -> IO Executable+    fromExecutableSection inferPathsModule sect@Section{sectionData = ExecutableSection main_ otherModules, ..} = do+      modules <- maybe inferModules (return . fromList) otherModules+      return (Executable main_ modules)+      where+        mentionedModules = getMentionedExecutableModules sect++        inferModules :: IO [String]+        inferModules+          | null sectionSourceDirs = return []+          | otherwise = (\\ mentionedModules) . (++ pathsModule) . concat <$> mapM (getModules dir) sectionSourceDirs++        pathsModule = case inferPathsModule of+          True -> [pathsModuleFromPackageName packageName_]+          False -> []++expandMain :: Section ExecutableSection -> Section ExecutableSection+expandMain = flatten . expand+  where+    expand :: Section ExecutableSection -> Section ([GhcOption], ExecutableSection)+    expand = fmap go+      where+        go exec@ExecutableSection{..} =+          let+            (mainSrcFile, ghcOptions) = maybe (Nothing, []) (first Just . parseMain) executableSectionMain+          in+            (ghcOptions, exec{executableSectionMain = mainSrcFile})++    flatten :: Section ([GhcOption], ExecutableSection) -> Section ExecutableSection+    flatten sect@Section{sectionData = (ghcOptions, exec), ..} = sect{+        sectionData = exec+      , sectionGhcOptions = sectionGhcOptions ++ ghcOptions+      , 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@@ -747,14 +887,15 @@   , sectionLdOptions = sectionLdOptions globalOptions ++ sectionLdOptions options   , sectionBuildable = sectionBuildable options <|> sectionBuildable globalOptions   , sectionDependencies = sectionDependencies options <> sectionDependencies globalOptions-  , sectionConditionals = sectionConditionals globalOptions ++ sectionConditionals options+  , sectionConditionals = map (fmap (a <$)) (sectionConditionals globalOptions) ++ sectionConditionals options   , sectionBuildTools = sectionBuildTools options <> sectionBuildTools globalOptions   } -toSection :: a -> CommonOptions -> ([FieldName], Section a)-toSection a CommonOptions{..}-  = ( concat unknownFields-    , Section {+toSectionI :: Identity (WithCommonOptions a Identity CSources JsSources) -> Section a+toSectionI = toSection . runIdentity++toSection :: WithCommonOptions a Identity CSources JsSources -> Section a+toSection (Product CommonOptions{..} a) = Section {         sectionData = a       , sectionSourceDirs = fromMaybeList commonOptionsSourceDirs       , sectionDefaultExtensions = fromMaybeList commonOptionsDefaultExtensions@@ -764,8 +905,8 @@       , sectionGhcjsOptions = fromMaybeList commonOptionsGhcjsOptions       , sectionCppOptions = fromMaybeList commonOptionsCppOptions       , sectionCcOptions = fromMaybeList commonOptionsCcOptions-      , sectionCSources = fromMaybeList commonOptionsCSources-      , sectionJsSources = fromMaybeList commonOptionsJsSources+      , sectionCSources = commonOptionsCSources+      , sectionJsSources = commonOptionsJsSources       , sectionExtraLibDirs = fromMaybeList commonOptionsExtraLibDirs       , sectionExtraLibraries = fromMaybeList commonOptionsExtraLibraries       , sectionExtraFrameworksDirs = fromMaybeList commonOptionsExtraFrameworksDirs@@ -778,15 +919,13 @@       , sectionConditionals = conditionals       , sectionBuildTools = fromMaybe mempty commonOptionsBuildTools       }-    )   where-    (unknownFields, conditionals) = unzip (map toConditional $ fromMaybeList commonOptionsWhen)+    conditionals = map toConditional (fromMaybeList commonOptionsWhen) -toConditional :: ConditionalSection -> ([FieldName], Conditional)-toConditional x = case x of-  ThenElseConditional (CaptureUnknownFields fields (ThenElse condition (CaptureUnknownFields fieldsThen then_) (CaptureUnknownFields fieldsElse else_))) ->-      (fields ++ fieldsThen ++ fieldsElse, Conditional condition (() <$ then_) (Just (() <$ else_)))-  FlatConditional (CaptureUnknownFields fields sect) -> (fields, Conditional (conditionCondition $ sectionData sect) (() <$ sect) Nothing)+    toConditional :: ConditionalSection a Identity CSources JsSources -> 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_)  pathsModuleFromPackageName :: String -> String pathsModuleFromPackageName name = "Paths_" ++ map f name

@@ -11,9 +11,6 @@ , githubBaseUrl ) where -import           Prelude ()-import           Prelude.Compat- import qualified Data.Text as T import           Text.PrettyPrint (renderStyle, Style(..), Mode(..)) import           Control.Monad

@@ -15,16 +15,12 @@ #endif ) where -import           Prelude ()-import           Prelude.Compat- import           Data.Char import           Data.Maybe-import           Data.List.Compat+import           Data.List import           Control.Applicative  import           Hpack.Render--- import           Hpack.Util  data FormattingHints = FormattingHints {   formattingHintsFieldOrder :: [String]

@@ -1,8 +1,5 @@ module Hpack.Options where -import           Prelude ()-import           Prelude.Compat- data ParseResult = Help | PrintVersion | Run Options | ParseError   deriving (Eq, Show) 

@@ -24,11 +24,8 @@ #endif ) where -import           Prelude ()-import           Prelude.Compat- import           Data.String-import           Data.List.Compat+import           Data.List  data Value =     Literal String

@@ -12,6 +12,8 @@ , defaultRenderSettings #ifdef TEST , renderConditional+, renderLibraryFields+, renderExecutableFields , renderFlag , renderSourceRepository , renderDirectories@@ -19,15 +21,13 @@ #endif ) where -import           Prelude ()-import           Prelude.Compat- import           Control.Monad import           Data.Char import           Data.Maybe-import           Data.List.Compat-import           System.Exit.Compat+import           Data.List+import           System.Exit import           System.FilePath+import           Data.Map.Lazy (Map) import qualified Data.Map.Lazy as Map  import           Hpack.Util@@ -88,6 +88,7 @@         customSetup       , map renderFlag packageFlags       , library+      , renderInternalLibraries packageInternalLibraries       , renderExecutables packageExecutables       , renderTests packageTests       , renderBenchmarks packageBenchmarks@@ -123,15 +124,25 @@     cabalVersion :: Maybe String     cabalVersion = maximum [         Just ">= 1.10"-      , packageLibrary >>= libCabalVersion+      , packageCabalVersion+      , packageLibrary >>= libraryCabalVersion+      , internalLibsCabalVersion packageInternalLibraries       ]      where-      libCabalVersion :: Section Library -> Maybe String-      libCabalVersion sect = ">= 1.21" <$ guard (hasReexportedModules sect)+      packageCabalVersion :: Maybe String+      packageCabalVersion+        | isJust packageCustomSetup = Just ">= 1.24"+        | otherwise = Nothing +      libraryCabalVersion :: Section Library -> Maybe String+      libraryCabalVersion sect = ">= 1.22" <$ guard (hasReexportedModules sect)+       hasReexportedModules :: Section Library -> Bool       hasReexportedModules = not . null . libraryReexportedModules . sectionData +      internalLibsCabalVersion :: Map String (Section Library) -> Maybe String+      internalLibsCabalVersion internalLibraries = ">= 2.0" <$ guard (not (Map.null internalLibraries))+ sortSectionFields :: [(String, [String])] -> [Element] -> [Element] sortSectionFields sectionsFieldOrder = go   where@@ -169,34 +180,43 @@   where     description = maybe [] (return . Field "description" . Literal) flagDescription -renderExecutables :: [Section Executable] -> [Element]-renderExecutables = map renderExecutable+renderInternalLibraries :: Map String (Section Library) -> [Element]+renderInternalLibraries = map renderInternalLibrary . Map.toList -renderExecutable :: Section Executable -> Element-renderExecutable sect@(sectionData -> Executable{..}) =-  Stanza ("executable " ++ executableName) (renderExecutableSection sect)+renderInternalLibrary :: (String, Section Library) -> Element+renderInternalLibrary (name, sect) =+  Stanza ("library " ++ name) (renderLibrarySection sect) -renderTests :: [Section Executable] -> [Element]-renderTests = map renderTest+renderExecutables :: Map String (Section Executable) -> [Element]+renderExecutables = map renderExecutable . Map.toList -renderTest :: Section Executable -> Element-renderTest sect@(sectionData -> Executable{..}) =-  Stanza ("test-suite " ++ executableName)+renderExecutable :: (String, Section Executable) -> Element+renderExecutable (name, sect@(sectionData -> Executable{..})) =+  Stanza ("executable " ++ name) (renderExecutableSection sect)++renderTests :: Map String (Section Executable) -> [Element]+renderTests = map renderTest . Map.toList++renderTest :: (String, Section Executable) -> Element+renderTest (name, sect) =+  Stanza ("test-suite " ++ name)     (Field "type" "exitcode-stdio-1.0" : renderExecutableSection sect) -renderBenchmarks :: [Section Executable] -> [Element]-renderBenchmarks = map renderBenchmark+renderBenchmarks :: Map String (Section Executable) -> [Element]+renderBenchmarks = map renderBenchmark . Map.toList -renderBenchmark :: Section Executable -> Element-renderBenchmark sect@(sectionData -> Executable{..}) =-  Stanza ("benchmark " ++ executableName)+renderBenchmark :: (String, Section Executable) -> Element+renderBenchmark (name, sect) =+  Stanza ("benchmark " ++ name)     (Field "type" "exitcode-stdio-1.0" : renderExecutableSection sect)  renderExecutableSection :: Section Executable -> [Element]-renderExecutableSection sect@(sectionData -> Executable{..}) =-  mainIs : renderSection sect ++ [otherModules, defaultLanguage]+renderExecutableSection sect = renderSection renderExecutableFields sect ++ [defaultLanguage]++renderExecutableFields :: Executable -> [Element]+renderExecutableFields Executable{..} = mainIs ++ [otherModules]   where-    mainIs = Field "main-is" (Literal executableMain)+    mainIs = maybe [] (return . Field "main-is" . Literal) executableMain     otherModules = renderOtherModules executableOtherModules  renderCustomSetup :: CustomSetup -> Element@@ -204,20 +224,25 @@   Stanza "custom-setup" [renderDependencies "setup-depends" customSetupDependencies]  renderLibrary :: Section Library -> Element-renderLibrary sect@(sectionData -> Library{..}) = Stanza "library" $-  renderSection sect +++renderLibrary sect = Stanza "library" $ renderLibrarySection sect++renderLibrarySection :: Section Library -> [Element]+renderLibrarySection sect = renderSection renderLibraryFields sect ++ [defaultLanguage]++renderLibraryFields :: Library -> [Element]+renderLibraryFields Library{..} =   maybe [] (return . renderExposed) libraryExposed ++ [     renderExposedModules libraryExposedModules   , renderOtherModules libraryOtherModules   , renderReexportedModules libraryReexportedModules-  , defaultLanguage   ]  renderExposed :: Bool -> Element renderExposed = Field "exposed" . Literal . show -renderSection :: Section a -> [Element]-renderSection Section{..} = [+renderSection :: (a -> [Element]) -> Section a -> [Element]+renderSection renderSectionData Section{..} =+  renderSectionData sectionData ++ [     renderDirectories "hs-source-dirs" sectionSourceDirs   , renderDefaultExtensions sectionDefaultExtensions   , renderOtherExtensions sectionOtherExtensions@@ -239,14 +264,14 @@   , renderDependencies "build-tools" sectionBuildTools   ]   ++ maybe [] (return . renderBuildable) sectionBuildable-  ++ map renderConditional sectionConditionals+  ++ map (renderConditional renderSectionData) sectionConditionals -renderConditional :: Conditional -> Element-renderConditional (Conditional condition sect mElse) = case mElse of+renderConditional :: (a -> [Element]) -> Conditional (Section a) -> Element+renderConditional renderSectionData (Conditional condition sect mElse) = case mElse of   Nothing -> if_-  Just else_ -> Group if_ (Stanza "else" $ renderSection else_)+  Just else_ -> Group if_ (Stanza "else" $ renderSection renderSectionData else_)   where-    if_ = Stanza ("if " ++ condition) (renderSection sect)+    if_ = Stanza ("if " ++ condition) (renderSection renderSectionData sect)  defaultLanguage :: Element defaultLanguage = Field "default-language" "Haskell2010"

@@ -0,0 +1,92 @@+{-# 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

@@ -0,0 +1,61 @@+module Hpack.Utf8 (+  encodeUtf8+, readFile+, writeFile+, putStr+, hPutStr+, hPutStrLn+) where++import           Prelude hiding (readFile, writeFile, putStr)++import qualified Data.Text as T+import qualified Data.Text.Encoding as Encoding+import           Data.Text.Encoding.Error (lenientDecode)+import qualified Data.ByteString as B+import           System.IO (Handle, stdout, IOMode(..), withFile, Newline(..), nativeNewline)++encodeUtf8 :: String -> B.ByteString+encodeUtf8 = Encoding.encodeUtf8 . T.pack++decodeUtf8 :: B.ByteString -> String+decodeUtf8 = T.unpack . Encoding.decodeUtf8With lenientDecode++encodeText :: String -> B.ByteString+encodeText = encodeUtf8 . encodeNewlines++decodeText :: B.ByteString -> String+decodeText = decodeNewlines . decodeUtf8++encodeNewlines :: String -> String+encodeNewlines = case nativeNewline of+  LF -> id+  CRLF -> go+    where+      go xs = case xs of+        '\n' : ys -> '\r' : '\n' : ys+        y : ys -> y : go ys+        [] -> []++decodeNewlines :: String -> String+decodeNewlines = go+  where+    go xs = case xs of+      '\r' : '\n' : ys -> '\n' : go ys+      y : ys -> y : go ys+      [] -> []++readFile :: FilePath -> IO String+readFile = fmap decodeText . B.readFile++writeFile :: FilePath -> String -> IO ()+writeFile name xs = withFile name WriteMode (`hPutStr` xs)++putStr :: String -> IO ()+putStr = hPutStr stdout++hPutStrLn :: Handle -> String -> IO ()+hPutStrLn h xs = hPutStr h xs >> hPutStr h "\n"++hPutStr :: Handle -> String -> IO ()+hPutStr h = B.hPutStr h . encodeText

@@ -1,5 +1,7 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-} module Hpack.Util (   List(..) , GhcOption@@ -15,25 +17,16 @@ , expandGlobs , sort , lexicographically-, encodeUtf8 , Hash , sha256 ) where -import           Prelude ()-import           Prelude.Compat- import           Control.Exception-import           Control.Monad.Compat+import           Control.Monad import           Data.Aeson.Types-import qualified Data.ByteString as B import           Data.Char-import           Data.Data-import           Data.List.Compat hiding (sort)+import           Data.List hiding (sort) import           Data.Ord-import qualified Data.Text as T-import qualified Data.Text.Encoding as Encoding-import           Data.Text.Encoding.Error (lenientDecode) import           System.IO.Error import           System.Directory import           System.FilePath@@ -42,6 +35,7 @@ import           Crypto.Hash  import           Hpack.Haskell+import           Hpack.Utf8 as Utf8  sort :: [String] -> [String] sort = sortBy (comparing lexicographically)@@ -50,7 +44,7 @@ lexicographically x = (map toLower x, x)  newtype List a = List {fromList :: [a]}-  deriving (Eq, Show, Data, Typeable)+  deriving (Eq, Show, Functor, Foldable, Traversable)  instance FromJSON a => FromJSON (List a) where   parseJSON v = List <$> case v of@@ -113,8 +107,8 @@  tryReadFile :: FilePath -> IO (Maybe String) tryReadFile file = do-  r <- tryJust (guard . isDoesNotExistError) (B.readFile file)-  return $ either (const Nothing) (Just . T.unpack . Encoding.decodeUtf8With lenientDecode) r+  r <- tryJust (guard . isDoesNotExistError) (Utf8.readFile file)+  return $ either (const Nothing) Just r  toPosixFilePath :: FilePath -> FilePath toPosixFilePath = Posix.joinPath . splitDirectories@@ -154,10 +148,7 @@       , errorRecovery = True       } -encodeUtf8 :: String -> B.ByteString-encodeUtf8 = Encoding.encodeUtf8 . T.pack- type Hash = String  sha256 :: String -> Hash-sha256 c = show (hash (encodeUtf8 c) :: Digest SHA256)+sha256 c = show (hash (Utf8.encodeUtf8 c) :: Digest SHA256)

@@ -0,0 +1,737 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ConstraintKinds #-}+module EndToEndSpec (spec) where++import           Helper++import           System.Exit+import           Data.Maybe+import           Data.List+import           Data.String.Interpolate+import           Data.String.Interpolate.Util++import qualified Hpack.Run as Hpack+import           Hpack.Config (packageConfig, readPackageConfig)+import           Hpack.FormattingHints (FormattingHints(..), sniffFormattingHints)++spec :: Spec+spec = around_ (inTempDirectoryNamed "foo") $ do+  describe "hpack" $ do+    describe "dependencies" $ do+      it "accepts single dependency" $ do+        [i|+        executable:+          dependencies: base+        |] `shouldRenderTo` executable "foo" [i|+        build-depends:+            base+        |]++      it "accepts list of dependencies" $ do+        [i|+        executable:+          dependencies:+            - base+            - transformers+        |] `shouldRenderTo` executable "foo" [i|+        build-depends:+            base+          , transformers+        |]++      context "with both global and section specific dependencies" $ do+        it "combines dependencies" $ do+          [i|+          dependencies:+            - base+          executable:+            dependencies: hspec+          |] `shouldRenderTo` executable "foo" [i|+          build-depends:+              base+            , hspec+          |]++        it "gives section specific dependencies precedence" $ do+          [i|+          dependencies:+            - base+          executable:+            dependencies: base >= 2+          |] `shouldRenderTo` executable "foo" [i|+          build-depends:+              base >=2+          |]++    describe "include-dirs" $ do+      it "accepts include-dirs" $ do+        [i|+        include-dirs:+          - foo+          - bar+        executable: {}+        |] `shouldRenderTo` executable "foo" [i|+        include-dirs:+            foo+            bar+        |]++    describe "install-includes" $ do+      it "accepts install-includes" $ do+        [i|+        install-includes:+          - foo.h+          - bar.h+        executable: {}+        |] `shouldRenderTo` executable "foo" [i|+        install-includes:+            foo.h+            bar.h+        |]++    describe "js-sources" $ before_ (touch "foo.js" >> touch "jsbits/bar.js") $ do+      it "accepts js-sources" $ do+        [i|+        executable:+          js-sources:+            - foo.js+            - jsbits/*.js+        |] `shouldRenderTo` executable "foo" [i|+        js-sources:+            foo.js+            jsbits/bar.js+        |]++      it "accepts global js-sources" $ do+        [i|+        js-sources:+          - foo.js+          - jsbits/*.js+        executable: {}+        |] `shouldRenderTo` executable "foo" [i|+        js-sources:+            foo.js+            jsbits/bar.js+        |]+    describe "extra-lib-dirs" $ do+      it "accepts extra-lib-dirs" $ do+        [i|+        extra-lib-dirs:+          - foo+          - bar+        executable: {}+        |] `shouldRenderTo` executable "foo" [i|+        extra-lib-dirs:+            foo+            bar+        |]++    describe "extra-libraries" $ do+      it "accepts extra-libraries" $ do+        [i|+        extra-libraries:+          - foo+          - bar+        executable: {}+        |] `shouldRenderTo` executable "foo" [i|+        extra-libraries:+            foo+            bar+        |]++    describe "extra-frameworks-dirs" $ do+      it "accepts extra-frameworks-dirs" $ do+        [i|+        extra-frameworks-dirs:+          - foo+          - bar+        executable: {}+        |] `shouldRenderTo` executable "foo" [i|+        extra-frameworks-dirs:+            foo+            bar+        |]++    describe "frameworks" $ do+      it "accepts frameworks" $ do+        [i|+        frameworks:+          - foo+          - bar+        executable: {}+        |] `shouldRenderTo` executable "foo" [i|+        frameworks:+            foo+            bar+        |]++    describe "c-sources" $ before_ (touch "cbits/foo.c" >> touch "cbits/bar.c") $ do+      context "with internal-libraries" $ do+        it "warns when a glob pattern does not match any files" $ do+          [i|+          name: foo+          internal-libraries:+            bar:+              c-sources: foo/*.c+          |] `shouldWarn` pure "Specified pattern \"foo/*.c\" for c-sources does not match any files"++      context "with library" $ do+        it "accepts global c-sources" $ do+          [i|+          c-sources: cbits/*.c+          library: {}+          |] `shouldRenderTo` library [i|+          other-modules:+              Paths_foo+          c-sources:+              cbits/bar.c+              cbits/foo.c+          |]++        it "accepts c-sources" $ do+          [i|+          library:+            c-sources: cbits/*.c+          |] `shouldRenderTo` library [i|+          other-modules:+              Paths_foo+          c-sources:+              cbits/bar.c+              cbits/foo.c+          |]++        it "accepts c-sources in conditional" $ do+          [i|+          library:+            when:+              condition: os(windows)+              c-sources: cbits/*.c+          |] `shouldRenderTo` library [i|+          other-modules:+              Paths_foo+          if os(windows)+            c-sources:+                cbits/bar.c+                cbits/foo.c+          |]++      context "with executables" $ do+        it "accepts global c-sources" $ do+          [i|+          c-sources: cbits/*.c+          executables:+            foo: {}+          |] `shouldRenderTo` executable "foo" [i|+          c-sources:+              cbits/bar.c+              cbits/foo.c+          |]++        it "accepts c-sources" $ do+          [i|+          executables:+            foo:+              c-sources: cbits/*.c+          |] `shouldRenderTo` executable "foo" [i|+          c-sources:+              cbits/bar.c+              cbits/foo.c+          |]++    context "with custom-setup" $ do+      it "warns on unknown fields" $ do+        [i|+        name: foo+        custom-setup:+          foo: 1+          bar: 2+        |] `shouldWarn` [+            "Ignoring unknown field \"bar\" in custom-setup section"+          , "Ignoring unknown field \"foo\" in custom-setup section"+          ]++      it "accepts dependencies" $ do+        [i|+        custom-setup:+          dependencies:+            - base+        |] `shouldRenderTo` customSetup [i|+        setup-depends:+            base+        |]++      it "leaves build-type alone, if it exists" $ do+        [i|+        build-type: Make+        custom-setup:+          dependencies:+            - base+        |] `shouldRenderTo` (customSetup [i|+        setup-depends:+            base+        |]) {packageBuildType = "Make"}++    context "with library" $ do+      it "accepts reexported-modules" $ do+        [i|+        library:+          reexported-modules: Baz+        |] `shouldRenderTo` (library [i|+        reexported-modules:+            Baz+        other-modules:+            Paths_foo+        |]) {packageCabalVersion = ">= 1.22"}++      context "when inferring modules" $ do+        context "with exposed-modules" $ do+          it "infers other-modules" $ do+            touch "src/Foo.hs"+            touch "src/Bar.hs"+            [i|+            library:+              source-dirs: src+              exposed-modules: Foo+            |] `shouldRenderTo` library [i|+            hs-source-dirs:+                src+            exposed-modules:+                Foo+            other-modules:+                Bar+                Paths_foo+            |]++        context "with other-modules" $ do+          it "infers exposed-modules" $ do+            touch "src/Foo.hs"+            touch "src/Bar.hs"+            [i|+            library:+              source-dirs: src+              other-modules: Bar+            |] `shouldRenderTo` library [i|+            hs-source-dirs:+                src+            exposed-modules:+                Foo+            other-modules:+                Bar+            |]++        context "with both exposed-modules and other-modules" $ do+          it "doesn't infer any modules" $ do+            touch "src/Foo.hs"+            touch "src/Bar.hs"+            [i|+            library:+              source-dirs: src+              exposed-modules: Foo+              other-modules: Bar+            |] `shouldRenderTo` library [i|+            hs-source-dirs:+                src+            exposed-modules:+                Foo+            other-modules:+                Bar+            |]++        context "with neither exposed-modules nor other-modules" $ do+          it "infers exposed-modules" $ do+            touch "src/Foo.hs"+            touch "src/Bar.hs"+            [i|+            library:+              source-dirs: src+            |] `shouldRenderTo` library [i|+            hs-source-dirs:+                src+            exposed-modules:+                Bar+                Foo+            other-modules:+                Paths_foo+            |]++        context "with a conditional" $ do+          it "doesn't infer any modules mentioned in that conditional" $ do+            touch "src/Foo.hs"+            touch "src/Bar.hs"+            [i|+            library:+              source-dirs: src+              when:+                condition: os(windows)+                exposed-modules: Foo+            |] `shouldRenderTo` library [i|+            hs-source-dirs:+                src+            if os(windows)+              exposed-modules:+                  Foo+            exposed-modules:+                Bar+            other-modules:+                Paths_foo+            |]++          context "with a source-dir inside the conditional" $ do+            it "infers other-modules" $ do+              touch "windows/Foo.hs"+              [i|+              library:+                when:+                  condition: os(windows)+                  source-dirs: windows+              |] `shouldRenderTo` library [i|+              other-modules:+                  Paths_foo+              if os(windows)+                other-modules:+                    Foo+                hs-source-dirs:+                    windows+              |]++    context "with internal-libraries" $ do+      it "accepts internal-libraries" $ do+        touch "src/Foo.hs"+        [i|+        internal-libraries:+          bar:+            source-dirs: src+          |] `shouldRenderTo` internalLibrary "bar" [i|+          exposed-modules:+              Foo+          other-modules:+              Paths_foo+          hs-source-dirs:+              src+          |]++      it "warns on unknown fields" $ do+        [i|+        name: foo+        internal-libraries:+          bar:+            baz: 42+        |] `shouldWarn` pure "Ignoring unknown field \"baz\" in internal-libraries section \"bar\""++      it "warns on missing source-dirs" $ do+        [i|+        name: foo+        internal-libraries:+          bar:+            source-dirs: src+        |] `shouldWarn` pure "Specified source-dir \"src\" does not exist"++    context "with executables" $ do+      it "accepts arbitrary entry points as main" $ do+        touch "src/Foo.hs"+        touch "src/Bar.hs"+        [i|+        executables:+          foo:+            source-dirs: src+            main: Foo+        |] `shouldRenderTo` executable "foo" [i|+        main-is: Foo.hs+        ghc-options: -main-is Foo+        hs-source-dirs:+            src+        other-modules:+            Bar+            Paths_foo+        |]++      context "when inferring modules" $ do+        it "infers other-modules" $ do+          touch "src/Main.hs"+          touch "src/Foo.hs"+          [i|+          executables:+            foo:+              main: Main.hs+              source-dirs: src+          |] `shouldRenderTo` executable "foo" [i|+            main-is: Main.hs+            hs-source-dirs:+                src+            other-modules:+                Foo+                Paths_foo+          |]++        it "allows to specify other-modules" $ do+          touch "src/Foo.hs"+          touch "src/Bar.hs"+          [i|+          executables:+            foo:+              main: Main.hs+              source-dirs: src+              other-modules: Baz+          |] `shouldRenderTo` executable "foo" [i|+            main-is: Main.hs+            hs-source-dirs:+                src+            other-modules:+                Baz+          |]+        context "with conditional" $ do+          it "doesn't infer any modules mentioned in that conditional" $ do+            touch "src/Foo.hs"+            touch "src/Bar.hs"+            [i|+            executables:+              foo:+                source-dirs: src+                when:+                  condition: os(windows)+                  other-modules: Foo+            |] `shouldRenderTo` executable "foo" [i|+            other-modules:+                Bar+                Paths_foo+            hs-source-dirs:+                src+            if os(windows)+              other-modules:+                  Foo+            |]++          it "infers other-modules" $ do+            touch "src/Foo.hs"+            touch "windows/Bar.hs"+            [i|+            executables:+              foo:+                source-dirs: src+                when:+                  condition: os(windows)+                  source-dirs: windows+            |] `shouldRenderTo` executable "foo" [i|+            other-modules:+                Foo+                Paths_foo+            hs-source-dirs:+                src+            if os(windows)+              other-modules:+                  Bar+              hs-source-dirs:+                  windows+            |]++      context "with conditional" $ do+        it "does not apply global options" $ do+          -- related bug: https://github.com/sol/hpack/issues/214+          [i|+          ghc-options: -Wall+          executables:+            foo:+              when:+                condition: os(windows)+                main: Foo.hs+          |] `shouldRenderTo` executable "foo" [i|+          ghc-options: -Wall+          if os(windows)+            main-is: Foo.hs+          |]++        it "accepts executable-specific fields" $ do+          [i|+          executables:+            foo:+              when:+                condition: os(windows)+                main: Foo+          |] `shouldRenderTo` executable "foo" [i|+          if os(windows)+            main-is: Foo.hs+            ghc-options: -main-is Foo+          |]++    describe "when" $ do+      it "accepts conditionals" $ do+        [i|+        when:+          condition: os(windows)+          dependencies: Win32+        executable: {}+        |] `shouldRenderTo` executable "foo" [i|+        if os(windows)+          build-depends:+              Win32+        |]+      it "warns on unknown fields" $ do+        [i|+        name: foo+        foo: 23+        when:+          - condition: os(windows)+            bar: 23+            when:+              condition: os(windows)+              bar2: 23+          - condition: os(windows)+            baz: 23+        |] `shouldWarn` [+            "Ignoring unknown field \"foo\" in package description"+          , "Ignoring unknown field \"bar\" in package description"+          , "Ignoring unknown field \"bar2\" in package description"+          , "Ignoring unknown field \"baz\" in package description"+          ]++      context "when parsing conditionals with else-branch" $ do+        it "accepts conditionals with else-branch" $ do+          [i|+          when:+            condition: os(windows)+            then:+              dependencies: Win32+            else:+              dependencies: unix+          executable: {}+          |] `shouldRenderTo` executable "foo" [i|+          if os(windows)+            build-depends:+                Win32+          else+            build-depends:+                unix+          |]++        it "rejects invalid conditionals" $ do+          [i|+          when:+            condition: os(windows)+            then:+              dependencies: Win32+            else: null+          |] `shouldFailWith` "package.yaml: Error in $.when.else: expected record (:*:), encountered Null"++        it "warns on unknown fields" $ do+          [i|+          name: foo+          when:+            condition: os(windows)+            foo: null+            then:+              bar: null+            else:+              when:+                condition: os(windows)+                then: {}+                else:+                  baz: null+          |] `shouldWarn` [+              "Ignoring unknown field \"foo\" in package description"+            , "Ignoring unknown field \"bar\" in package description"+            , "Ignoring unknown field \"baz\" in package description"+            ]++run :: FilePath -> String -> IO ([String], String)+run c old = run_ c old >>= either die return++run_ :: FilePath -> String -> IO (Either String ([String], String))+run_ c old = do+  mPackage <- readPackageConfig c+  return $ case mPackage of+    Right (warnings, pkg) ->+      let+        FormattingHints{..} = sniffFormattingHints old+        alignment = fromMaybe 0 formattingHintsAlignment+        settings = formattingHintsRenderSettings+        output = Hpack.renderPackage settings alignment formattingHintsFieldOrder formattingHintsSectionsFieldOrder pkg+      in+        Right (warnings, output)+    Left err -> Left err++newtype PlainString = PlainString String+  deriving Eq++instance Show PlainString where+  show (PlainString xs) = xs++shouldRenderTo :: HasCallStack => String -> Package -> Expectation+shouldRenderTo input p = do+  writeFile packageConfig input+  (_ , output) <- run packageConfig expected+  PlainString (dropEmptyLines output) `shouldBe` PlainString expected+  where+    expected = dropEmptyLines (renderPackage p)+    dropEmptyLines = unlines . filter (not . null) . lines++shouldWarn :: HasCallStack => String -> [String] -> Expectation+shouldWarn input expected = do+  writeFile packageConfig input+  (warnings, _) <- run packageConfig ""+  sort warnings `shouldBe` sort expected++shouldFailWith :: HasCallStack => String -> String -> Expectation+shouldFailWith input expected = do+  writeFile packageConfig input+  run_ packageConfig "" `shouldReturn` Left expected++customSetup :: String -> Package+customSetup a = (package content) {packageCabalVersion = ">= 1.24", packageBuildType = "Custom"}+  where+    content = [i|+custom-setup+#{indentBy 2 $ unindent a}+|]++library :: String -> Package+library l = package content+  where+    content = [i|+library+#{indentBy 2 $ unindent l}+  default-language: Haskell2010+|]++internalLibrary :: String -> String -> Package+internalLibrary name e = (package content) {packageCabalVersion = ">= 2.0"}+  where+    content = [i|+library #{name}+#{indentBy 2 $ unindent e}+  default-language: Haskell2010+|]++executable :: String -> String -> Package+executable name e = package content+  where+    content = [i|+executable #{name}+#{indentBy 2 $ unindent e}+  default-language: Haskell2010+|]++package :: String -> Package+package = Package "foo" "Simple" ">= 1.10"++data Package = Package {+  packageName :: String+, packageBuildType :: String+, packageCabalVersion :: String+, packageContent :: String+}++renderPackage :: Package -> String+renderPackage Package{..} = unindent [i|+name: #{packageName}+version: 0.0.0+build-type: #{packageBuildType}+cabal-version: #{packageCabalVersion}++#{unindent packageContent}+|]++indentBy :: Int -> String -> String+indentBy n = unlines . map (replicate n ' ' ++) . lines

@@ -3,7 +3,7 @@ import           Helper import           Test.QuickCheck import           Data.Version (showVersion)-import           Control.Monad.Compat+import           Control.Monad  import           Paths_hpack (version) 

@@ -1,6 +1,8 @@ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Hpack.ConfigSpec (   spec@@ -14,9 +16,9 @@ import           Data.Aeson.Types import           Data.String.Interpolate.IsString import           Control.Arrow+import           GHC.Exts import           System.Directory (createDirectory)-import           Data.Yaml-import           Data.Either.Compat+import           Data.Either import qualified Data.Map.Lazy as Map  import           Hpack.Util@@ -24,14 +26,19 @@ import           Hpack.Config hiding (package) import qualified Hpack.Config as Config +instance IsList (Maybe (List a)) where+  type Item (Maybe (List a)) = a+  fromList = Just . List+  toList = undefined+ deps :: [String] -> Dependencies deps = Dependencies . Map.fromList . map (flip (,) AnyVersion)  package :: Package package = Config.package "foo" "0.0.0" -executable :: String -> String -> Executable-executable name main_ = Executable name main_ ["Paths_foo"]+executable :: String -> Executable+executable main_ = Executable (Just main_) []  library :: Library library = Library Nothing [] ["Paths_foo"] []@@ -59,12 +66,41 @@  spec :: Spec spec = do+  describe "fromLibrarySectionInConditional" $ do+    let+      sect = LibrarySection {+        librarySectionExposed = Nothing+      , librarySectionExposedModules = Nothing+      , librarySectionOtherModules = Nothing+      , librarySectionReexportedModules = Nothing+      }+      lib = Library {+        libraryExposed = Nothing+      , libraryExposedModules = []+      , libraryOtherModules = []+      , libraryReexportedModules = []+      }+      inferableModules = ["Foo", "Bar"]+      from = fromLibrarySectionInConditional inferableModules++    context "when inferring modules" $ do+      it "infers other-modules" $ do+        from sect `shouldBe` lib {libraryOtherModules = ["Foo", "Bar"]}++      context "with exposed-modules" $ do+        it "infers nothing" $ do+          from sect {librarySectionExposedModules = []} `shouldBe` lib++      context "with other-modules" $ do+        it "infers nothing" $ do+          from sect {librarySectionOtherModules = []} `shouldBe` lib+   describe "renamePackage" $ do     it "renames a package" $ do       renamePackage "bar" package `shouldBe` package {packageName = "bar"}      it "renames dependencies on self" $ do-      let packageWithExecutable dependencies = package {packageExecutables = [(section $ executable "main" "Main.hs") {sectionDependencies = deps dependencies}]}+      let packageWithExecutable dependencies = package {packageExecutables = Map.fromList [("main", (section $ executable "Main.hs") {sectionDependencies = deps dependencies})]}       renamePackage "bar" (packageWithExecutable ["foo"]) `shouldBe` (packageWithExecutable ["bar"]) {packageName = "bar"}    describe "renameDependencies" $ do@@ -85,162 +121,6 @@             }       renameDependencies "bar" "baz" (sectionWithConditional ["foo", "bar"]) `shouldBe` sectionWithConditional ["foo", "baz"] -  describe "parseJSON" $ do-    context "when parsing (CaptureUnknownFields Section a)" $ do-      it "accepts dependencies" $ do-        let input = [i|-              dependencies: hpack-              |]-        captureUnknownFieldsValue <$> decodeEither input-          `shouldBe` Right (section Empty){sectionDependencies = deps ["hpack"]}--      it "accepts includes-dirs" $ do-        let input = [i|-              include-dirs:-                - foo-                - bar-              |]-        captureUnknownFieldsValue <$> decodeEither input-          `shouldBe` Right (section Empty){sectionIncludeDirs = ["foo", "bar"]}--      it "accepts install-includes" $ do-        let input = [i|-              install-includes:-                - foo.h-                - bar.h-              |]-        captureUnknownFieldsValue <$> decodeEither input-          `shouldBe` Right (section Empty){sectionInstallIncludes = ["foo.h", "bar.h"]}--      it "accepts c-sources" $ do-        let input = [i|-              c-sources:-                - foo.c-                - bar/*.c-              |]-        captureUnknownFieldsValue <$> decodeEither input-          `shouldBe` Right (section Empty){sectionCSources = ["foo.c", "bar/*.c"]}--      it "accepts js-sources" $ do-        let input = [i|-              js-sources:-                - foo.js-                - bar/*.js-              |]-        captureUnknownFieldsValue <$> decodeEither input-          `shouldBe` Right (section Empty){sectionJsSources = ["foo.js", "bar/*.js"]}--      it "accepts extra-lib-dirs" $ do-        let input = [i|-              extra-lib-dirs:-                - foo-                - bar-              |]-        captureUnknownFieldsValue <$> decodeEither input-          `shouldBe` Right (section Empty){sectionExtraLibDirs = ["foo", "bar"]}--      it "accepts extra-libraries" $ do-        let input = [i|-              extra-libraries:-                - foo-                - bar-              |]-        captureUnknownFieldsValue <$> decodeEither input-          `shouldBe` Right (section Empty){sectionExtraLibraries = ["foo", "bar"]}--      it "accepts extra-frameworks-dirs" $ do-        let input = [i|-              extra-frameworks-dirs:-                - foo-                - bar-              |]-        captureUnknownFieldsValue <$> decodeEither input-          `shouldBe` Right (section Empty){sectionExtraFrameworksDirs = ["foo", "bar"]}--      it "accepts frameworks" $ do-        let input = [i|-              frameworks:-                - foo-                - bar-              |]-        captureUnknownFieldsValue <$> decodeEither input-          `shouldBe` Right (section Empty){sectionFrameworks = ["foo", "bar"]}--      context "when parsing conditionals" $ do-        it "accepts conditionals" $ do-          let input = [i|-                when:-                  condition: os(windows)-                  dependencies: Win32-                |]-              conditionals = [-                Conditional "os(windows)"-                (section ()){sectionDependencies = deps ["Win32"]}-                Nothing-                ]-          captureUnknownFieldsValue <$> decodeEither input-            `shouldBe` Right (section Empty){sectionConditionals = conditionals}--        it "warns on unknown fields" $ do-          let input = [i|-                foo: 23-                when:-                  - condition: os(windows)-                    bar: 23-                    when:-                      condition: os(windows)-                      bar2: 23-                  - condition: os(windows)-                    baz: 23-                |]-          captureUnknownFieldsFields <$> (decodeEither input :: Either String (CaptureUnknownFields (Section Empty)))-            `shouldBe` Right ["foo", "bar", "bar2", "baz"]--        context "when parsing conditionals with else-branch" $ do-          it "accepts conditionals with else-branch" $ do-            let input = [i|-                  when:-                    condition: os(windows)-                    then:-                      dependencies: Win32-                    else:-                      dependencies: unix-                  |]-                conditionals = [-                  Conditional "os(windows)"-                  (section ()){sectionDependencies = deps ["Win32"]}-                  (Just (section ()){sectionDependencies = deps ["unix"]})-                  ]-                r :: Either String (Section Empty)-                r = captureUnknownFieldsValue <$> decodeEither input-            sectionConditionals <$> r `shouldBe` Right conditionals--          it "rejects invalid conditionals" $ do-            let input = [i|-                  when:-                    condition: os(windows)-                    then:-                      dependencies: Win32-                    else: null-                  |]--                r :: Either String (Section Empty)-                r = captureUnknownFieldsValue <$> decodeEither input-            sectionConditionals <$> r `shouldSatisfy` isLeft--          it "warns on unknown fields" $ do-            let input = [i|-                  when:-                    condition: os(windows)-                    foo: null-                    then:-                      bar: null-                    else:-                      baz: null-                  |]-            captureUnknownFieldsFields <$> (decodeEither input :: Either String (CaptureUnknownFields (Section Empty)))-              `shouldBe` Right ["foo", "bar", "baz"]-   describe "getModules" $ around withTempDirectory $ do     it "returns Haskell modules in specified source directory" $ \dir -> do       touch (dir </> "src/Foo.hs")@@ -262,17 +142,17 @@    describe "determineModules" $ do     it "adds the Paths_* module to the other-modules" $ do-      determineModules "foo" [] (Just $ List ["Foo"]) Nothing `shouldBe` (["Foo"], ["Paths_foo"])+      determineModules "foo" [] ["Foo"] Nothing `shouldBe` (["Foo"], ["Paths_foo"])      it "adds the Paths_* module to the other-modules when no modules are specified" $ do       determineModules "foo" [] Nothing Nothing `shouldBe` ([], ["Paths_foo"])      it "replaces dashes with underscores in Paths_*" $ do-      determineModules "foo-bar" [] (Just $ List ["Foo"]) Nothing `shouldBe` (["Foo"], ["Paths_foo_bar"])+      determineModules "foo-bar" [] ["Foo"] Nothing `shouldBe` (["Foo"], ["Paths_foo_bar"])      context "when the Paths_* module is part of the exposed-modules" $ do       it "does not add the Paths_* module to the other-modules" $ do-        determineModules "foo" [] (Just $ List ["Foo", "Paths_foo"]) Nothing `shouldBe` (["Foo", "Paths_foo"], [])+        determineModules "foo" [] ["Foo", "Paths_foo"] Nothing `shouldBe` (["Foo", "Paths_foo"], [])    describe "readPackageConfig" $ do     it "warns on unknown fields" $ do@@ -282,7 +162,7 @@         baz: 42         _qux: 66         |]-        (`shouldBe` [+        (`shouldMatchList` [           "Ignoring unknown field \"bar\" in package description"         , "Ignoring unknown field \"baz\" in package description"         ]@@ -297,7 +177,7 @@             baz: 42             _qux: 66         |]-        (`shouldBe` [+        (`shouldMatchList` [           "Ignoring unknown field \"_qux\" in package description"         , "Ignoring unknown field \"bar\" in package description"         , "Ignoring unknown field \"baz\" in package description"@@ -313,12 +193,40 @@           dependencies: ghc-prim           baz: 42         |]-        (`shouldBe` [+        (`shouldMatchList` [           "Ignoring unknown field \"baz\" in package description"         , "Ignoring unknown field \"github\" in package description"         ]         ) +    it "warns on unknown fields in when block in library section" $ do+      withPackageWarnings_ [i|+        name: foo+        library:+          when:+            condition: impl(ghc)+            baz: 42+        |]+        (`shouldBe` [+          "Ignoring unknown field \"baz\" in library section"+        ]+        )++    it "warns on unknown fields in when block in executable section" $ do+      withPackageWarnings_ [i|+        name: foo+        executables:+          foo:+            main: Main.hs+            when:+              condition: impl(ghc)+              baz: 42+        |]+        (`shouldBe` [+          "Ignoring unknown field \"baz\" in executable section \"foo\""+        ]+        )+     it "warns on missing name" $ do       withPackageWarnings_ [i|         {}@@ -567,8 +475,8 @@         |]         (`shouldBe` package {           packageLibrary = Just (section library) {sectionCppOptions = ["-DFOO", "-DLIB"]}-        , packageExecutables = [(section $ executable "foo" "Main.hs") {sectionCppOptions = ["-DFOO", "-DFOO"]}]-        , packageTests = [(section $ executable "spec" "Spec.hs") {sectionCppOptions = ["-DFOO", "-DTEST"]}]+        , packageExecutables = Map.fromList [("foo", (section $ executable "Main.hs") {sectionCppOptions = ["-DFOO", "-DFOO"]})]+        , packageTests = Map.fromList [("spec", (section $ executable "Spec.hs") {sectionCppOptions = ["-DFOO", "-DTEST"]})]         }         ) @@ -591,8 +499,8 @@         |]         (`shouldBe` package {           packageLibrary = Just (section library) {sectionCcOptions = ["-Wall", "-fLIB"]}-        , packageExecutables = [(section $ executable "foo" "Main.hs") {sectionCcOptions = ["-Wall", "-O2"]}]-        , packageTests = [(section $ executable "spec" "Spec.hs") {sectionCcOptions = ["-Wall", "-O0"]}]+        , packageExecutables = Map.fromList [("foo", (section $ executable "Main.hs") {sectionCcOptions = ["-Wall", "-O2"]})]+        , packageTests = Map.fromList [("spec", (section $ executable "Spec.hs") {sectionCcOptions = ["-Wall", "-O0"]})]         }         ) @@ -615,8 +523,8 @@         |]         (`shouldBe` package {           packageLibrary = Just (section library) {sectionGhcjsOptions = ["-dedupe", "-ghcjs1"]}-        , packageExecutables = [(section $ executable "foo" "Main.hs") {sectionGhcjsOptions = ["-dedupe", "-ghcjs2"]}]-        , packageTests = [(section $ executable "spec" "Spec.hs") {sectionGhcjsOptions = ["-dedupe", "-ghcjs3"]}]+        , packageExecutables = Map.fromList [("foo", (section $ executable "Main.hs") {sectionGhcjsOptions = ["-dedupe", "-ghcjs2"]})]+        , packageTests = Map.fromList [("spec", (section $ executable "Spec.hs") {sectionGhcjsOptions = ["-dedupe", "-ghcjs3"]})]         }         ) @@ -642,54 +550,10 @@         |]         (`shouldBe` package {           packageLibrary = Just (section library) {sectionBuildable = Just True}-        , packageExecutables = [(section $ executable "foo" "Main.hs") {sectionBuildable = Just False}]+        , packageExecutables = Map.fromList [("foo", (section $ executable "Main.hs") {sectionBuildable = Just False})]         }         ) -    context "when reading custom-setup section" $ do-      it "warns on unknown fields" $ do-        withPackageWarnings_ [i|-          name: foo-          custom-setup:-            foo: 1-            bar: 2-          |]-          (`shouldBe` [-            "Ignoring unknown field \"bar\" in custom-setup section"-          , "Ignoring unknown field \"foo\" in custom-setup section"-          ])--      it "sets build-type: Custom, if missing" $ do-        withPackageConfig_ [i|-          custom-setup:-            dependencies:-              - base-          |]-          (packageBuildType >>> (`shouldBe` Custom))--      it "leaves build-type alone, if it exists" $ do-        withPackageConfig_ [i|-          name: foo-          build-type: Make-          custom-setup:-            dependencies:-              - base-          |]-          (packageBuildType >>> (`shouldBe` Make))--      it "accepts dependencies" $ do-        withPackageConfig_ [i|-          custom-setup:-            dependencies:-              - foo > 1.0-              - bar == 2.0-          |]-          (packageCustomSetup >>> fmap customSetupDependencies >>> fmap unDependencies >>> fmap Map.toList >>> (`shouldBe` Just [-              ("bar", VersionRange "==2.0")-            , ("foo", VersionRange ">1.0")-            ])-          )-     it "allows yaml merging and overriding fields" $ do       withPackageConfig_ [i|         _common: &common@@ -708,7 +572,7 @@             bar: 23             baz: 42           |]-          (`shouldBe` [+          (`shouldMatchList` [             "Ignoring unknown field \"bar\" in library section"           , "Ignoring unknown field \"baz\" in library section"           ]@@ -768,54 +632,6 @@           |]           (packageLibrary >>> (`shouldBe` Just (section library) {sectionBuildTools = deps ["alex", "happy"]})) -      it "accepts c-sources" $ do-        withPackageConfig [i|-          library:-            c-sources:-              - cbits/*.c-          |]-          (do-          touch "cbits/foo.c"-          touch "cbits/bar.c"-          )-          (packageLibrary >>> (`shouldBe` Just (section library) {sectionCSources = ["cbits/bar.c", "cbits/foo.c"]}))--      it "accepts global c-sources" $ do-        withPackageConfig [i|-          c-sources:-            - cbits/*.c-          library: {}-          |]-          (do-          touch "cbits/foo.c"-          touch "cbits/bar.c"-          )-          (packageLibrary >>> (`shouldBe` Just (section library) {sectionCSources = ["cbits/bar.c", "cbits/foo.c"]}))--      it "accepts js-sources" $ do-        withPackageConfig [i|-          library:-            js-sources:-              - jsbits/*.js-          |]-          (do-          touch "jsbits/foo.js"-          touch "jsbits/bar.js"-          )-          (packageLibrary >>> (`shouldBe` Just (section library) {sectionJsSources = ["jsbits/bar.js", "jsbits/foo.js"]}))--      it "accepts global js-sources" $ do-        withPackageConfig [i|-          js-sources:-            - jsbits/*.js-          library: {}-          |]-          (do-          touch "jsbits/foo.js"-          touch "jsbits/bar.js"-          )-          (packageLibrary >>> (`shouldBe` Just (section library) {sectionJsSources = ["jsbits/bar.js", "jsbits/foo.js"]}))-       it "allows to specify exposed" $ do         withPackageConfig_ [i|           library:@@ -823,61 +639,6 @@           |]           (packageLibrary >>> (`shouldBe` Just (section library{libraryExposed = Just False}))) -      it "allows to specify exposed-modules" $ do-        withPackageConfig [i|-          library:-            source-dirs: src-            exposed-modules: Foo-          |]-          (do-          touch "src/Foo.hs"-          touch "src/Bar.hs"-          )-          (packageLibrary >>> (`shouldBe` Just (section library{libraryExposedModules = ["Foo"], libraryOtherModules = ["Bar", "Paths_foo"]}) {sectionSourceDirs = ["src"]}))--      it "allows to specify other-modules" $ do-        withPackageConfig [i|-          library:-            source-dirs: src-            other-modules: Bar-          |]-          (do-          touch "src/Foo.hs"-          touch "src/Bar.hs"-          )-          (packageLibrary >>> (`shouldBe` Just (section library{libraryExposedModules = ["Foo"], libraryOtherModules = ["Bar"]}) {sectionSourceDirs = ["src"]}))--      it "allows to specify reexported-modules" $ do-        withPackageConfig_ [i|-          library:-            reexported-modules: Baz-          |]-          (packageLibrary >>> (`shouldBe` Just (section library{libraryReexportedModules = ["Baz"]})))--      it "allows to specify both exposed-modules and other-modules" $ do-        withPackageConfig [i|-          library:-            source-dirs: src-            exposed-modules: Foo-            other-modules: Bar-          |]-          (do-          touch "src/Baz.hs"-          )-          (packageLibrary >>> (`shouldBe` Just (section library{libraryExposedModules = ["Foo"], libraryOtherModules = ["Bar"]}) {sectionSourceDirs = ["src"]}))--      context "when neither exposed-modules nor other-modules are specified" $ do-        it "exposes all modules" $ do-          withPackageConfig [i|-            library:-              source-dirs: src-            |]-            (do-            touch "src/Foo.hs"-            touch "src/Bar.hs"-            )-            (packageLibrary >>> (`shouldBe` Just (section library{libraryExposedModules = ["Bar", "Foo"]}) {sectionSourceDirs = ["src"]}))-     context "when reading executable section" $ do       it "warns on unknown fields" $ do         withPackageWarnings_ [i|@@ -888,7 +649,7 @@               bar: 42               baz: 23           |]-          (`shouldBe` [+          (`shouldMatchList` [             "Ignoring unknown field \"bar\" in executable section \"foo\""           , "Ignoring unknown field \"baz\" in executable section \"foo\""           ]@@ -900,14 +661,14 @@             foo:               main: driver/Main.hs           |]-          (packageExecutables >>> (`shouldBe` [section $ executable "foo" "driver/Main.hs"]))+          (packageExecutables >>> (`shouldBe` Map.fromList [("foo", section $ executable "driver/Main.hs")]))        it "reads executable section" $ do         withPackageConfig_ [i|           executable:             main: driver/Main.hs           |]-          (packageExecutables >>> (`shouldBe` [section $ executable "foo" "driver/Main.hs"]))+          (packageExecutables >>> (`shouldBe` Map.fromList [("foo", section $ executable "driver/Main.hs")]))        it "warns on unknown executable fields" $ do         withPackageWarnings_ [i|@@ -927,7 +688,7 @@               foo2:                 main: driver/Main2.hs             |]-            (packageExecutables >>> (`shouldBe` [section $ executable "foo" "driver/Main1.hs"]))+            (packageExecutables >>> (`shouldBe` Map.fromList [("foo", section $ executable "driver/Main1.hs")]))          it "warns" $ do           withPackageWarnings_ [i|@@ -940,17 +701,6 @@             |]             (`shouldBe` ["Ignoring field \"executables\" in favor of \"executable\""]) -      it "accepts arbitrary entry points as main" $ do-        withPackageConfig_ [i|-          executables:-            foo:-              main: Foo-          |]-          (packageExecutables >>> (`shouldBe` [-            (section $ executable "foo" "Foo.hs") {sectionGhcOptions = ["-main-is Foo"]}-          ]-          ))-       it "accepts source-dirs" $ do         withPackageConfig_ [i|           executables:@@ -960,7 +710,7 @@                 - foo                 - bar           |]-          (packageExecutables >>> (`shouldBe` [(section $ executable "foo" "Main.hs") {sectionSourceDirs = ["foo", "bar"]}]))+          (packageExecutables >>> (`shouldBe` Map.fromList [("foo", (section (executable "Main.hs") {executableOtherModules = ["Paths_foo"]}) {sectionSourceDirs = ["foo", "bar"]})]))        it "accepts build-tools" $ do         withPackageConfig_ [i|@@ -971,7 +721,7 @@                 - alex                 - happy           |]-          (packageExecutables >>> (`shouldBe` [(section $ executable "foo" "Main.hs") {sectionBuildTools = deps ["alex", "happy"]}]))+          (packageExecutables >>> (`shouldBe` Map.fromList [("foo", (section $ executable "Main.hs") {sectionBuildTools = deps ["alex", "happy"]})]))        it "accepts global source-dirs" $ do         withPackageConfig_ [i|@@ -982,7 +732,7 @@             foo:               main: Main.hs           |]-          (packageExecutables >>> (`shouldBe` [(section $ executable "foo" "Main.hs") {sectionSourceDirs = ["foo", "bar"]}]))+          (packageExecutables >>> (`shouldBe` Map.fromList [("foo", (section (executable "Main.hs") {executableOtherModules = ["Paths_foo"]}) {sectionSourceDirs = ["foo", "bar"]})]))        it "accepts global build-tools" $ do         withPackageConfig_ [i|@@ -993,34 +743,7 @@             foo:               main: Main.hs           |]-          (packageExecutables >>> (`shouldBe` [(section $ executable "foo" "Main.hs") {sectionBuildTools = deps ["alex", "happy"]}]))--      it "infers other-modules" $ do-        withPackageConfig [i|-          executables:-            foo:-              main: Main.hs-              source-dirs: src-          |]-          (do-          touch "src/Main.hs"-          touch "src/Foo.hs"-          )-          (map (executableOtherModules . sectionData) . packageExecutables >>> (`shouldBe` [["Foo", "Paths_foo"]]))--      it "allows to specify other-modules" $ do-        withPackageConfig [i|-          executables:-            foo:-              main: Main.hs-              source-dirs: src-              other-modules: Baz-          |]-          (do-          touch "src/Foo.hs"-          touch "src/Bar.hs"-          )-          (map (executableOtherModules . sectionData) . packageExecutables >>> (`shouldBe` [["Baz"]]))+          (packageExecutables >>> (`shouldBe` Map.fromList [("foo", (section $ executable "Main.hs") {sectionBuildTools = deps ["alex", "happy"]})]))        it "accepts default-extensions" $ do         withPackageConfig_ [i|@@ -1031,7 +754,7 @@                 - Foo                 - Bar           |]-          (packageExecutables >>> (`shouldBe` [(section $ executable "foo" "driver/Main.hs") {sectionDefaultExtensions = ["Foo", "Bar"]}]))+          (packageExecutables >>> (`shouldBe` Map.fromList [("foo", (section $ executable "driver/Main.hs") {sectionDefaultExtensions = ["Foo", "Bar"]})]))        it "accepts global default-extensions" $ do         withPackageConfig_ [i|@@ -1042,7 +765,7 @@             foo:               main: driver/Main.hs           |]-          (packageExecutables >>> (`shouldBe` [(section $ executable "foo" "driver/Main.hs") {sectionDefaultExtensions = ["Foo", "Bar"]}]))+          (packageExecutables >>> (`shouldBe` Map.fromList [("foo", (section $ executable "driver/Main.hs") {sectionDefaultExtensions = ["Foo", "Bar"]})]))        it "accepts GHC options" $ do         withPackageConfig_ [i|@@ -1051,7 +774,7 @@               main: driver/Main.hs               ghc-options: -Wall           |]-          (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionGhcOptions = ["-Wall"]}]})+          (`shouldBe` package {packageExecutables = Map.fromList [("foo", (section $ executable "driver/Main.hs") {sectionGhcOptions = ["-Wall"]})]})        it "accepts global GHC options" $ do         withPackageConfig_ [i|@@ -1060,7 +783,7 @@             foo:               main: driver/Main.hs           |]-          (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionGhcOptions = ["-Wall"]}]})+          (`shouldBe` package {packageExecutables = Map.fromList [("foo", (section $ executable "driver/Main.hs") {sectionGhcOptions = ["-Wall"]})]})        it "accepts GHC profiling options" $ do         withPackageConfig_ [i|@@ -1069,7 +792,7 @@               main: driver/Main.hs               ghc-prof-options: -fprof-auto           |]-          (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionGhcProfOptions = ["-fprof-auto"]}]})+          (`shouldBe` package {packageExecutables = Map.fromList [("foo", (section $ executable "driver/Main.hs") {sectionGhcProfOptions = ["-fprof-auto"]})]})        it "accepts global GHC profiling options" $ do         withPackageConfig_ [i|@@ -1078,63 +801,7 @@             foo:               main: driver/Main.hs           |]-          (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionGhcProfOptions = ["-fprof-auto"]}]})--      it "accepts c-sources" $ do-        withPackageConfig [i|-          executables:-            foo:-              main: driver/Main.hs-              c-sources:-                - cbits/*.c-          |]-          (do-          touch "cbits/foo.c"-          touch "cbits/bar.c"-          )-          (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionCSources = ["cbits/bar.c", "cbits/foo.c"]}]})--      it "accepts global c-sources" $ do-        withPackageConfig [i|-          c-sources:-            - cbits/*.c-          executables:-            foo:-              main: driver/Main.hs-          |]-          (do-          touch "cbits/foo.c"-          touch "cbits/bar.c"-          )-          (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionCSources = ["cbits/bar.c", "cbits/foo.c"]}]})--      it "accepts js-sources" $ do-        withPackageConfig [i|-          executables:-            foo:-              main: driver/Main.hs-              js-sources:-                - jsbits/*.js-          |]-          (do-          touch "jsbits/foo.js"-          touch "jsbits/bar.js"-          )-          (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionJsSources = ["jsbits/bar.js", "jsbits/foo.js"]}]})--      it "accepts global js-sources" $ do-        withPackageConfig [i|-          js-sources:-            - jsbits/*.js-          executables:-            foo:-              main: driver/Main.hs-          |]-          (do-          touch "jsbits/foo.js"-          touch "jsbits/bar.js"-          )-          (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionJsSources = ["jsbits/bar.js", "jsbits/foo.js"]}]})+          (`shouldBe` package {packageExecutables = Map.fromList [("foo", (section $ executable "driver/Main.hs") {sectionGhcProfOptions = ["-fprof-auto"]})]})      context "when reading benchmark section" $ do       it "warns on unknown fields" $ do@@ -1146,7 +813,7 @@               bar: 42               baz: 23           |]-          (`shouldBe` [+          (`shouldMatchList` [             "Ignoring unknown field \"bar\" in benchmark section \"foo\""           , "Ignoring unknown field \"baz\" in benchmark section \"foo\""           ]@@ -1162,7 +829,7 @@               bar: 42               baz: 23           |]-          (`shouldBe` [+          (`shouldMatchList` [             "Ignoring unknown field \"bar\" in test section \"foo\""           , "Ignoring unknown field \"baz\" in test section \"foo\""           ]@@ -1174,52 +841,7 @@             spec:               main: test/Spec.hs           |]-          (`shouldBe` package {packageTests = [section $ executable "spec" "test/Spec.hs"]})--      it "accepts single dependency" $ do-        withPackageConfig_ [i|-          tests:-            spec:-              main: test/Spec.hs-              dependencies: hspec-          |]-          (`shouldBe` package {packageTests = [(section $ executable "spec" "test/Spec.hs") {sectionDependencies = deps ["hspec"]}]})--      it "accepts list of dependencies" $ do-        withPackageConfig_ [i|-          tests:-            spec:-              main: test/Spec.hs-              dependencies:-                - hspec-                - QuickCheck-          |]-          (`shouldBe` package {packageTests = [(section $ executable "spec" "test/Spec.hs") {sectionDependencies = deps ["hspec", "QuickCheck"]}]})--      context "when both global and section specific dependencies are specified" $ do-        it "combines dependencies" $ do-          withPackageConfig_ [i|-            dependencies:-              - base--            tests:-              spec:-                main: test/Spec.hs-                dependencies: hspec-            |]-            (`shouldBe` package {packageTests = [(section $ executable "spec" "test/Spec.hs") {sectionDependencies = deps ["base", "hspec"]}]})--        it "gives section specific dependencies precedence" $ do-          withPackageConfig_ [i|-            dependencies:-              - base--            tests:-              spec:-                main: test/Spec.hs-                dependencies: base >= 2-            |]-            (packageTests >>> map (Map.toList . unDependencies . sectionDependencies) >>> (`shouldBe` [[("base", VersionRange ">=2")]]))+          (`shouldBe` package {packageTests = Map.fromList [("spec", section $ executable "test/Spec.hs")]})      context "when a specified source directory does not exist" $ do       it "warns" $ do@@ -1264,9 +886,8 @@         it "returns an error" $ \dir -> do           let file = dir </> "package.yaml"           writeFile file [i|-            executables:-              foo:-                ain: driver/Main.hs+            - one+            - two             |]           readPackageConfig file >>= (`shouldSatisfy` isLeft) 

@@ -2,9 +2,6 @@  import           Helper -import           Prelude ()-import           Prelude.Compat- import           Hpack.Options  spec :: Spec

@@ -1,12 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} module Hpack.RenderSpec where -import           Prelude ()-import           Prelude.Compat- import           Test.Hspec import           Test.QuickCheck-import           Data.List.Compat+import           Data.List import           Data.Maybe  import           Hpack.Render

@@ -2,7 +2,7 @@ module Hpack.RunSpec (spec) where  import           Helper-import           Data.List.Compat+import           Data.List import qualified Data.Map.Lazy as Map  import           Hpack.ConfigSpec hiding (spec)@@ -13,6 +13,9 @@ library :: Library library = Library Nothing [] [] [] +renderEmptySection :: Empty -> [Element]+renderEmptySection Empty = []+ spec :: Spec spec = do   describe "renderPackage" $ do@@ -126,22 +129,6 @@         , "  default-language: Haskell2010"         ] -    context "when rendering custom-setup section" $ do-      it "includes setup-depends" $ do-        let setup = CustomSetup-              { customSetupDependencies = deps ["foo", "bar"] }-        renderPackage_ package {packageCustomSetup = Just setup} `shouldBe` unlines [-            "name: foo"-          , "version: 0.0.0"-          , "build-type: Simple"-          , "cabal-version: >= 1.10"-          , ""-          , "custom-setup"-          , "  setup-depends:"-          , "      bar"-          , "    , foo"-          ]-     context "when rendering library section" $ do       it "renders library section" $ do         renderPackage_ package {packageLibrary = Just $ section library} `shouldBe` unlines [@@ -154,45 +141,6 @@           , "  default-language: Haskell2010"           ] -      it "includes exposed-modules" $ do-        renderPackage_ package {packageLibrary = Just (section library{libraryExposedModules = ["Foo"]})} `shouldBe` unlines [-            "name: foo"-          , "version: 0.0.0"-          , "build-type: Simple"-          , "cabal-version: >= 1.10"-          , ""-          , "library"-          , "  exposed-modules:"-          , "      Foo"-          , "  default-language: Haskell2010"-          ]--      it "includes other-modules" $ do-        renderPackage_ package {packageLibrary = Just (section library{libraryOtherModules = ["Bar"]})} `shouldBe` unlines [-            "name: foo"-          , "version: 0.0.0"-          , "build-type: Simple"-          , "cabal-version: >= 1.10"-          , ""-          , "library"-          , "  other-modules:"-          , "      Bar"-          , "  default-language: Haskell2010"-          ]--      it "includes reexported-modules and bumps cabal version" $ do-        renderPackage_ package {packageLibrary = Just (section library{libraryReexportedModules = ["Baz"]})} `shouldBe` unlines [-            "name: foo"-          , "version: 0.0.0"-          , "build-type: Simple"-          , "cabal-version: >= 1.21"-          , ""-          , "library"-          , "  reexported-modules:"-          , "      Baz"-          , "  default-language: Haskell2010"-          ]-     context "when given list of existing fields" $ do       it "retains field order" $ do         renderPackage defaultRenderSettings 16 ["cabal-version", "version", "name", "build-type"] [] package `shouldBe` unlines [@@ -211,7 +159,7 @@           ]        it "retains section field order" $ do-        renderPackage defaultRenderSettings 0 [] [("executable foo", ["default-language", "main-is", "ghc-options"])] package {packageExecutables = [(section $ Executable "foo" "Main.hs" []) {sectionGhcOptions = ["-Wall", "-Werror"]}]} `shouldBe` unlines [+        renderPackage defaultRenderSettings 0 [] [("executable foo", ["default-language", "main-is", "ghc-options"])] package {packageExecutables = Map.fromList [("foo", (section $ Executable (Just "Main.hs") []) {sectionGhcOptions = ["-Wall", "-Werror"]})]} `shouldBe` unlines [             "name: foo"           , "version: 0.0.0"           , "build-type: Simple"@@ -226,8 +174,8 @@      context "when rendering executable section" $ do       it "includes dependencies" $ do-        renderPackage_ package {packageExecutables = [(section $ Executable "foo" "Main.hs" []) {sectionDependencies = Dependencies $ Map.fromList-        [("foo", VersionRange "== 0.1.0"), ("bar", AnyVersion)]}]} `shouldBe` unlines [+        renderPackage_ package {packageExecutables = Map.fromList [("foo", (section $ Executable (Just "Main.hs") []) {sectionDependencies = Dependencies $ Map.fromList+        [("foo", VersionRange "== 0.1.0"), ("bar", AnyVersion)]})]} `shouldBe` unlines [             "name: foo"           , "version: 0.0.0"           , "build-type: Simple"@@ -242,7 +190,7 @@           ]        it "includes GHC options" $ do-        renderPackage_ package {packageExecutables = [(section $ Executable "foo" "Main.hs" []) {sectionGhcOptions = ["-Wall", "-Werror"]}]} `shouldBe` unlines [+        renderPackage_ package {packageExecutables = Map.fromList [("foo", (section $ Executable (Just "Main.hs") []) {sectionGhcOptions = ["-Wall", "-Werror"]})]} `shouldBe` unlines [             "name: foo"           , "version: 0.0.0"           , "build-type: Simple"@@ -255,7 +203,7 @@           ]        it "includes frameworks" $ do-        renderPackage_ package {packageExecutables = [(section $ Executable "foo" "Main.hs" []) {sectionFrameworks = ["foo", "bar"]}]} `shouldBe` unlines [+        renderPackage_ package {packageExecutables = Map.fromList [("foo", (section $ Executable (Just "Main.hs") []) {sectionFrameworks = ["foo", "bar"]})]} `shouldBe` unlines [             "name: foo"           , "version: 0.0.0"           , "build-type: Simple"@@ -270,7 +218,7 @@           ]        it "includes extra-framework-dirs" $ do-        renderPackage_ package {packageExecutables = [(section $ Executable "foo" "Main.hs" []) {sectionExtraFrameworksDirs = ["foo", "bar"]}]} `shouldBe` unlines [+        renderPackage_ package {packageExecutables = Map.fromList [("foo", (section $ Executable (Just "Main.hs") []) {sectionExtraFrameworksDirs = ["foo", "bar"]})]} `shouldBe` unlines [             "name: foo"           , "version: 0.0.0"           , "build-type: Simple"@@ -285,7 +233,7 @@           ]        it "includes GHC profiling options" $ do-        renderPackage_ package {packageExecutables = [(section $ Executable "foo" "Main.hs" []) {sectionGhcProfOptions = ["-fprof-auto", "-rtsopts"]}]} `shouldBe` unlines [+        renderPackage_ package {packageExecutables = Map.fromList [("foo", (section $ Executable (Just "Main.hs") []) {sectionGhcProfOptions = ["-fprof-auto", "-rtsopts"]})]} `shouldBe` unlines [             "name: foo"           , "version: 0.0.0"           , "build-type: Simple"@@ -299,16 +247,16 @@    describe "renderConditional" $ do     it "renders conditionals" $ do-      let conditional = Conditional "os(windows)" (section ()) {sectionDependencies = deps ["Win32"]} Nothing-      render defaultRenderSettings 0 (renderConditional conditional) `shouldBe` [+      let conditional = Conditional "os(windows)" (section Empty) {sectionDependencies = deps ["Win32"]} Nothing+      render defaultRenderSettings 0 (renderConditional renderEmptySection conditional) `shouldBe` [           "if os(windows)"         , "  build-depends:"         , "      Win32"         ]      it "renders conditionals with else-branch" $ do-      let conditional = Conditional "os(windows)" (section ()) {sectionDependencies = deps ["Win32"]} (Just $ (section ()) {sectionDependencies = deps ["unix"]})-      render defaultRenderSettings 0 (renderConditional conditional) `shouldBe` [+      let conditional = Conditional "os(windows)" (section Empty) {sectionDependencies = deps ["Win32"]} (Just $ (section Empty) {sectionDependencies = deps ["unix"]})+      render defaultRenderSettings 0 (renderConditional renderEmptySection conditional) `shouldBe` [           "if os(windows)"         , "  build-depends:"         , "      Win32"@@ -318,9 +266,9 @@         ]      it "renders nested conditionals" $ do-      let conditional = Conditional "arch(i386)" (section ()) {sectionGhcOptions = ["-threaded"], sectionConditionals = [innerConditional]} Nothing-          innerConditional = Conditional "os(windows)" (section ()) {sectionDependencies = deps ["Win32"]} Nothing-      render defaultRenderSettings 0 (renderConditional conditional) `shouldBe` [+      let conditional = Conditional "arch(i386)" (section Empty) {sectionGhcOptions = ["-threaded"], sectionConditionals = [innerConditional]} Nothing+          innerConditional = Conditional "os(windows)" (section Empty) {sectionDependencies = deps ["Win32"]} Nothing+      render defaultRenderSettings 0 (renderConditional renderEmptySection conditional) `shouldBe` [           "if arch(i386)"         , "  ghc-options: -threaded"         , "  if os(windows)"

@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}+module Hpack.Utf8Spec (spec) where++import           Helper++import qualified Data.ByteString as B++import qualified Hpack.Utf8 as Utf8++spec :: Spec+spec = do+  describe "readFile" $ do+    context "with a file that uses CRLF newlines" $ do+      it "applies newline conversion" $ do+        inTempDirectory $ do+          let+            name = "foo.txt"+          B.writeFile name "foo\r\nbar"+          Utf8.readFile name `shouldReturn` "foo\nbar"++  describe "writeFile" $ do+    it "uses system specific newline encoding" $ do+      inTempDirectory $ do+        let+          name = "foo.txt"+          c = "foo\nbar"++        writeFile name c+        systemSpecific <- B.readFile name++        Utf8.writeFile name c+        B.readFile name `shouldReturn` systemSpecific

@@ -2,9 +2,8 @@  import           Helper -import           Prelude ()-import           Prelude.Compat hiding (readFile)-import qualified Prelude.Compat as Prelude+import           Prelude hiding (readFile)+import qualified Prelude as Prelude  import           Control.DeepSeq