hpack-convert (empty) → 0.14.1
raw patch · 26 files changed
+4852/−0 lines, 26 filesdep +Cabaldep +Globdep +QuickChecksetup-changed
Dependencies added: Cabal, Glob, QuickCheck, aeson, aeson-qq, base, base-compat, bytestring, containers, deepseq, directory, filepath, hpack-convert, hspec, interpolate, mockery, pretty, temporary, text, unordered-containers, vector, yaml
Files
- LICENSE +19/−0
- Setup.lhs +3/−0
- driver/Main.hs +6/−0
- hpack-convert.cabal +133/−0
- src/Hpack.hs +131/−0
- src/Hpack/Config.hs +1022/−0
- src/Hpack/Convert.hs +264/−0
- src/Hpack/Convert/Run.hs +54/−0
- src/Hpack/FormattingHints.hs +115/−0
- src/Hpack/GenericsUtil.hs +46/−0
- src/Hpack/Haskell.hs +55/−0
- src/Hpack/Render.hs +135/−0
- src/Hpack/Run.hs +275/−0
- src/Hpack/Util.hs +122/−0
- src/Hpack/Yaml.hs +16/−0
- test/Helper.hs +26/−0
- test/Hpack/ConfigSpec.hs +1052/−0
- test/Hpack/ConvertSpec.hs +449/−0
- test/Hpack/FormattingHintsSpec.hs +166/−0
- test/Hpack/GenericsUtilSpec.hs +24/−0
- test/Hpack/HaskellSpec.hs +31/−0
- test/Hpack/RenderSpec.hs +158/−0
- test/Hpack/RunSpec.hs +325/−0
- test/Hpack/UtilSpec.hs +151/−0
- test/HpackSpec.hs +73/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2014-2016 Simon Hengel <sol@typeful.net>++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ driver/Main.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import qualified Hpack++main :: IO ()+main = Hpack.main
+ hpack-convert.cabal view
@@ -0,0 +1,133 @@+-- This file has been generated from package.yaml by hpack version 0.14.1.+--+-- see: https://github.com/sol/hpack++name: hpack-convert+version: 0.14.1+synopsis: Convert Cabal manifests into hpack's package.yamls+category: Development+homepage: https://github.com/yamadapc/hpack-convert#readme+bug-reports: https://github.com/yamadapc/hpack-convert/issues+maintainer: Pedro Tacla Yamada <tacla.yamada@gmail.com>+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10++source-repository head+ type: git+ location: https://github.com/yamadapc/hpack-convert++library+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ base >= 4.7 && < 5+ , base-compat >= 0.8+ , Cabal+ , pretty+ , deepseq+ , directory+ , filepath+ , Glob+ , text+ , containers+ , unordered-containers+ , yaml+ , bytestring+ , vector+ , aeson >= 0.8+ exposed-modules:+ Hpack+ Hpack.Config+ Hpack.Run+ Hpack.Yaml+ other-modules:+ Hpack.Convert+ Hpack.Convert.Run+ Hpack.FormattingHints+ Hpack.GenericsUtil+ Hpack.Haskell+ Hpack.Render+ Hpack.Util+ Paths_hpack_convert+ default-language: Haskell2010++executable hpack-convert+ main-is: Main.hs+ hs-source-dirs:+ driver+ ghc-options: -Wall+ build-depends:+ base >= 4.7 && < 5+ , base-compat >= 0.8+ , Cabal+ , pretty+ , deepseq+ , directory+ , filepath+ , Glob+ , text+ , containers+ , unordered-containers+ , yaml+ , bytestring+ , vector+ , hpack-convert+ , aeson >= 0.8+ default-language: Haskell2010++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs:+ test+ , src+ ghc-options: -Wall+ cpp-options: -DTEST+ build-depends:+ base >= 4.7 && < 5+ , base-compat >= 0.8+ , Cabal+ , pretty+ , deepseq+ , directory+ , filepath+ , Glob+ , text+ , containers+ , unordered-containers+ , yaml+ , bytestring+ , vector+ , hspec == 2.*+ , QuickCheck+ , temporary+ , mockery >= 0.3+ , interpolate+ , aeson-qq+ , aeson >= 0.10+ other-modules:+ Helper+ Hpack.ConfigSpec+ Hpack.ConvertSpec+ Hpack.FormattingHintsSpec+ Hpack.GenericsUtilSpec+ Hpack.HaskellSpec+ Hpack.RenderSpec+ Hpack.RunSpec+ Hpack.UtilSpec+ HpackSpec+ Hpack+ Hpack.Config+ Hpack.Convert+ Hpack.Convert.Run+ Hpack.FormattingHints+ Hpack.GenericsUtil+ Hpack.Haskell+ Hpack.Render+ Hpack.Run+ Hpack.Util+ Hpack.Yaml+ default-language: Haskell2010
+ src/Hpack.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE CPP #-}+module Hpack (+ hpack+, hpackResult+, Result(..)+, Status(..)+, version+, main+#ifdef TEST+, hpackWithVersion+, parseVerbosity+, extractVersion+, parseVersion+#endif+) where++import Prelude ()+import Prelude.Compat++import Control.DeepSeq+import Control.Exception+import Control.Monad.Compat+import Data.List.Compat+import Data.Maybe+import Data.Version (Version)+import qualified Data.Version as Version+import System.Environment+import System.Exit+import System.IO+import System.IO.Error+import Text.ParserCombinators.ReadP++import Paths_hpack_convert (version)+import Hpack.Config+import Hpack.Convert.Run+import Hpack.Run++programVersion :: Version -> String+programVersion v = "hpack version " ++ Version.showVersion v++header :: Version -> String+header v = unlines [+ "-- This file has been generated from " ++ packageConfig ++ " by " ++ programVersion v ++ "."+ , "--"+ , "-- see: https://github.com/sol/hpack"+ , ""+ ]++main :: IO ()+main = do+ args <- getArgs+ case args of+ ["--version"] -> putStrLn (programVersion version)+ ["--help"] -> printHelp+ _ -> runConvert++printHelp :: IO ()+printHelp = do+ hPutStrLn stderr $ unlines [+ "Usage: hpack-convert [ dir | cabalfile ]"+ , " hpack-convert --version"+ , " hpack-convert --help"+ ]++parseVerbosity :: [String] -> (Bool, [String])+parseVerbosity xs = (verbose, ys)+ where+ silentFlag = "--silent"+ verbose = not (silentFlag `elem` xs)+ ys = filter (/= silentFlag) xs++safeInit :: [a] -> [a]+safeInit [] = []+safeInit xs = init xs++extractVersion :: [String] -> Maybe Version+extractVersion = listToMaybe . mapMaybe (stripPrefix prefix >=> parseVersion . safeInit)+ where+ prefix = "-- This file has been generated from package.yaml by hpack version "++parseVersion :: String -> Maybe Version+parseVersion xs = case [v | (v, "") <- readP_to_S Version.parseVersion xs] of+ [v] -> Just v+ _ -> Nothing++hpack :: FilePath -> Bool -> IO ()+hpack = hpackWithVersion version++hpackResult :: FilePath -> IO Result+hpackResult = hpackWithVersionResult version++data Result = Result {+ resultWarnings :: [String]+, resultCabalFile :: String+, resultStatus :: Status+}++data Status = Generated | AlreadyGeneratedByNewerHpack | OutputUnchanged++hpackWithVersion :: Version -> FilePath -> Bool -> IO ()+hpackWithVersion v dir verbose = do+ r <- hpackWithVersionResult v dir+ forM_ (resultWarnings r) $ \warning -> hPutStrLn stderr ("WARNING: " ++ warning)+ when verbose $ putStrLn $+ case resultStatus r of+ Generated -> "generated " ++ resultCabalFile r+ OutputUnchanged -> resultCabalFile r ++ " is up-to-date"+ AlreadyGeneratedByNewerHpack -> resultCabalFile r ++ " was generated with a newer version of hpack, please upgrade and try again."++hpackWithVersionResult :: Version -> FilePath -> IO Result+hpackWithVersionResult v dir = do+ (warnings, cabalFile, new) <- run dir+ old <- either (const Nothing) (Just . splitHeader) <$> tryJust (guard . isDoesNotExistError) (readFile cabalFile >>= (return $!!))+ let oldVersion = fmap fst old >>= extractVersion+ status <-+ if (oldVersion <= Just v) then+ if (fmap snd old == Just (lines new)) then+ return OutputUnchanged+ else do+ writeFile cabalFile $ header v ++ new+ return Generated+ else+ return AlreadyGeneratedByNewerHpack+ return Result+ { resultWarnings = warnings+ , resultCabalFile = cabalFile+ , resultStatus = status+ }+ where+ splitHeader :: String -> ([String], [String])+ splitHeader = fmap (dropWhile null) . span ("--" `isPrefixOf`) . lines
+ src/Hpack/Config.hs view
@@ -0,0 +1,1022 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE UndecidableInstances #-}+module Hpack.Config (+ packageConfig+, readPackageConfig+, encodePackage+, writePackage+, renamePackage+, packageDependencies+, package+, section+, Package(..)+, Dependency(..)+, AddSource(..)+, GitUrl+, GitRef+, GhcOption+, Section(..)+, Library(..)+, Executable(..)+, Conditional(..)+, Flag(..)+, SourceRepository(..)+#ifdef TEST+, renameDependencies+, HasFieldNames(..)+, CaptureUnknownFields(..)+, Empty(..)+, getModules+, determineModules+#endif+) where++import Control.Applicative+import Control.Monad.Compat+import Data.Aeson+import Data.Aeson.Types+import Data.ByteString (ByteString)+import qualified Data.ByteString as ByteString+import Data.Data+import Data.Map.Lazy (Map)+import qualified Data.Map.Lazy as Map+import qualified Data.HashMap.Lazy as HashMap+import Data.List.Compat (elemIndex, intersect, isPrefixOf, nub,+ sortBy, (\\))+import Data.Maybe+import Data.Ord+import Data.String+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Vector as Vector+import qualified Data.Yaml.Pretty as Yaml+import GHC.Generics (Generic, Rep)+import Prelude ()+import Prelude.Compat+import System.Directory+import System.FilePath++import Hpack.GenericsUtil+import Hpack.Util+import Hpack.Yaml++package :: String -> String -> Package+package name version = Package name version Nothing Nothing Nothing Nothing Nothing Nothing [] [] [] Nothing Nothing Nothing [] [] [] Nothing Nothing [] [] []++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+ }++renameDependencies :: String -> String -> Section a -> Section a+renameDependencies old new sect@Section{..} = sect {sectionDependencies = map rename sectionDependencies, sectionConditionals = map renameConditional sectionConditionals}+ where+ rename dep+ | dependencyName dep == old = dep {dependencyName = new}+ | otherwise = dep++ renameConditional :: Conditional -> Conditional+ renameConditional (Conditional condition then_ else_) = Conditional condition (renameDependencies old new then_) (renameDependencies old new <$> else_)++packageDependencies :: Package -> [Dependency]+packageDependencies Package{..} = nub . sortBy (comparing (lexicographically . dependencyName)) $+ (concatMap sectionDependencies packageExecutables)+ ++ (concatMap sectionDependencies packageTests)+ ++ (concatMap sectionDependencies packageBenchmarks)+ ++ maybe [] sectionDependencies packageLibrary++section :: a -> Section a+section a = Section a [] [] [] [] [] [] [] [] [] [] [] [] [] [] Nothing [] []++packageConfig :: FilePath+packageConfig = "package.yaml"++githubBaseUrl :: String+githubBaseUrl = "https://github.com/"++jsonOptions :: String -> Options+jsonOptions name = defaultOptions { fieldLabelModifier = hyphenize name+ , omitNothingFields = True+ }++genericToJSON_ :: forall a. (Generic a, GToJSON (Rep a), HasTypeName a) => a -> Value+genericToJSON_ =+ removeEmptyObjects .+ removeEmptyArrays .+ genericToJSON (jsonOptions name)+ where+ name :: String+ name = typeName (Proxy :: Proxy a)++removeEmptyObjects :: Value -> Value+removeEmptyObjects (Object o) = Object $ HashMap.filter (/= Object mempty) o+removeEmptyObjects v = v++removeEmptyArrays :: Value -> Value+removeEmptyArrays (Object o) = Object $ HashMap.filter (/= Array mempty) o+removeEmptyArrays v = v++genericParseJSON_ :: forall a. (Generic a, GFromJSON (Rep a), HasTypeName a) => Value -> Parser a+genericParseJSON_ = genericParseJSON (jsonOptions name)+ where+ name :: String+ name = typeName (Proxy :: Proxy a)++hyphenize :: String -> String -> String+hyphenize name =+#if MIN_VERSION_aeson(0,10,0)+ camelTo2+#else+ camelTo+#endif+ '-' . drop (length name) . dropWhile (== '_')++type FieldName = String++class HasFieldNames a where+ fieldNames :: Proxy a -> [FieldName]++ default fieldNames :: (HasTypeName a, Selectors (Rep a)) => Proxy a -> [String]+ fieldNames proxy = map (hyphenize $ typeName proxy) (selectors proxy)++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 FlagSection) where+ parseJSON = captureUnknownFields++getUnknownFields :: forall a. HasFieldNames a => Value -> Proxy a -> [FieldName]+getUnknownFields v _ = case v of+ Object o -> unknown+ where+ unknown = keys \\ fields+ keys = map T.unpack (HashMap.keys o)+ fields = fieldNames (Proxy :: Proxy a)+ _ -> []++data LibrarySection = LibrarySection {+ librarySectionExposed :: Maybe Bool+, librarySectionExposedModules :: Maybe (List String)+, librarySectionOtherModules :: Maybe (List String)+, librarySectionReexportedModules :: Maybe (List String)+} deriving (Eq, Show, Generic)++instance HasFieldNames LibrarySection++instance FromJSON LibrarySection where+ parseJSON = genericParseJSON_++data ExecutableSection = ExecutableSection {+ executableSectionMain :: FilePath+, executableSectionOtherModules :: Maybe (List String)+} deriving (Eq, Show, Generic)++instance HasFieldNames ExecutableSection++instance FromJSON ExecutableSection where+ parseJSON = genericParseJSON_++data CommonOptions = CommonOptions {+ commonOptionsSourceDirs :: Maybe (List FilePath)+, commonOptionsDependencies :: Maybe (List Dependency)+, commonOptionsDefaultExtensions :: Maybe (List String)+, commonOptionsOtherExtensions :: Maybe (List String)+, commonOptionsGhcOptions :: Maybe (List GhcOption)+, commonOptionsGhcProfOptions :: Maybe (List GhcProfOption)+, commonOptionsCppOptions :: Maybe (List CppOption)+, commonOptionsCCOptions :: Maybe (List CCOption)+, commonOptionsCSources :: Maybe (List FilePath)+, commonOptionsExtraLibDirs :: Maybe (List FilePath)+, commonOptionsExtraLibraries :: Maybe (List FilePath)+, commonOptionsIncludeDirs :: Maybe (List FilePath)+, commonOptionsInstallIncludes :: Maybe (List FilePath)+, commonOptionsLdOptions :: Maybe (List LdOption)+, commonOptionsBuildable :: Maybe Bool+, commonOptionsWhen :: Maybe (List ConditionalSection)+, commonOptionsBuildTools :: Maybe (List Dependency)+} deriving (Eq, Show, Generic)++instance HasFieldNames CommonOptions++instance FromJSON CommonOptions where+ parseJSON = genericParseJSON_++data ConditionalSection = ThenElseConditional (CaptureUnknownFields ThenElse) | FlatConditional (CaptureUnknownFields (Section Condition))+ deriving (Eq, Show, Generic)++instance FromJSON ConditionalSection where+ parseJSON v+ | hasKey "then" v || hasKey "else" v = ThenElseConditional <$> parseJSON v+ | otherwise = FlatConditional <$> parseJSON v++hasKey :: Text -> Value -> Bool+hasKey key (Object o) = HashMap.member key o+hasKey _ _ = False++newtype Condition = Condition {+ conditionCondition :: String+} deriving (Eq, Show, Generic)++instance FromJSON Condition where+ parseJSON = genericParseJSON_++instance HasFieldNames Condition++data ThenElse = ThenElse {+ _thenElseCondition :: String+, _thenElseThen :: (CaptureUnknownFields (Section Empty))+, _thenElseElse :: (CaptureUnknownFields (Section Empty))+} deriving (Eq, Show, Generic)++instance FromJSON (CaptureUnknownFields ThenElse) where+ parseJSON = captureUnknownFields++instance HasFieldNames ThenElse++instance FromJSON ThenElse where+ parseJSON = genericParseJSON_++data Empty = Empty+ deriving (Eq, Show, Generic)++instance FromJSON Empty where+ parseJSON _ = return Empty++instance HasFieldNames Empty where+ fieldNames _ = []++data PackageConfig = PackageConfig {+ packageConfigName :: Maybe String+, packageConfigVersion :: Maybe String+, packageConfigSynopsis :: Maybe String+, packageConfigDescription :: Maybe String+, packageConfigHomepage :: Maybe (Maybe String)+, packageConfigBugReports :: Maybe (Maybe String)+, packageConfigCategory :: Maybe String+, packageConfigStability :: Maybe String+, packageConfigAuthor :: Maybe (List String)+, packageConfigMaintainer :: Maybe (List String)+, packageConfigCopyright :: Maybe (List String)+, packageConfigLicense :: Maybe String+, packageConfigLicenseFile :: Maybe String+, packageConfigTestedWith :: Maybe String+, packageConfigFlags :: Maybe (Map String (CaptureUnknownFields FlagSection))+, packageConfigExtraSourceFiles :: Maybe (List FilePath)+, packageConfigDataFiles :: Maybe (List FilePath)+, packageConfigGithub :: Maybe Text+, packageConfigGit :: Maybe String+, packageConfigLibrary :: Maybe (CaptureUnknownFields (Section LibrarySection))+, packageConfigExecutables :: Maybe (Map String (CaptureUnknownFields (Section ExecutableSection)))+, packageConfigTests :: Maybe (Map String (CaptureUnknownFields (Section ExecutableSection)))+, packageConfigBenchmarks :: Maybe (Map String (CaptureUnknownFields (Section ExecutableSection)))+} deriving (Eq, Show, Generic)++instance HasFieldNames PackageConfig++instance ToJSON Package where+ toJSON p =+ removeEmptyArrays $+ removeEmptyObjects $+ (\(Object o) -> Object $ case packageSourceRepository p of+ Just repo ->+ let srepo = (sourceRepositoryUrl repo) +++ (fromMaybe "" (sourceRepositorySubdir repo))+ in+ if githubBaseUrl `isPrefixOf` srepo+ then let dropIfGH (Just (String v))+ | githubBaseUrl `isPrefixOf` T.unpack v = Nothing+ dropIfGH v = v+ in+ HashMap.insert "github" (String (T.pack (drop (length githubBaseUrl) srepo))) $+ HashMap.alter dropIfGH "bug-reports" $+ HashMap.alter dropIfGH "homepage" o+ else HashMap.insert "git" (String (T.pack srepo)) o+ Nothing -> o+ ) $+ (\(Object o) -> Object $ HashMap.delete "source-repository" o) $+ (\(Object o) -> Object $ HashMap.mapWithKey convertSingletons o) $+ (\(Object o) ->+ Object $+ HashMap.alter+ (\l -> case l of+ Just "LICENSE" -> Nothing+ _ -> l)+ "license-file"+ o+ ) $+ pullCommonFields "build-tools" $+ pullCommonFields "conditionals" $+ pullCommonFields "buildable" $+ pullCommonFields "ld-options" $+ pullCommonFields "install-includes" $+ pullCommonFields "include-dirs" $+ pullCommonFields "extra-libraries" $+ pullCommonFields "extra-lib-dirs" $+ pullCommonFields "c-sources" $+ pullCommonFields "cc-options" $+ pullCommonFields "cpp-options" $+ pullCommonFields "ghc-prof-options" $+ pullCommonFields "ghc-options" $+ pullCommonFields "other-extensions" $+ pullCommonFields "default-extensions" $+ pullCommonFields "other-modules" $+ pullCommonFields "source-dirs" $+ pullCommonFields "dependencies" (genericToJSON_ p)++pullCommonFields :: Text -> Value -> Value+pullCommonFields field topLevel@(Object topLevelObj) =+ let commonField = let deps = mapMaybe getField [ "library"+ , "executables"+ , "benchmarks"+ , "tests"+ ]+ in maybe [] (\h -> foldl intersect h deps) (listToMaybe deps)+ in mergeObjects (Object (filterCommon commonField)) $+ mergeObjects topLevel (object [ field .= commonField ])+ where+ filterCommon :: [Value] -> HashMap.HashMap Text Value+ filterCommon commonField =+ let helper :: Maybe Value -> Maybe Value+ helper (Just (Array vs)) =+ let v = Vector.filter (not . (`elem` commonField)) vs+ in if Vector.null v then Nothing else Just (Array v)+ helper Nothing = Nothing+ helper (Just v) = Just v+ outerHelper = (\(Object sectObj) -> Object $ HashMap.alter helper field sectObj)+ outermostHelper = (\(Object e) -> Object $ HashMap.map outerHelper e)+ o' = HashMap.adjust outerHelper "library" topLevelObj+ o'' = HashMap.adjust outermostHelper "executables" o'+ o''' = HashMap.adjust outermostHelper "benchmarks" o''+ o'''' = HashMap.adjust outermostHelper "tests" o'''+ in o''''+ getField "library" =+ case (HashMap.lookup "library" topLevelObj >>= unObject) of+ Nothing -> Nothing+ Just lib -> do+ return $ fromMaybe [] (HashMap.lookup field lib >>= unArray)+ getField name =+ case (HashMap.lookup name topLevelObj >>= unObject) of+ Nothing -> Nothing+ Just sect -> do+ blocks <- mapM unObject (map snd (HashMap.toList sect))+ return $ concat $ mapMaybe (HashMap.lookup field >=> unArray) blocks+ unArray (Array v) = Just (Vector.toList v)+ unArray _ = Nothing+ unObject (Object o) = Just o+ unObject _ = Nothing+pullCommonFields _ v = v++omitBuildableTrue :: Value -> Value+omitBuildableTrue (Object o) = Object (HashMap.filterWithKey f o)+ where+ f "buildable" (Bool True) = False+ f _ _ = True+omitBuildableTrue v = v++omitSection :: Value -> Value+omitSection (Object o) = Object $+ HashMap.mapWithKey convertSingletons $+ HashMap.filterWithKey omitSectionEntry o+omitSection v = v++convertSingletons :: Text -> Value -> Value+convertSingletons "ghc-options" (Array a) = convertSingleton a+convertSingletons "cpp-options" (Array a) = convertSingleton a+convertSingletons "cc-options" (Array a) = convertSingleton a+convertSingletons "c-sources" (Array a) = convertSingleton a+convertSingletons "ld-options" (Array a) = convertSingleton a+convertSingletons "ghc-prof-options" (Array a) = convertSingleton a+convertSingletons "extra-lib-dirs" (Array a) = convertSingleton a+convertSingletons "extra-libraries" (Array a) = convertSingleton a+convertSingletons "copyright" (Array a) = convertSingleton a+convertSingletons "maintainer" (Array a) = convertSingleton a+convertSingletons "author" (Array a) = convertSingleton a+convertSingletons "source-dirs" (Array a) = convertSingleton a+convertSingletons _ v = v++convertSingleton :: Vector.Vector Value -> Value+convertSingleton a =+ if Vector.length a == 1+ then Vector.head a+ else Array a++omitSectionEntry :: Text -> Value -> Bool+omitSectionEntry "license-file" "LICENSE" = False+omitSectionEntry "data" _ = False+omitSectionEntry "conditionals" _ = False+omitSectionEntry "name" _ = False+omitSectionEntry "exposed" (Bool True) = False+omitSectionEntry "other-modules" _ = False+omitSectionEntry _ _ = True++mergeObjects :: Value -> Value -> Value+mergeObjects (Object o1) (Object o2) = Object (o1 `mappend` o2)+mergeObjects (Object o1) _ = Object o1+mergeObjects _ (Object o2) = Object o2+mergeObjects v _ = v++instance ToJSON [Section Executable] where+ toJSON ss = Object $+ HashMap.fromList $ map helper ss+ where+ helper sect@Section{..} = ( T.pack (executableName sectionData)+ , toJSON sect+ )++instance {-# OVERLAPS #-} ToJSON (Section ()) where+ toJSON sect@Section{..} =+ (omitSection+ (mergeObjects+ (mergeObjects+ (genericToJSON_ sect)+ (toJSON sectionData))+ (object $ case sectionConditionals of+ [] -> []+ cs -> case toJSON (omitRedundantBuildables cs) of+ Array [] -> []+ Array csObjs -> case Vector.filter (/= Object mempty) csObjs of+ [] -> []+ csV -> ["when" .= csV]+ v -> ["when" .= v])))+ where+ omitRedundantBuildables = map $ \(Conditional c i e) ->+ Conditional c (omitRedundantBuildable i) (omitRedundantBuildable <$> e)+ omitRedundantBuildable s+ | fromMaybe True sectionBuildable ==+ fromMaybe True (Hpack.Config.sectionBuildable s) =+ s {sectionBuildable = Nothing}+ omitRedundantBuildable s = s++instance (Generic (Section a), GToJSON (Rep (Section a)), HasTypeName (Section a),+ ToJSON a) => ToJSON (Section a) where+ toJSON sect@Section{..} =+ omitBuildableTrue (omitSection+ (mergeObjects+ (mergeObjects+ (genericToJSON_ sect)+ (toJSON sectionData))+ (object $ case sectionConditionals of+ [] -> []+ cs -> case toJSON (omitRedundantBuildables cs) of+ Array [] -> []+ Array csObjs -> case Vector.filter (/= Object mempty) csObjs of+ [] -> []+ csV -> ["when" .= csV]+ csArr -> ["when" .= csArr])))+ where+ omitRedundantBuildables = map $ \(Conditional c i e) ->+ Conditional c (omitRedundantBuildable i) (omitRedundantBuildable <$> e)+ omitRedundantBuildable s+ | fromMaybe True sectionBuildable ==+ fromMaybe True (Hpack.Config.sectionBuildable s) =+ s {sectionBuildable = Nothing}+ omitRedundantBuildable s = s++instance ToJSON Conditional where+ toJSON (Conditional cnd ifSection Nothing) = case toJSON ifSection of+ -- If an empty block is generated strip it out+ Object [] -> object []+ ifSectionObj -> mergeObjects (object [ "condition" .= toJSON cnd ]) ifSectionObj+ toJSON (Conditional cnd ifSection (Just elseSection)) = case toJSON ifSection of+ -- If an empty block is at the if statement negate the condition+ Object [] -> toJSON (Conditional ("!(" ++ cnd ++ ")") elseSection Nothing)+ ifSectionObj -> case toJSON elseSection of+ Object [] -> toJSON (Conditional cnd ifSection Nothing)+ elseSectionObj ->+ object [ "condition" .= toJSON cnd+ , "then" .= ifSectionObj+ , "else" .= elseSectionObj+ ]++instance ToJSON AddSource where+ toJSON = genericToJSON_++instance ToJSON Dependency where+ toJSON (Dependency d Nothing) = fromString d+ toJSON (Dependency d (Just ref)) =+ object ([ "name" .= d+ ] `mappend` case toJSON ref of+ Object ps -> HashMap.toList ps+ _ -> mempty)++instance ToJSON Executable where+ toJSON = genericToJSON_++instance ToJSON Library where+ toJSON = genericToJSON_++instance ToJSON [Flag] where+ toJSON fs = Object $+ HashMap.fromList $ map helper fs+ where+ helper Flag{..} = ( T.pack flagName+ , object [ "description" .= toJSON flagDescription+ , "manual" .= toJSON flagManual+ , "default" .= toJSON flagDefault+ ]+ )++instance ToJSON SourceRepository where+ toJSON = genericToJSON_++instance FromJSON PackageConfig where+ parseJSON value = handleNullValues <$> genericParseJSON_ value+ where+ handleNullValues :: PackageConfig -> PackageConfig+ handleNullValues =+ ifNull "homepage" (\p -> p {packageConfigHomepage = Just Nothing})+ . ifNull "bug-reports" (\p -> p {packageConfigBugReports = Just Nothing})++ ifNull :: String -> (a -> a) -> a -> a+ ifNull name f+ | isNull name value = f+ | otherwise = id++isNull :: String -> Value -> Bool+isNull name value = case parseMaybe p value of+ Just Null -> True+ _ -> False+ where+ p = parseJSON >=> (.: fromString name)++encodePackage :: Package -> ByteString+encodePackage pkg = Yaml.encodePretty config pkg+ where+ config = Yaml.setConfCompare keyWeight Yaml.defConfig+ keys = [ "condition"+ , "then"+ , "else"+ , "name"+ , "version"+ , "synopsis"+ , "description"+ , "category"+ , "author"+ , "maintainer"+ , "copyright"+ , "license"+ , "license-file"+ , "github"+ , "homepage"+ , "git"+ , "bug-reports"+ , "main"+ , "source-dirs"+ , "extra-source-files"+ , "c-sources"+ , "default-extensions"+ , "other-extensions"+ , "ghc-options"+ , "ghc-prof-options"+ , "cc-options"+ , "cpp-options"+ , "ld-options"+ , "extra-lib-dirs"+ , "extra-libraries"+ , "include-dirs"+ , "install-includes"+ , "build-tools"+ , "exposed-modules"+ , "dependencies"+ , "buildable"+ , "when"+ , "library"+ , "executables"+ , "tests"+ , "benchmarks"+ ]+ keyWeight k1 k2 =+ fromMaybe maxBound (elemIndex k1 keys)+ `compare`+ fromMaybe maxBound (elemIndex k2 keys)++writePackage :: FilePath -> Package -> IO ()+writePackage fp pkg = ByteString.writeFile fp (encodePackage pkg)++readPackageConfig :: FilePath -> IO (Either String ([String], Package))+readPackageConfig file = do+ r <- decodeYaml file+ case r of+ Left err -> return (Left err)+ Right config -> do+ dir <- takeDirectory <$> canonicalizePath file+ Right <$> mkPackage dir config++data Dependency = Dependency {+ dependencyName :: String+, dependencyGitRef :: Maybe AddSource+} deriving (Eq, Show, Ord, Generic)++instance IsString Dependency where+ fromString name = Dependency name Nothing++instance FromJSON Dependency where+ parseJSON v = case v of+ String _ -> fromString <$> parseJSON v+ Object o -> addSourceDependency o+ _ -> typeMismatch "String or an Object" v+ where+ addSourceDependency o = Dependency <$> name <*> (Just <$> (local <|> git))+ where+ name :: Parser String+ name = o .: "name"++ local :: Parser AddSource+ local = Local <$> o .: "path"++ git :: Parser AddSource+ git = GitRef <$> url <*> ref <*> subdir++ url :: Parser String+ url =+ ((githubBaseUrl ++) <$> o .: "github")+ <|> (o .: "git")+ <|> fail "neither key \"git\" nor key \"github\" present"++ ref :: Parser String+ ref = o .: "ref"++ subdir :: Parser (Maybe FilePath)+ subdir = o .:? "subdir"++data AddSource = GitRef GitUrl GitRef (Maybe FilePath) | Local FilePath+ deriving (Eq, Show, Ord, Generic)++type GitUrl = String+type GitRef = String++data Package = Package {+ packageName :: String+, packageVersion :: String+, packageSynopsis :: Maybe String+, packageDescription :: Maybe String+, packageHomepage :: Maybe String+, packageBugReports :: Maybe String+, packageCategory :: Maybe String+, packageStability :: Maybe String+, packageAuthor :: [String]+, packageMaintainer :: [String]+, packageCopyright :: [String]+, packageLicense :: Maybe String+, packageLicenseFile :: Maybe FilePath+, packageTestedWith :: Maybe String+, packageFlags :: [Flag]+, packageExtraSourceFiles :: [FilePath]+, packageDataFiles :: [FilePath]+, packageSourceRepository :: Maybe SourceRepository+, packageLibrary :: Maybe (Section Library)+, packageExecutables :: [Section Executable]+, packageTests :: [Section Executable]+, packageBenchmarks :: [Section Executable]+} deriving (Eq, Show, Generic)++data Library = Library {+ libraryExposed :: Maybe Bool+, libraryExposedModules :: [String]+, libraryOtherModules :: [String]+, libraryReexportedModules :: [String]+} deriving (Eq, Show, Generic)++data Executable = Executable {+ executableName :: String+, executableMain :: FilePath+, executableOtherModules :: [String]+} deriving (Eq, Show, Generic)++data Section a = Section {+ sectionData :: a+, sectionSourceDirs :: [FilePath]+, sectionDependencies :: [Dependency]+, sectionDefaultExtensions :: [String]+, sectionOtherExtensions :: [String]+, sectionGhcOptions :: [GhcOption]+, sectionGhcProfOptions :: [GhcProfOption]+, sectionCppOptions :: [CppOption]+, sectionCCOptions :: [CCOption]+, sectionCSources :: [FilePath]+, sectionExtraLibDirs :: [FilePath]+, sectionExtraLibraries :: [FilePath]+, sectionIncludeDirs :: [FilePath]+, sectionInstallIncludes :: [FilePath]+, sectionLdOptions :: [LdOption]+, sectionBuildable :: Maybe Bool+, sectionConditionals :: [Conditional]+, sectionBuildTools :: [Dependency]+} deriving (Eq, Show, Functor, Foldable, Traversable, Generic)++data Conditional = Conditional {+ conditionalCondition :: String+, conditionalThen :: Section ()+, conditionalElse :: Maybe (Section ())+} deriving (Eq, Show, Generic)++instance HasFieldNames a => HasFieldNames (Section a) where+ fieldNames Proxy = fieldNames (Proxy :: Proxy a) ++ fieldNames (Proxy :: Proxy CommonOptions)++data FlagSection = FlagSection {+ _flagSectionDescription :: Maybe String+, _flagSectionManual :: Bool+, _flagSectionDefault :: Bool+} deriving (Eq, Show, Generic)++instance HasFieldNames FlagSection++instance FromJSON FlagSection where+ parseJSON = genericParseJSON_++data Flag = Flag {+ flagName :: String+, flagDescription :: Maybe String+, flagManual :: Bool+, flagDefault :: Bool+} deriving (Eq, Show, Generic)++toFlag :: (String, FlagSection) -> Flag+toFlag (name, FlagSection description manual def) = Flag name description manual def++data SourceRepository = SourceRepository {+ sourceRepositoryUrl :: String+, sourceRepositorySubdir :: Maybe String+} deriving (Eq, Show, Generic)++mkPackage :: FilePath -> (CaptureUnknownFields (Section PackageConfig)) -> IO ([String], Package)+mkPackage dir (CaptureUnknownFields unknownFields globalOptions@Section{sectionData = PackageConfig{..}}) = do+ let name = fromMaybe (takeBaseName dir) packageConfigName++ mLibrary <- mapM (toLibrary dir name globalOptions) mLibrarySection+ executables <- toExecutables dir globalOptions (map (fmap captureUnknownFieldsValue) executableSections)+ tests <- toExecutables dir globalOptions (map (fmap captureUnknownFieldsValue) testsSections)+ benchmarks <- toExecutables dir globalOptions (map (fmap captureUnknownFieldsValue) benchmarkSections)++ licenseFileExists <- doesFileExist (dir </> "LICENSE")++ missingSourceDirs <- nub . sort <$> filterM (fmap not <$> doesDirectoryExist . (dir </>)) (+ maybe [] sectionSourceDirs mLibrary+ ++ concatMap sectionSourceDirs executables+ ++ concatMap sectionSourceDirs tests+ ++ concatMap sectionSourceDirs benchmarks+ )++ (extraSourceFilesWarnings, extraSourceFiles) <-+ expandGlobs dir (fromMaybeList packageConfigExtraSourceFiles)++ (dataFilesWarnings, dataFiles) <-+ expandGlobs dir (fromMaybeList packageConfigDataFiles)++ let pkg = Package {+ packageName = name+ , packageVersion = fromMaybe "0.0.0" packageConfigVersion+ , packageSynopsis = packageConfigSynopsis+ , packageDescription = packageConfigDescription+ , packageHomepage = homepage+ , packageBugReports = bugReports+ , packageCategory = packageConfigCategory+ , packageStability = packageConfigStability+ , packageAuthor = fromMaybeList packageConfigAuthor+ , packageMaintainer = fromMaybeList packageConfigMaintainer+ , packageCopyright = fromMaybeList packageConfigCopyright+ , packageLicense = packageConfigLicense+ , packageLicenseFile = packageConfigLicenseFile <|> (guard licenseFileExists >> Just "LICENSE")+ , packageTestedWith = packageConfigTestedWith+ , packageFlags = flags+ , packageExtraSourceFiles = extraSourceFiles+ , packageDataFiles = dataFiles+ , packageSourceRepository = sourceRepository+ , packageLibrary = mLibrary+ , packageExecutables = executables+ , packageTests = tests+ , packageBenchmarks = benchmarks+ }++ warnings =+ formatUnknownFields "package description" unknownFields+ ++ flagWarnings+ ++ maybe [] (formatUnknownFields "library section") (captureUnknownFieldsFields <$> packageConfigLibrary)+ ++ formatUnknownSectionFields "executable" executableSections+ ++ formatUnknownSectionFields "test" testsSections+ ++ formatMissingSourceDirs missingSourceDirs+ ++ extraSourceFilesWarnings+ ++ dataFilesWarnings++ return (warnings, pkg)+ where+ executableSections :: [(String, CaptureUnknownFields (Section ExecutableSection))]+ executableSections = toList packageConfigExecutables++ testsSections :: [(String, CaptureUnknownFields (Section ExecutableSection))]+ testsSections = toList packageConfigTests++ benchmarkSections :: [(String, CaptureUnknownFields (Section ExecutableSection))]+ benchmarkSections = toList packageConfigBenchmarks++ (flagWarnings, flags) = (concatMap formatUnknownFlagFields xs, map (toFlag . fmap captureUnknownFieldsValue) xs)+ where+ xs :: [(String, CaptureUnknownFields FlagSection)]+ xs = toList packageConfigFlags++ formatUnknownFlagFields :: (String, CaptureUnknownFields a) -> [String]+ formatUnknownFlagFields (name, fields) = map f (captureUnknownFieldsFields fields)+ where f field = "Ignoring unknown field " ++ show field ++ " for flag " ++ show name++ toList :: Maybe (Map String a) -> [(String, a)]+ toList = Map.toList . fromMaybe mempty++ mLibrarySection :: Maybe (Section LibrarySection)+ mLibrarySection = captureUnknownFieldsValue <$> packageConfigLibrary++ formatUnknownFields :: String -> [FieldName] -> [String]+ formatUnknownFields name = map f . sort+ where+ f field = "Ignoring unknown field " ++ show field ++ " in " ++ name++ formatUnknownSectionFields :: String -> [(String, CaptureUnknownFields a)] -> [String]+ formatUnknownSectionFields sectionType = concatMap f . map (fmap captureUnknownFieldsFields)+ where+ f :: (String, [String]) -> [String]+ f (sect, fields) = formatUnknownFields (sectionType ++ " section " ++ show sect) fields++ formatMissingSourceDirs = map f+ where+ f name = "Specified source-dir " ++ show name ++ " does not exist"++ sourceRepository :: Maybe SourceRepository+ sourceRepository = github <|> (`SourceRepository` Nothing) <$> packageConfigGit++ github :: Maybe SourceRepository+ github = parseGithub <$> packageConfigGithub+ where+ parseGithub :: Text -> SourceRepository+ parseGithub input = case map T.unpack $ T.splitOn "/" input of+ [user, repo, subdir] ->+ SourceRepository (githubBaseUrl ++ user ++ "/" ++ repo) (Just subdir)+ _ -> SourceRepository (githubBaseUrl ++ T.unpack input) Nothing++ homepage :: Maybe String+ homepage = case packageConfigHomepage of+ Just Nothing -> Nothing+ _ -> join packageConfigHomepage <|> fromGithub+ where+ fromGithub = (++ "#readme") . sourceRepositoryUrl <$> github++ bugReports :: Maybe String+ bugReports = case packageConfigBugReports of+ Just Nothing -> Nothing+ _ -> join packageConfigBugReports <|> fromGithub+ where+ fromGithub = (++ "/issues") . sourceRepositoryUrl <$> github++toLibrary :: FilePath -> String -> Section global -> Section LibrarySection -> IO (Section Library)+toLibrary dir name globalOptions library = traverse fromLibrarySection sect+ where+ sect :: Section LibrarySection+ sect = mergeSections globalOptions library++ sourceDirs :: [FilePath]+ sourceDirs = sectionSourceDirs sect++ 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)++toExecutables :: FilePath -> Section global -> [(String, Section ExecutableSection)] -> IO [Section Executable]+toExecutables dir globalOptions executables = mapM toExecutable sections+ where+ sections :: [(String, Section ExecutableSection)]+ sections = map (fmap $ mergeSections globalOptions) executables++ toExecutable :: (String, Section ExecutableSection) -> IO (Section Executable)+ toExecutable (name, sect@Section{..}) = do+ (executable, ghcOptions) <- fromExecutableSection sectionData+ return (sect {sectionData = executable, sectionGhcOptions = sectionGhcOptions ++ ghcOptions})+ where+ fromExecutableSection :: ExecutableSection -> IO (Executable, [GhcOption])+ fromExecutableSection ExecutableSection{..} = do+ modules <- maybe (filterMain . concat <$> mapM (getModules dir) sectionSourceDirs) (return . fromList) executableSectionOtherModules+ return (Executable name mainSrcFile modules, ghcOptions)+ where+ filterMain :: [String] -> [String]+ filterMain = maybe id (filter . (/=)) (toModule $ splitDirectories executableSectionMain)++ (mainSrcFile, ghcOptions) = parseMain executableSectionMain++mergeSections :: Section global -> Section a -> Section a+mergeSections globalOptions options+ = Section {+ sectionData = sectionData options+ , sectionSourceDirs = sectionSourceDirs globalOptions ++ sectionSourceDirs options+ , sectionDefaultExtensions = sectionDefaultExtensions globalOptions ++ sectionDefaultExtensions options+ , sectionOtherExtensions = sectionOtherExtensions globalOptions ++ sectionOtherExtensions options+ , sectionGhcOptions = sectionGhcOptions globalOptions ++ sectionGhcOptions options+ , sectionGhcProfOptions = sectionGhcProfOptions globalOptions ++ sectionGhcProfOptions options+ , sectionCppOptions = sectionCppOptions globalOptions ++ sectionCppOptions options+ , sectionCCOptions = sectionCCOptions globalOptions ++ sectionCCOptions options+ , sectionCSources = sectionCSources globalOptions ++ sectionCSources options+ , sectionExtraLibDirs = sectionExtraLibDirs globalOptions ++ sectionExtraLibDirs options+ , sectionExtraLibraries = sectionExtraLibraries globalOptions ++ sectionExtraLibraries options+ , sectionIncludeDirs = sectionIncludeDirs globalOptions ++ sectionIncludeDirs options+ , sectionInstallIncludes = sectionInstallIncludes globalOptions ++ sectionInstallIncludes options+ , sectionLdOptions = sectionLdOptions globalOptions ++ sectionLdOptions options+ , sectionBuildable = sectionBuildable options <|> sectionBuildable globalOptions+ , sectionDependencies = sectionDependencies globalOptions ++ sectionDependencies options+ , sectionConditionals = sectionConditionals globalOptions ++ sectionConditionals options+ , sectionBuildTools = sectionBuildTools globalOptions ++ sectionBuildTools options+ }++toSection :: a -> CommonOptions -> ([FieldName], Section a)+toSection a CommonOptions{..}+ = ( concat unknownFields+ , Section {+ sectionData = a+ , sectionSourceDirs = fromMaybeList commonOptionsSourceDirs+ , sectionDefaultExtensions = fromMaybeList commonOptionsDefaultExtensions+ , sectionOtherExtensions = fromMaybeList commonOptionsOtherExtensions+ , sectionGhcOptions = fromMaybeList commonOptionsGhcOptions+ , sectionGhcProfOptions = fromMaybeList commonOptionsGhcProfOptions+ , sectionCppOptions = fromMaybeList commonOptionsCppOptions+ , sectionCCOptions = fromMaybeList commonOptionsCCOptions+ , sectionCSources = fromMaybeList commonOptionsCSources+ , sectionExtraLibDirs = fromMaybeList commonOptionsExtraLibDirs+ , sectionExtraLibraries = fromMaybeList commonOptionsExtraLibraries+ , sectionIncludeDirs = fromMaybeList commonOptionsIncludeDirs+ , sectionInstallIncludes = fromMaybeList commonOptionsInstallIncludes+ , sectionLdOptions = fromMaybeList commonOptionsLdOptions+ , sectionBuildable = commonOptionsBuildable+ , sectionDependencies = fromMaybeList commonOptionsDependencies+ , sectionConditionals = conditionals+ , sectionBuildTools = fromMaybeList commonOptionsBuildTools+ }+ )+ where+ (unknownFields, conditionals) = unzip (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)++pathsModuleFromPackageName :: String -> String+pathsModuleFromPackageName name = "Paths_" ++ map f name+ where+ f '-' = '_'+ f x = x++determineModules :: String -> [String] -> Maybe (List String) -> Maybe (List String) -> ([String], [String])+determineModules name modules mExposedModules mOtherModules = case (mExposedModules, mOtherModules) of+ (Nothing, Nothing) -> (modules, [])+ _ -> (exposedModules, otherModules)+ where+ otherModules = maybe ((modules \\ exposedModules) ++ pathsModule) fromList mOtherModules+ exposedModules = maybe (modules \\ otherModules) fromList mExposedModules+ pathsModule = [pathsModuleFromPackageName name] \\ exposedModules++getModules :: FilePath -> FilePath -> IO [String]+getModules dir src_ = sort <$> do+ exists <- doesDirectoryExist (dir </> src_)+ if exists+ then do+ src <- canonicalizePath (dir </> src_)+ removeSetup src . toModules <$> getFilesRecursive src+ else return []+ where+ toModules :: [[FilePath]] -> [String]+ toModules = catMaybes . map toModule++ removeSetup :: FilePath -> [String] -> [String]+ removeSetup src+ | src == dir = filter (/= "Setup")+ | otherwise = id++fromMaybeList :: Maybe (List a) -> [a]+fromMaybeList = maybe [] fromList
+ src/Hpack/Convert.hs view
@@ -0,0 +1,264 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+module Hpack.Convert where++import Control.Applicative+import Data.Maybe+import qualified Data.Version as Version+import qualified Distribution.Compiler as Compiler+import qualified Distribution.InstalledPackageInfo as Cabal+import qualified Distribution.Package as Cabal+import qualified Distribution.PackageDescription as Cabal+import qualified Distribution.PackageDescription.Parse as Cabal+import qualified Distribution.Text as Cabal+import qualified Distribution.Version as Cabal+import Hpack.Config hiding (package)+import Text.PrettyPrint (fsep, (<+>))++-- * Public API++-- | Reads a 'Package' from cabal's 'GenericPackageDescription' representation+-- of a @.cabal@ file+fromPackageDescription :: Cabal.GenericPackageDescription -> Package+fromPackageDescription Cabal.GenericPackageDescription{..} =+ let Cabal.PackageDescription{..} = packageDescription+ in+ Package { packageName = Cabal.unPackageName (Cabal.pkgName package)+ , packageVersion = Version.showVersion (Cabal.pkgVersion package)+ , packageSynopsis = nullNothing synopsis+ , packageDescription = nullNothing description+ , packageHomepage = nullNothing homepage+ , packageBugReports = nullNothing bugReports+ , packageCategory = nullNothing category+ , packageStability = nullNothing stability+ , packageAuthor = maybeToList (nullNothing author)+ , packageMaintainer = maybeToList (nullNothing maintainer)+ , packageCopyright = maybeToList (nullNothing copyright)+ , packageLicense = Just (show (Cabal.disp license))+ , packageLicenseFile = listToMaybe licenseFiles+ , packageTestedWith =+ show .+ fsep . map (\(f, vr) -> Cabal.disp f <+> Cabal.disp vr ) <$>+ nullNothing testedWith+ , packageFlags =+ map (\Cabal.MkFlag{..} ->+ let Cabal.FlagName fn = flagName+ in Flag { flagName = fn+ , flagDescription =+ nullNothing flagDescription+ , flagManual = flagManual+ , flagDefault = flagDefault+ })+ genPackageFlags+ , packageExtraSourceFiles = extraSrcFiles+ , packageDataFiles = dataFiles+ , packageSourceRepository = fromSourceRepos sourceRepos+ , packageLibrary = fromCondLibrary condLibrary+ , packageExecutables = fromCondExecutables condExecutables+ , packageTests = fromCondTestSuites condTestSuites+ , packageBenchmarks = fromCondBenchmarks condBenchmarks+ }++-- | Reads a 'Package' from a @.cabal@ manifest string+fromPackageDescriptionString :: String -> Either ConvertError Package+fromPackageDescriptionString pkgStr =+ case Cabal.parsePackageDescription pkgStr of+ Cabal.ParseFailed e -> Left (ConvertCabalParseError e)+ Cabal.ParseOk _ gpkg -> Right (fromPackageDescription gpkg)++data ConvertError = ConvertCabalParseError Cabal.PError+ deriving(Show, Eq)++-- data ConvertWarning = CWIgnoreSection String+-- | CWIgnoreCondition String+-- | CWIgnoreSourceRepo Cabal.SourceRepo+-- | CWSourceRepoWithoutUrl Cabal.SourceRepo++-- * Private functions for converting each section++fromSourceRepos :: [Cabal.SourceRepo] -> Maybe SourceRepository+fromSourceRepos [] = Nothing+fromSourceRepos (_repo@Cabal.SourceRepo{..}:_more) =+ -- (+ Just SourceRepository { sourceRepositoryUrl = fromMaybe "" repoLocation+ -- TODO - this is broken (?)+ , sourceRepositorySubdir = repoSubdir+ }+ -- TODO - Warnings+ -- , case repoLocation of+ -- Nothing -> [CWSourceRepoWithoutUrl repo]+ -- _ -> []+ -- ++ map CWIgnoreSourceRepo more+ -- )++fromDependency :: Cabal.Dependency -> Dependency+fromDependency (Cabal.Dependency pn Cabal.AnyVersion) =+ Dependency (show (Cabal.disp pn)) Nothing+fromDependency (Cabal.Dependency pn vr) =+ Dependency (show (Cabal.disp pn <+> Cabal.disp vr)) Nothing++fromCondLibrary :: Maybe (Cabal.CondTree Cabal.ConfVar [Cabal.Dependency] Cabal.Library) -> Maybe (Section Library)+fromCondLibrary mcondLibrary = do+ condLibrary@(Cabal.CondNode Cabal.Library{libBuildInfo} _ components) <- mcondLibrary+ l <- libFromCondLibrary condLibrary+ return (sectionWithBuildInfo l libBuildInfo)+ { sectionConditionals = map fromCondComponentHasBuildInfo components+ }++fromCondExecutables :: [(String, Cabal.CondTree Cabal.ConfVar [Cabal.Dependency] Cabal.Executable)] -> [Section Executable]+fromCondExecutables = map fromCondExecutableTup++fromCondTestSuites :: [(String, Cabal.CondTree Cabal.ConfVar [Cabal.Dependency] Cabal.TestSuite)] -> [Section Executable]+fromCondTestSuites = mapMaybe fromCondTestSuiteTup++fromCondBenchmarks :: [(String, Cabal.CondTree Cabal.ConfVar [Cabal.Dependency] Cabal.Benchmark)] -> [Section Executable]+fromCondBenchmarks = mapMaybe fromCondBenchmarkTup++fromCondExecutableTup :: (String, Cabal.CondTree Cabal.ConfVar [Cabal.Dependency] Cabal.Executable) -> Section Executable+fromCondExecutableTup etup@(_, Cabal.CondNode Cabal.Executable{buildInfo} _ components) =+ let e = exeFromCondExecutableTup etup+ in (sectionWithBuildInfo e buildInfo)+ { sectionConditionals = map fromCondComponentHasBuildInfo components+ }++fromCondTestSuiteTup :: (String, Cabal.CondTree Cabal.ConfVar [Cabal.Dependency] Cabal.TestSuite) -> Maybe (Section Executable)+fromCondTestSuiteTup ttup@(_, Cabal.CondNode Cabal.TestSuite{testBuildInfo} _ components) = do+ te <- testExeFromCondExecutableTup ttup+ return (sectionWithBuildInfo te testBuildInfo)+ { sectionConditionals = map fromCondComponentHasBuildInfo components+ }++fromCondBenchmarkTup :: (String, Cabal.CondTree Cabal.ConfVar [Cabal.Dependency] Cabal.Benchmark) -> Maybe (Section Executable)+fromCondBenchmarkTup btup@(_, Cabal.CondNode Cabal.Benchmark{benchmarkBuildInfo} _ components) = do+ be <- benchExeFromCondExecutableTup btup+ return (sectionWithBuildInfo be benchmarkBuildInfo)+ { sectionConditionals = map fromCondComponentHasBuildInfo components+ }++-- * Conditional Mapping+class HasBuildInfo a where+ getBuildInfo :: a -> Cabal.BuildInfo++instance HasBuildInfo Cabal.Library where+ getBuildInfo Cabal.Library{libBuildInfo} = libBuildInfo++instance HasBuildInfo Cabal.Executable where+ getBuildInfo Cabal.Executable{buildInfo} = buildInfo++instance HasBuildInfo Cabal.TestSuite where+ getBuildInfo Cabal.TestSuite{testBuildInfo} = testBuildInfo++instance HasBuildInfo Cabal.Benchmark where+ getBuildInfo Cabal.Benchmark{benchmarkBuildInfo} = benchmarkBuildInfo++fromCondHasBuildInfo :: HasBuildInfo a => Cabal.CondTree Cabal.ConfVar [Cabal.Dependency] a -> Section ()+fromCondHasBuildInfo (Cabal.CondNode hbi _ components) =+ let bi = getBuildInfo hbi+ in (sectionWithBuildInfo () bi)+ { sectionConditionals = map fromCondComponentHasBuildInfo components+ }++fromCondComponentHasBuildInfo :: (HasBuildInfo a)+ => ( Cabal.Condition Cabal.ConfVar+ , Cabal.CondTree Cabal.ConfVar [Cabal.Dependency] a+ , Maybe (Cabal.CondTree Cabal.ConfVar [Cabal.Dependency] a)+ )+ -> Conditional+fromCondComponentHasBuildInfo (cond, ifTree, elseTree) =+ Conditional { conditionalCondition = fromCondition cond+ , conditionalThen = fromCondHasBuildInfo ifTree+ , conditionalElse = fromCondHasBuildInfo <$> elseTree+ }++fromCondition :: Cabal.Condition Cabal.ConfVar -> String+fromCondition (Cabal.Var c) = case c of+ Cabal.OS os -> "os(" ++ show (Cabal.disp os) ++ ")"+ Cabal.Flag (Cabal.FlagName fl) -> "flag(" ++ fl ++ ")"+ Cabal.Arch ar -> "arch(" ++ show (Cabal.disp ar) ++ ")"+ Cabal.Impl cc vr -> "impl(" ++ show (Cabal.disp cc <+> Cabal.disp vr) ++ ")"+fromCondition (Cabal.CNot c) = "!(" ++ fromCondition c ++ ")"+fromCondition (Cabal.COr c1 c2) = "(" ++ fromCondition c1 ++ ") || (" ++ fromCondition c2 ++ ")"+fromCondition (Cabal.CAnd c1 c2) = "(" ++ fromCondition c1 ++ ") && (" ++ fromCondition c2 ++ ")"+fromCondition (Cabal.Lit b) = show b+++-- * Private helpers++-- | Builds a 'Package' 'Section' from a data entity and a 'BuildInfo' entity+sectionWithBuildInfo :: a -> Cabal.BuildInfo -> Section a+sectionWithBuildInfo d Cabal.BuildInfo{..} =+ Section { sectionData = d+ , sectionSourceDirs = hsSourceDirs+ , sectionDependencies = map fromDependency targetBuildDepends+ , sectionDefaultExtensions = map (show . Cabal.disp)+ defaultExtensions+ , sectionOtherExtensions = map (show . Cabal.disp) otherExtensions+ , sectionGhcOptions = fromMaybe [] $+ lookup Compiler.GHC options+ , sectionGhcProfOptions = fromMaybe [] $+ lookup Compiler.GHC profOptions+ , sectionCppOptions = cppOptions+ , sectionCCOptions = ccOptions+ , sectionCSources = cSources+ , sectionExtraLibDirs = extraLibDirs+ , sectionExtraLibraries = extraLibs+ , sectionIncludeDirs = includeDirs+ , sectionInstallIncludes = installIncludes+ , sectionLdOptions = ldOptions+ , sectionBuildable = Just buildable+ -- TODO ^^ ????+ , sectionConditionals = []+ -- TODO ^^ ????+ , sectionBuildTools = map fromDependency buildTools+ }++libFromCondLibrary :: Cabal.CondTree Cabal.ConfVar [Cabal.Dependency] Cabal.Library -> Maybe Library+libFromCondLibrary (Cabal.CondNode (Cabal.Library{..}) _ _) = do+ let Cabal.BuildInfo{..} = libBuildInfo+ return Library { libraryExposed = Just libExposed+ , libraryExposedModules = map (show . Cabal.disp)+ exposedModules+ , libraryOtherModules = map (show . Cabal.disp) otherModules+ , libraryReexportedModules = map (show . Cabal.disp)+ reexportedModules+ }++exeFromCondExecutableTup :: (String, Cabal.CondTree Cabal.ConfVar [Cabal.Dependency] Cabal.Executable) -> Executable+exeFromCondExecutableTup (name, Cabal.CondNode Cabal.Executable{..} _ _) =+ Executable { executableName = name+ , executableMain = modulePath+ , executableOtherModules = map (show . Cabal.disp)+ (Cabal.otherModules buildInfo)+ }++testExeFromCondExecutableTup :: (String, Cabal.CondTree Cabal.ConfVar [Cabal.Dependency] Cabal.TestSuite) -> Maybe Executable+testExeFromCondExecutableTup (name, Cabal.CondNode Cabal.TestSuite{..} _ _) =+ case testInterface of+ Cabal.TestSuiteExeV10 _ mainIs -> Just+ Executable { executableName = name+ , executableMain = mainIs+ , executableOtherModules = map (show . Cabal.disp)+ (Cabal.otherModules testBuildInfo)+ }+ _ -> Nothing++benchExeFromCondExecutableTup :: (String, Cabal.CondTree Cabal.ConfVar [Cabal.Dependency] Cabal.Benchmark) -> Maybe Executable+benchExeFromCondExecutableTup (name, Cabal.CondNode Cabal.Benchmark{..} _ _) =+ case benchmarkInterface of+ Cabal.BenchmarkExeV10 _ mainIs -> Just+ Executable { executableName = name+ , executableMain = mainIs+ , executableOtherModules = map (show . Cabal.disp)+ (Cabal.otherModules benchmarkBuildInfo)+ }+ _ -> Nothing++-- | Returns Nothing if a list is empty and Just the list otherwise+--+-- >>> nullNothing []+-- Nothing+-- >>> nullNothing [1, 2, 3]+-- Just [1, 2, 3]+nullNothing :: [a] -> Maybe [a]+nullNothing s = const s <$> listToMaybe s
+ src/Hpack/Convert/Run.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE TupleSections #-}+module Hpack.Convert.Run+ ( runConvert+ )+ where++import Control.Applicative+import Control.Monad+import Data.List+import Data.Maybe+import System.Directory+import System.Environment+import System.Exit+import System.FilePath+import System.FilePath.Glob++import Hpack.Config+import Hpack.Convert++runConvert :: IO ()+runConvert = do+ as <- getArgs+ (dir, cabalFileFP) <- case as of+ (dir:_) -> do+ isFile <- doesFileExist dir+ if takeExtension dir == ".cabal" && isFile+ then return (takeDirectory dir, dir)+ else (dir,) <$> findCabalFileFP dir+ _ -> do+ cwd <- getCurrentDirectory+ cabalFileFP <- findCabalFileFP cwd+ return (cwd, cabalFileFP)+ pkg <- runConvert' dir cabalFileFP+ writePackage (dir </> "package.yaml") pkg+ putStrLn $ "generated package.yaml based on " ++ cabalFileFP++findCabalFileFP :: FilePath -> IO FilePath+findCabalFileFP dir = do+ mcabalFileFP <- listToMaybe <$> globDir1 (compile "*.cabal") dir+ case mcabalFileFP of+ Nothing -> die "No cabal file in the current directory"+ Just cabalFileFP -> return cabalFileFP++runConvert' :: FilePath -> FilePath -> IO Package+runConvert' dir cabalFileFP = do+ mpackageYaml <- find (== "package.yaml") <$> getDirectoryContents dir++ when (isJust mpackageYaml) $+ die $ (dir </> "package.yaml") ++ " already exists"++ old <- readFile cabalFileFP+ case fromPackageDescriptionString old of+ Left err -> die (show err)+ Right pkg -> return pkg
+ src/Hpack/FormattingHints.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ViewPatterns #-}+module Hpack.FormattingHints (+ FormattingHints (..)+, sniffFormattingHints+#ifdef TEST+, extractFieldOrder+, extractSectionsFieldOrder+, breakLines+, unindent+, sniffAlignment+, splitField+, sniffIndentation+, sniffCommaStyle+#endif+) where++import Prelude ()+import Prelude.Compat++import Data.Char+import Data.Maybe+import Data.List.Compat+import Control.Applicative++import Hpack.Render+-- import Hpack.Util++data FormattingHints = FormattingHints {+ formattingHintsFieldOrder :: [String]+, formattingHintsSectionsFieldOrder :: [(String, [String])]+, formattingHintsAlignment :: Maybe Alignment+, formattingHintsRenderSettings :: RenderSettings+} deriving (Eq, Show)++sniffFormattingHints :: String -> FormattingHints+sniffFormattingHints (breakLines -> input) = FormattingHints {+ formattingHintsFieldOrder = extractFieldOrder input+, formattingHintsSectionsFieldOrder = extractSectionsFieldOrder input+, formattingHintsAlignment = sniffAlignment input+, formattingHintsRenderSettings = sniffRenderSettings input+}++breakLines :: String -> [String]+breakLines = filter (not . null) . map (reverse . dropWhile isSpace . reverse) . lines++extractFieldOrder :: [String] -> [String]+extractFieldOrder = map fst . catMaybes . map splitField++extractSectionsFieldOrder :: [String] -> [(String, [String])]+extractSectionsFieldOrder = map (fmap extractFieldOrder) . splitSections+ where+ splitSections input = case break startsWithSpace input of+ ([], []) -> []+ (xs, ys) -> case span startsWithSpace ys of+ (fields, zs) -> case reverse xs of+ name : _ -> (name, unindent fields) : splitSections zs+ _ -> splitSections zs++ startsWithSpace :: String -> Bool+ startsWithSpace xs = case xs of+ y : _ -> isSpace y+ _ -> False++unindent :: [String] -> [String]+unindent input = map (drop indentation) input+ where+ indentation = minimum $ map (length . takeWhile isSpace) input++sniffAlignment :: [String] -> Maybe Alignment+sniffAlignment input = case nub . catMaybes . map indentation . catMaybes . map splitField $ input of+ [n] -> Just (Alignment n)+ _ -> Nothing+ where++ indentation :: (String, String) -> Maybe Int+ indentation (name, value) = case span isSpace value of+ (_, "") -> Nothing+ (xs, _) -> (Just . succ . length $ name ++ xs)++splitField :: String -> Maybe (String, String)+splitField field = case span isNameChar field of+ (xs, ':':ys) -> Just (xs, ys)+ _ -> Nothing+ where+ isNameChar = (`elem` nameChars)+ nameChars = ['a'..'z'] ++ ['A'..'Z'] ++ "-"++sniffIndentation :: [String] -> Maybe Int+sniffIndentation input = sniffFrom "library" <|> sniffFrom "executable"+ where+ sniffFrom :: String -> Maybe Int+ sniffFrom section = case findSection . removeEmptyLines $ input of+ _ : x : _ -> Just . length $ takeWhile isSpace x+ _ -> Nothing+ where+ findSection = dropWhile (not . isPrefixOf section)++ removeEmptyLines :: [String] -> [String]+ removeEmptyLines = filter $ any (not . isSpace)++sniffCommaStyle :: [String] -> Maybe CommaStyle+sniffCommaStyle input+ | any startsWithComma input = Just LeadingCommas+ | any (startsWithComma . reverse) input = Just TrailingCommas+ | otherwise = Nothing+ where+ startsWithComma = isPrefixOf "," . dropWhile isSpace++sniffRenderSettings :: [String] -> RenderSettings+sniffRenderSettings input = RenderSettings indentation fieldAlignment commaStyle+ where+ indentation = fromMaybe (renderSettingsIndentation defaultRenderSettings) (sniffIndentation input)+ fieldAlignment = renderSettingsFieldAlignment defaultRenderSettings+ commaStyle = fromMaybe (renderSettingsCommaStyle defaultRenderSettings) (sniffCommaStyle input)
+ src/Hpack/GenericsUtil.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+module Hpack.GenericsUtil (+ HasTypeName+, typeName+, Selectors+, selectors+) where++import Data.Proxy+import GHC.Generics++class HasTypeName a where+ typeName :: Proxy a -> String++instance (Datatype d, Generic a, Rep a ~ M1 D d m) => HasTypeName a where+ typeName _ = datatypeName (undefined :: M1 D d x y)++selectors :: (Selectors (Rep a)) => Proxy a -> [String]+selectors = f+ where+ f :: forall a. (Selectors (Rep a)) => Proxy a -> [String]+ f _ = selNames (Proxy :: Proxy (Rep a))++class Selectors a where+ selNames :: Proxy a -> [String]++instance Selectors f => Selectors (M1 D x f) where+ selNames _ = selNames (Proxy :: Proxy f)++instance Selectors f => Selectors (M1 C x f) where+ selNames _ = selNames (Proxy :: Proxy f)++instance Selector s => Selectors (M1 S s (K1 R t)) where+ selNames _ = [selName (undefined :: M1 S s (K1 R t) ())]++instance (Selectors a, Selectors b) => Selectors (a :*: b) where+ selNames _ = selNames (Proxy :: Proxy a) ++ selNames (Proxy :: Proxy b)++instance Selectors U1 where+ selNames _ = []
+ src/Hpack/Haskell.hs view
@@ -0,0 +1,55 @@+module Hpack.Haskell (+ isModule+, isQualifiedIdentifier+, isIdentifier+) where++import Data.Char++isModule :: [String] -> Bool+isModule name = (not . null) name && all isModuleName name++isModuleName :: String -> Bool+isModuleName name = case name of+ x : xs -> isUpper x && all isIdChar xs+ _ -> False++isQualifiedIdentifier :: [String] -> Bool+isQualifiedIdentifier name = case reverse name of+ x : xs -> isIdentifier x && isModule xs+ _ -> False++isIdentifier :: String -> Bool+isIdentifier name = case name of+ x : xs -> isLower x && all isIdChar xs && name `notElem` reserved+ _ -> False++reserved :: [String]+reserved = [+ "case"+ , "class"+ , "data"+ , "default"+ , "deriving"+ , "do"+ , "else"+ , "foreign"+ , "if"+ , "import"+ , "in"+ , "infix"+ , "infixl"+ , "infixr"+ , "instance"+ , "let"+ , "module"+ , "newtype"+ , "of"+ , "then"+ , "type"+ , "where"+ , "_"+ ]++isIdChar :: Char -> Bool+isIdChar c = isAlphaNum c || c == '_' || c == '\''
+ src/Hpack/Render.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Hpack.Render (+-- * AST+ Element (..)+, Value (..)++-- * Render+, RenderSettings (..)+, CommaStyle (..)+, defaultRenderSettings+, Alignment (..)+, Nesting+, render++-- * Utils+, sortFieldsBy++#ifdef TEST+, Lines (..)+, renderValue+, addSortKey+#endif+) where++import Prelude ()+import Prelude.Compat++import Data.String+import Data.List.Compat++data Value =+ Literal String+ | CommaSeparatedList [String]+ | LineSeparatedList [String]+ | WordList [String]+ deriving (Eq, Show)++data Element = Stanza String [Element] | Group Element Element | Field String Value+ deriving (Eq, Show)++data Lines = SingleLine String | MultipleLines [String]+ deriving (Eq, Show)++data CommaStyle = LeadingCommas | TrailingCommas+ deriving (Eq, Show)++newtype Nesting = Nesting Int+ deriving (Eq, Show, Num, Enum)++newtype Alignment = Alignment Int+ deriving (Eq, Show, Num)++data RenderSettings = RenderSettings {+ renderSettingsIndentation :: Int+, renderSettingsFieldAlignment :: Alignment+, renderSettingsCommaStyle :: CommaStyle+} deriving (Eq, Show)++defaultRenderSettings :: RenderSettings+defaultRenderSettings = RenderSettings 2 0 LeadingCommas++render :: RenderSettings -> Nesting -> Element -> [String]+render settings nesting (Stanza name elements) = indent settings nesting name : renderElements settings (succ nesting) elements+render settings nesting (Group a b) = render settings nesting a ++ render settings nesting b+render settings nesting (Field name value) = renderField settings nesting name value++renderElements :: RenderSettings -> Nesting -> [Element] -> [String]+renderElements settings nesting = concatMap (render settings nesting)++renderField :: RenderSettings -> Nesting -> String -> Value -> [String]+renderField settings@RenderSettings{..} nesting name value = case renderValue settings value of+ SingleLine "" -> []+ SingleLine x -> [indent settings nesting (name ++ ": " ++ padding ++ x)]+ MultipleLines [] -> []+ MultipleLines xs -> (indent settings nesting name ++ ":") : map (indent settings $ succ nesting) xs+ where+ Alignment fieldAlignment = renderSettingsFieldAlignment+ padding = replicate (fieldAlignment - length name - 2) ' '++renderValue :: RenderSettings -> Value -> Lines+renderValue RenderSettings{..} v = case v of+ Literal s -> SingleLine s+ WordList ws -> SingleLine $ unwords ws+ LineSeparatedList xs -> renderLineSeparatedList renderSettingsCommaStyle xs+ CommaSeparatedList xs -> renderCommaSeparatedList renderSettingsCommaStyle xs++renderLineSeparatedList :: CommaStyle -> [String] -> Lines+renderLineSeparatedList style = MultipleLines . map (padding ++)+ where+ padding = case style of+ LeadingCommas -> " "+ TrailingCommas -> ""++renderCommaSeparatedList :: CommaStyle -> [String] -> Lines+renderCommaSeparatedList style = MultipleLines . case style of+ LeadingCommas -> map renderLeadingComma . zip (True : repeat False)+ TrailingCommas -> map renderTrailingComma . reverse . zip (True : repeat False) . reverse+ where+ renderLeadingComma :: (Bool, String) -> String+ renderLeadingComma (isFirst, x)+ | isFirst = " " ++ x+ | otherwise = ", " ++ x++ renderTrailingComma :: (Bool, String) -> String+ renderTrailingComma (isLast, x)+ | isLast = x+ | otherwise = x ++ ","++instance IsString Value where+ fromString = Literal++indent :: RenderSettings -> Nesting -> String -> String+indent RenderSettings{..} (Nesting nesting) s = replicate (nesting * renderSettingsIndentation) ' ' ++ s++sortFieldsBy :: [String] -> [Element] -> [Element]+sortFieldsBy existingFieldOrder =+ map snd+ . sortOn fst+ . addSortKey+ . map (\a -> (existingIndex a, a))+ where+ existingIndex :: Element -> Maybe Int+ existingIndex (Field name _) = name `elemIndex` existingFieldOrder+ existingIndex _ = Nothing++addSortKey :: [(Maybe Int, a)] -> [((Int, Int), a)]+addSortKey = go (-1) . zip [0..]+ where+ go :: Int -> [(Int, (Maybe Int, a))] -> [((Int, Int), a)]+ go n xs = case xs of+ [] -> []+ (x, (Just y, a)) : ys -> ((y, x), a) : go y ys+ (x, (Nothing, a)) : ys -> ((n, x), a) : go n ys
+ src/Hpack/Run.hs view
@@ -0,0 +1,275 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE CPP #-}+module Hpack.Run (+ run+, renderPackage+, RenderSettings(..)+, Alignment(..)+, CommaStyle(..)+, defaultRenderSettings+#ifdef TEST+, renderConditional+, renderFlag+, renderSourceRepository+, formatDescription+#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 System.FilePath++import Hpack.Util+import Hpack.Config+import Hpack.Render+import Hpack.FormattingHints++run :: FilePath -> IO ([String], FilePath, String)+run dir = do+ mPackage <- readPackageConfig (dir </> packageConfig)+ case mPackage of+ Right (warnings, pkg) -> do+ let cabalFile = dir </> (packageName pkg ++ ".cabal")++ old <- tryReadFile cabalFile++ let+ FormattingHints{..} = sniffFormattingHints (fromMaybe "" old)+ alignment = fromMaybe 16 formattingHintsAlignment+ settings = formattingHintsRenderSettings++ output = renderPackage settings alignment formattingHintsFieldOrder formattingHintsSectionsFieldOrder pkg++ return (warnings, cabalFile, output)+ Left err -> die err++renderPackage :: RenderSettings -> Alignment -> [String] -> [(String, [String])] -> Package -> String+renderPackage settings alignment existingFieldOrder sectionsFieldOrder Package{..} = intercalate "\n" (unlines header : chunks)+ where+ chunks :: [String]+ chunks = map unlines . filter (not . null) . map (render settings 0) $ sortSectionFields sectionsFieldOrder stanzas++ header :: [String]+ header = concatMap (render settings {renderSettingsFieldAlignment = alignment} 0) fields++ extraSourceFiles :: Element+ extraSourceFiles = Field "extra-source-files" (LineSeparatedList packageExtraSourceFiles)++ dataFiles :: Element+ dataFiles = Field "data-files" (LineSeparatedList packageDataFiles)++ sourceRepository = maybe [] (return . renderSourceRepository) packageSourceRepository++ library = maybe [] (return . renderLibrary) packageLibrary++ stanzas :: [Element]+ stanzas =+ extraSourceFiles+ : dataFiles+ : sourceRepository+ ++ concat [+ map renderFlag packageFlags+ , library+ , renderExecutables packageExecutables+ , renderTests packageTests+ , renderBenchmarks packageBenchmarks+ ]++ fields :: [Element]+ fields = sortFieldsBy existingFieldOrder . mapMaybe (\(name, value) -> Field name . Literal <$> value) $ [+ ("name", Just packageName)+ , ("version", Just packageVersion)+ , ("synopsis", packageSynopsis)+ , ("description", (formatDescription alignment <$> packageDescription))+ , ("category", packageCategory)+ , ("stability", packageStability)+ , ("homepage", packageHomepage)+ , ("bug-reports", packageBugReports)+ , ("author", formatList packageAuthor)+ , ("maintainer", formatList packageMaintainer)+ , ("copyright", formatList packageCopyright)+ , ("license", packageLicense)+ , ("license-file", packageLicenseFile)+ , ("tested-with", packageTestedWith)+ , ("build-type", Just "Simple")+ , ("cabal-version", cabalVersion)+ ]++ formatList :: [String] -> Maybe String+ formatList xs = guard (not $ null xs) >> (Just $ intercalate separator xs)+ where+ separator = let Alignment n = alignment in ",\n" ++ replicate n ' '++ cabalVersion :: Maybe String+ cabalVersion = maximum [+ Just ">= 1.10"+ , packageLibrary >>= libCabalVersion+ ]+ where+ libCabalVersion :: Section Library -> Maybe String+ libCabalVersion sect = ">= 1.21" <$ guard (hasReexportedModules sect)++ hasReexportedModules :: Section Library -> Bool+ hasReexportedModules = not . null . libraryReexportedModules . sectionData++sortSectionFields :: [(String, [String])] -> [Element] -> [Element]+sortSectionFields sectionsFieldOrder = go+ where+ go sections = case sections of+ [] -> []+ Stanza name fields : xs | Just fieldOrder <- lookup name sectionsFieldOrder -> Stanza name (sortFieldsBy fieldOrder fields) : go xs+ x : xs -> x : go xs++formatDescription :: Alignment -> String -> String+formatDescription (Alignment alignment) description = case map emptyLineToDot $ lines description of+ x : xs -> intercalate "\n" (x : map (indentation ++) xs)+ [] -> ""+ where+ n = max alignment (length ("description: " :: String))+ indentation = replicate n ' '++ emptyLineToDot xs+ | isEmptyLine xs = "."+ | otherwise = xs++ isEmptyLine = all isSpace++renderSourceRepository :: SourceRepository -> Element+renderSourceRepository SourceRepository{..} = Stanza "source-repository head" [+ Field "type" "git"+ , Field "location" (Literal sourceRepositoryUrl)+ , Field "subdir" (maybe "" Literal sourceRepositorySubdir)+ ]++renderFlag :: Flag -> Element+renderFlag Flag {..} = Stanza ("flag " ++ flagName) $ description ++ [+ Field "manual" (Literal $ show flagManual)+ , Field "default" (Literal $ show flagDefault)+ ]+ where+ description = maybe [] (return . Field "description" . Literal) flagDescription++renderExecutables :: [Section Executable] -> [Element]+renderExecutables = map renderExecutable++renderExecutable :: Section Executable -> Element+renderExecutable sect@(sectionData -> Executable{..}) =+ Stanza ("executable " ++ executableName) (renderExecutableSection sect)++renderTests :: [Section Executable] -> [Element]+renderTests = map renderTest++renderTest :: Section Executable -> Element+renderTest sect@(sectionData -> Executable{..}) =+ Stanza ("test-suite " ++ executableName)+ (Field "type" "exitcode-stdio-1.0" : renderExecutableSection sect)++renderBenchmarks :: [Section Executable] -> [Element]+renderBenchmarks = map renderBenchmark++renderBenchmark :: Section Executable -> Element+renderBenchmark sect@(sectionData -> Executable{..}) =+ Stanza ("benchmark " ++ executableName)+ (Field "type" "exitcode-stdio-1.0" : renderExecutableSection sect)++renderExecutableSection :: Section Executable -> [Element]+renderExecutableSection sect@(sectionData -> Executable{..}) =+ mainIs : renderSection sect ++ [otherModules, defaultLanguage]+ where+ mainIs = Field "main-is" (Literal executableMain)+ otherModules = renderOtherModules executableOtherModules++renderLibrary :: Section Library -> Element+renderLibrary sect@(sectionData -> Library{..}) = Stanza "library" $+ renderSection sect +++ 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{..} = [+ renderSourceDirs sectionSourceDirs+ , renderDefaultExtensions sectionDefaultExtensions+ , renderOtherExtensions sectionOtherExtensions+ , renderGhcOptions sectionGhcOptions+ , renderGhcProfOptions sectionGhcProfOptions+ , renderCppOptions sectionCppOptions+ , renderCCOptions sectionCCOptions+ , Field "include-dirs" (LineSeparatedList sectionIncludeDirs)+ , Field "install-includes" (LineSeparatedList sectionInstallIncludes)+ , Field "c-sources" (LineSeparatedList sectionCSources)+ , Field "extra-lib-dirs" (LineSeparatedList sectionExtraLibDirs)+ , Field "extra-libraries" (LineSeparatedList sectionExtraLibraries)+ , renderLdOptions sectionLdOptions+ , renderDependencies sectionDependencies+ , renderBuildTools sectionBuildTools+ ]+ ++ maybe [] (return . renderBuildable) sectionBuildable+ ++ map renderConditional sectionConditionals++renderConditional :: Conditional -> Element+renderConditional (Conditional condition sect mElse) = case mElse of+ Nothing -> if_+ Just else_ -> Group if_ (Stanza "else" $ renderSection else_)+ where+ if_ = Stanza ("if " ++ condition) (renderSection sect)++defaultLanguage :: Element+defaultLanguage = Field "default-language" "Haskell2010"++renderSourceDirs :: [String] -> Element+renderSourceDirs = Field "hs-source-dirs" . CommaSeparatedList++renderExposedModules :: [String] -> Element+renderExposedModules = Field "exposed-modules" . LineSeparatedList++renderOtherModules :: [String] -> Element+renderOtherModules = Field "other-modules" . LineSeparatedList++renderReexportedModules :: [String] -> Element+renderReexportedModules = Field "reexported-modules" . LineSeparatedList++renderDependencies :: [Dependency] -> Element+renderDependencies = Field "build-depends" . CommaSeparatedList . map dependencyName++renderGhcOptions :: [GhcOption] -> Element+renderGhcOptions = Field "ghc-options" . WordList++renderGhcProfOptions :: [GhcProfOption] -> Element+renderGhcProfOptions = Field "ghc-prof-options" . WordList++renderCppOptions :: [CppOption] -> Element+renderCppOptions = Field "cpp-options" . WordList++renderCCOptions :: [CCOption] -> Element+renderCCOptions = Field "cc-options" . WordList++renderLdOptions :: [LdOption] -> Element+renderLdOptions = Field "ld-options" . WordList++renderBuildable :: Bool -> Element+renderBuildable = Field "buildable" . Literal . show++renderDefaultExtensions :: [String] -> Element+renderDefaultExtensions = Field "default-extensions" . WordList++renderOtherExtensions :: [String] -> Element+renderOtherExtensions = Field "other-extensions" . WordList++renderBuildTools :: [Dependency] -> Element+renderBuildTools = Field "build-tools" . CommaSeparatedList . map dependencyName
+ src/Hpack/Util.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Hpack.Util (+ List(..)+, GhcOption+, GhcProfOption+, CppOption+, CCOption+, LdOption+, parseMain+, toModule+, getFilesRecursive+, tryReadFile+, expandGlobs+, sort+, lexicographically+) where++import Prelude ()+import Prelude.Compat++import Control.Applicative+import Control.DeepSeq+import Control.Exception+import Control.Monad.Compat+import Data.Aeson.Types+import Data.Char+import Data.Data+import Data.List.Compat hiding (sort)+import Data.Ord+import System.Directory+import System.FilePath+import qualified System.FilePath.Posix as Posix+import System.FilePath.Glob++import Hpack.Haskell++sort :: [String] -> [String]+sort = sortBy (comparing lexicographically)++lexicographically :: String -> (String, String)+lexicographically x = (map toLower x, x)++newtype List a = List {fromList :: [a]}+ deriving (Eq, Show, Data, Typeable)++instance FromJSON a => FromJSON (List a) where+ parseJSON v = List <$> case v of+ Array _ -> parseJSON v+ _ -> return <$> parseJSON v++type GhcOption = String+type GhcProfOption = String+type CppOption = String+type CCOption = String+type LdOption = String++parseMain :: String -> (FilePath, [GhcOption])+parseMain main = case reverse name of+ x : _ | isQualifiedIdentifier name && x `notElem` ["hs", "lhs"] -> (intercalate "/" (init name) ++ ".hs", ["-main-is " ++ main])+ _ | isModule name -> (intercalate "/" name ++ ".hs", ["-main-is " ++ main])+ _ -> (main, [])+ where+ name = splitOn '.' main++splitOn :: Char -> String -> [String]+splitOn c = go+ where+ go xs = case break (== c) xs of+ (ys, "") -> [ys]+ (ys, _:zs) -> ys : go zs++toModule :: [FilePath] -> Maybe String+toModule path = case reverse path of+ [] -> Nothing+ x : xs -> do+ m <- stripSuffix ".hs" x <|> stripSuffix ".lhs" x+ let name = reverse (m : xs)+ guard (isModule name) >> return (intercalate "." name)+ where+ stripSuffix :: String -> String -> Maybe String+ stripSuffix suffix x = reverse <$> stripPrefix (reverse suffix) (reverse x)++getFilesRecursive :: FilePath -> IO [[String]]+getFilesRecursive baseDir = go []+ where+ go :: [FilePath] -> IO [[FilePath]]+ go dir = do+ c <- map ((dir ++) . return) . filter (`notElem` [".", ".."]) <$> getDirectoryContents (pathTo dir)+ subdirsFiles <- filterM (doesDirectoryExist . pathTo) c >>= mapM go+ files <- filterM (doesFileExist . pathTo) c+ return (files ++ concat subdirsFiles)+ where+ pathTo :: [FilePath] -> FilePath+ pathTo p = baseDir </> joinPath p++tryReadFile :: FilePath -> IO (Maybe String)+tryReadFile file = do+ r <- try (readFile file) :: IO (Either IOException String)+ return $!! either (const Nothing) Just r++toPosixFilePath :: FilePath -> FilePath+toPosixFilePath = Posix.joinPath . splitDirectories++expandGlobs :: FilePath -> [String] -> IO ([String], [FilePath])+expandGlobs dir patterns = do+ files <- (fst <$> globDir compiledPatterns dir) >>= mapM removeDirectories+ let warnings = [warn pattern | ([], pattern) <- zip files patterns]+ return (warnings, combineResults files)+ where+ combineResults = nub . sort . map (toPosixFilePath . makeRelative dir) . concat+ warn pattern = "Specified pattern " ++ show pattern ++ " for extra-source-files does not match any files"+ compiledPatterns = map (compileWith options) patterns+ removeDirectories = filterM doesFileExist+ options = CompOptions {+ characterClasses = False+ , characterRanges = False+ , numberRanges = False+ , wildcards = True+ , recursiveWildcards = True+ , pathSepInRanges = False+ , errorRecovery = True+ }
+ src/Hpack/Yaml.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE RecordWildCards #-}+module Hpack.Yaml where++import Data.Yaml++decodeYaml :: FromJSON a => FilePath -> IO (Either String a)+decodeYaml file = do+ result <- decodeFileEither file+ return $ either (Left . errToString) Right result+ where+ errToString err = file ++ case err of+ AesonException e -> ": " ++ e+ InvalidYaml (Just (YamlException s)) -> ": " ++ s+ InvalidYaml (Just (YamlParseException{..})) -> ":" ++ show yamlLine ++ ":" ++ show yamlColumn ++ ": " ++ yamlProblem ++ " " ++ yamlContext+ where YamlMark{..} = yamlProblemMark+ _ -> ": " ++ show err
+ test/Helper.hs view
@@ -0,0 +1,26 @@+module Helper (+ module Test.Hspec+, module Test.Mockery.Directory+, module Control.Applicative+, withTempDirectory+, module System.FilePath+, withCurrentDirectory+) where++import Test.Hspec+import Test.Mockery.Directory+import Control.Applicative+import System.Directory (getCurrentDirectory, setCurrentDirectory, canonicalizePath)+import Control.Exception+import qualified System.IO.Temp as Temp+import System.FilePath++withCurrentDirectory :: FilePath -> IO a -> IO a+withCurrentDirectory dir action = do+ bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do+ setCurrentDirectory dir+ action++withTempDirectory :: (FilePath -> IO a) -> IO a+withTempDirectory action = Temp.withSystemTempDirectory "hspec" $ \dir -> do+ canonicalizePath dir >>= action
+ test/Hpack/ConfigSpec.hs view
@@ -0,0 +1,1052 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+module Hpack.ConfigSpec (+ spec++, package+, executable+, library+) where++import Helper++import Data.Aeson.QQ+import Data.Aeson.Types+import Data.String.Interpolate.IsString+import Control.Arrow+import System.Directory (createDirectory)+import Data.Yaml+import Data.Either.Compat++import Hpack.Util+import Hpack.Config hiding (package)+import qualified Hpack.Config as Config++package :: Package+package = Config.package "foo" "0.0.0"++executable :: String -> String -> Executable+executable name main_ = Executable name main_ []++library :: Library+library = Library Nothing [] [] []++withPackage :: String -> IO () -> (([String], Package) -> Expectation) -> Expectation+withPackage content beforeAction expectation = withTempDirectory $ \dir_ -> do+ let dir = dir_ </> "foo"+ createDirectory dir+ writeFile (dir </> "package.yaml") content+ withCurrentDirectory dir beforeAction+ r <- readPackageConfig (dir </> "package.yaml")+ either expectationFailure expectation r++withPackageConfig :: String -> IO () -> (Package -> Expectation) -> Expectation+withPackageConfig content beforeAction expectation = withPackage content beforeAction (expectation . snd)++withPackageConfig_ :: String -> (Package -> Expectation) -> Expectation+withPackageConfig_ content = withPackageConfig content (return ())++withPackageWarnings :: String -> IO () -> ([String] -> Expectation) -> Expectation+withPackageWarnings content beforeAction expectation = withPackage content beforeAction (expectation . fst)++withPackageWarnings_ :: String -> ([String] -> Expectation) -> Expectation+withPackageWarnings_ content = withPackageWarnings content (return ())++spec :: Spec+spec = do+ 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 = dependencies}]}+ renamePackage "bar" (packageWithExecutable ["foo"]) `shouldBe` (packageWithExecutable ["bar"]) {packageName = "bar"}++ describe "renameDependencies" $ do+ let sectionWithDeps dependencies = (section ()) {sectionDependencies = dependencies}++ it "renames dependencies" $ do+ renameDependencies "bar" "baz" (sectionWithDeps ["foo", "bar"]) `shouldBe` sectionWithDeps ["foo", "baz"]++ it "renames dependency in conditionals" $ do+ let sectionWithConditional dependencies = (section ()) {+ sectionConditionals = [+ Conditional {+ conditionalCondition = "some condition"+ , conditionalThen = sectionWithDeps dependencies+ , conditionalElse = Just (sectionWithDeps dependencies)+ }+ ]+ }+ 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 = ["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 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"]}++ context "when parsing conditionals" $ do+ it "accepts conditionals" $ do+ let input = [i|+ when:+ condition: os(windows)+ dependencies: Win32+ |]+ conditionals = [+ Conditional "os(windows)"+ (section ()){sectionDependencies = ["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 = ["Win32"]}+ (Just (section ()){sectionDependencies = ["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"]++ context "when parsing a Dependency" $ do+ it "accepts simple dependencies" $ do+ parseEither parseJSON "hpack" `shouldBe` Right (Dependency "hpack" Nothing)++ it "accepts git dependencies" $ do+ let value = [aesonQQ|{+ name: "hpack",+ git: "https://github.com/sol/hpack",+ ref: "master"+ }|]+ source = GitRef "https://github.com/sol/hpack" "master" Nothing+ parseEither parseJSON value `shouldBe` Right (Dependency "hpack" (Just source))++ it "accepts github dependencies" $ do+ let value = [aesonQQ|{+ name: "hpack",+ github: "sol/hpack",+ ref: "master"+ }|]+ source = GitRef "https://github.com/sol/hpack" "master" Nothing+ parseEither parseJSON value `shouldBe` Right (Dependency "hpack" (Just source))++ it "accepts an optional subdirectory for git dependencies" $ do+ let value = [aesonQQ|{+ name: "warp",+ github: "yesodweb/wai",+ ref: "master",+ subdir: "warp"+ }|]+ source = GitRef "https://github.com/yesodweb/wai" "master" (Just "warp")+ parseEither parseJSON value `shouldBe` Right (Dependency "warp" (Just source))++ it "accepts local dependencies" $ do+ let value = [aesonQQ|{+ name: "hpack",+ path: "../hpack"+ }|]+ source = Local "../hpack"+ parseEither parseJSON value `shouldBe` Right (Dependency "hpack" (Just source))++ context "when parsing fails" $ do+ it "returns an error message" $ do+ let value = Number 23+ parseEither parseJSON value `shouldBe` (Left "Error in $: expected String or an Object, encountered Number" :: Either String Dependency)++ context "when ref is missing" $ do+ it "produces accurate error messages" $ do+ let value = [aesonQQ|{+ name: "hpack",+ git: "sol/hpack",+ ef: "master"+ }|]+ parseEither parseJSON value `shouldBe` (Left "Error in $: key \"ref\" not present" :: Either String Dependency)++ context "when both git and github are missing" $ do+ it "produces accurate error messages" $ do+ let value = [aesonQQ|{+ name: "hpack",+ gi: "sol/hpack",+ ref: "master"+ }|]+ parseEither parseJSON value `shouldBe` (Left "Error in $: neither key \"git\" nor key \"github\" present" :: Either String Dependency)++ describe "getModules" $ around withTempDirectory $ do+ it "returns Haskell modules in specified source directory" $ \dir -> do+ touch (dir </> "src/Foo.hs")+ touch (dir </> "src/Bar/Baz.hs")+ touch (dir </> "src/Setup.hs")+ getModules dir "src" >>= (`shouldMatchList` ["Foo", "Bar.Baz", "Setup"])++ context "when source directory is '.'" $ do+ it "ignores Setup" $ \dir -> do+ touch (dir </> "Foo.hs")+ touch (dir </> "Setup.hs")+ getModules dir "." `shouldReturn` ["Foo"]++ context "when source directory is './.'" $ do+ it "ignores Setup" $ \dir -> do+ touch (dir </> "Foo.hs")+ touch (dir </> "Setup.hs")+ getModules dir "./." `shouldReturn` ["Foo"]++ describe "determineModules" $ do+ it "adds the Paths_* module to the other-modules" $ do+ determineModules "foo" [] (Just $ List ["Foo"]) Nothing `shouldBe` (["Foo"], ["Paths_foo"])++ it "replaces dashes with underscores in Paths_*" $ do+ determineModules "foo-bar" [] (Just $ List ["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"], [])++ describe "readPackageConfig" $ do+ it "warns on unknown fields" $ do+ withPackageWarnings_ [i|+ bar: 23+ baz: 42+ |]+ (`shouldBe` [+ "Ignoring unknown field \"bar\" in package description"+ , "Ignoring unknown field \"baz\" in package description"+ ]+ )++ it "warns on unknown fields in when block, list" $ do+ withPackageWarnings_ [i|+ when:+ - condition: impl(ghc)+ bar: 23+ baz: 42+ |]+ (`shouldBe` [+ "Ignoring unknown field \"bar\" in package description"+ , "Ignoring unknown field \"baz\" in package description"+ ]+ )++ it "warns on unknown fields in when block, single" $ do+ withPackageWarnings_ [i|+ when:+ condition: impl(ghc)+ github: foo/bar+ dependencies: ghc-prim+ baz: 42+ |]+ (`shouldBe` [+ "Ignoring unknown field \"baz\" in package description"+ , "Ignoring unknown field \"github\" in package description"+ ]+ )++ it "accepts name" $ do+ withPackageConfig_ [i|+ name: bar+ |]+ (packageName >>> (`shouldBe` "bar"))++ it "accepts version" $ do+ withPackageConfig_ [i|+ version: 0.1.0+ |]+ (packageVersion >>> (`shouldBe` "0.1.0"))++ it "accepts synopsis" $ do+ withPackageConfig_ [i|+ synopsis: some synopsis+ |]+ (packageSynopsis >>> (`shouldBe` Just "some synopsis"))++ it "accepts description" $ do+ withPackageConfig_ [i|+ description: some description+ |]+ (packageDescription >>> (`shouldBe` Just "some description"))++ it "accepts category" $ do+ withPackageConfig_ [i|+ category: Data+ |]+ (`shouldBe` package {packageCategory = Just "Data"})++ it "accepts author" $ do+ withPackageConfig_ [i|+ author: John Doe+ |]+ (`shouldBe` package {packageAuthor = ["John Doe"]})++ it "accepts maintainer" $ do+ withPackageConfig_ [i|+ maintainer: John Doe <john.doe@example.com>+ |]+ (`shouldBe` package {packageMaintainer = ["John Doe <john.doe@example.com>"]})++ it "accepts copyright" $ do+ withPackageConfig_ [i|+ copyright: (c) 2015 John Doe+ |]+ (`shouldBe` package {packageCopyright = ["(c) 2015 John Doe"]})++ it "accepts stability" $ do+ withPackageConfig_ [i|+ stability: experimental+ |]+ (packageStability >>> (`shouldBe` Just "experimental"))++ it "accepts homepage URL" $ do+ withPackageConfig_ [i|+ github: hspec/hspec+ homepage: https://example.com/+ |]+ (packageHomepage >>> (`shouldBe` Just "https://example.com/"))++ it "infers homepage URL from github" $ do+ withPackageConfig_ [i|+ github: hspec/hspec+ |]+ (packageHomepage >>> (`shouldBe` Just "https://github.com/hspec/hspec#readme"))++ it "omits homepage URL if it is null" $ do+ withPackageConfig_ [i|+ github: hspec/hspec+ homepage: null+ |]+ (packageHomepage >>> (`shouldBe` Nothing))++ it "accepts bug-reports URL" $ do+ withPackageConfig_ [i|+ github: hspec/hspec+ bug-reports: https://example.com/issues+ |]+ (packageBugReports >>> (`shouldBe` Just "https://example.com/issues"))++ it "infers bug-reports URL from github" $ do+ withPackageConfig_ [i|+ github: hspec/hspec+ |]+ (packageBugReports >>> (`shouldBe` Just "https://github.com/hspec/hspec/issues"))++ it "omits bug-reports URL if it is null" $ do+ withPackageConfig_ [i|+ github: hspec/hspec+ bug-reports: null+ |]+ (packageBugReports >>> (`shouldBe` Nothing))++ it "accepts license" $ do+ withPackageConfig_ [i|+ license: MIT+ |]+ (`shouldBe` package {packageLicense = Just "MIT"})++ it "infers license file" $ do+ withPackageConfig [i|+ name: foo+ |]+ (do+ touch "LICENSE"+ )+ (packageLicenseFile >>> (`shouldBe` Just "LICENSE"))++ it "accepts license file" $ do+ withPackageConfig_ [i|+ license-file: FOO+ |]+ (packageLicenseFile >>> (`shouldBe` Just "FOO"))++ it "accepts flags" $ do+ withPackageConfig_ [i|+ flags:+ integration-tests:+ description: Run the integration test suite+ manual: yes+ default: no+ |]+ (packageFlags >>> (`shouldBe` [Flag "integration-tests" (Just "Run the integration test suite") True False]))++ it "warns on unknown fields in flag sections" $ do+ withPackageWarnings_ [i|+ flags:+ integration-tests:+ description: Run the integration test suite+ manual: yes+ default: no+ foo: 23+ |]+ (`shouldBe` [+ "Ignoring unknown field \"foo\" for flag \"integration-tests\""+ ]+ )++ it "accepts extra-source-files" $ do+ withPackageConfig [i|+ extra-source-files:+ - CHANGES.markdown+ - README.markdown+ |]+ (do+ touch "CHANGES.markdown"+ touch "README.markdown"+ )+ (packageExtraSourceFiles >>> (`shouldBe` ["CHANGES.markdown", "README.markdown"]))++ it "accepts data-files" $ do+ withPackageConfig [i|+ data-files:+ - data/**/*.html+ |]+ (do+ touch "data/foo/index.html"+ touch "data/bar/index.html"+ )+ (packageDataFiles >>> (`shouldMatchList` ["data/foo/index.html", "data/bar/index.html"]))++ it "accepts github" $ do+ withPackageConfig_ [i|+ github: hspec/hspec+ |]+ (packageSourceRepository >>> (`shouldBe` Just (SourceRepository "https://github.com/hspec/hspec" Nothing)))++ it "accepts third part of github URL as subdir" $ do+ withPackageConfig_ [i|+ github: hspec/hspec/hspec-core+ |]+ (packageSourceRepository >>> (`shouldBe` Just (SourceRepository "https://github.com/hspec/hspec" (Just "hspec-core"))))++ it "accepts arbitrary git URLs as source repository" $ do+ withPackageConfig_ [i|+ git: https://gitlab.com/gitlab-org/gitlab-ce.git+ |]+ (packageSourceRepository >>> (`shouldBe` Just (SourceRepository "https://gitlab.com/gitlab-org/gitlab-ce.git" Nothing)))++ it "accepts CPP options" $ do+ withPackageConfig_ [i|+ cpp-options: -DFOO+ library:+ cpp-options: -DLIB++ executables:+ foo:+ main: Main.hs+ cpp-options: -DFOO+++ tests:+ spec:+ main: Spec.hs+ cpp-options: -DTEST+ |]+ (`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"]}]+ }+ )++ it "accepts cc-options" $ do+ withPackageConfig_ [i|+ cc-options: -Wall+ library:+ cc-options: -fLIB++ executables:+ foo:+ main: Main.hs+ cc-options: -O2+++ tests:+ spec:+ main: Spec.hs+ cc-options: -O0+ |]+ (`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"]}]+ }+ )++ it "accepts ld-options" $ do+ withPackageConfig_ [i|+ library:+ ld-options: -static+ |]+ (`shouldBe` package {+ packageLibrary = Just (section library) {sectionLdOptions = ["-static"]}+ }+ )++ it "accepts buildable" $ do+ withPackageConfig_ [i|+ buildable: no+ library:+ buildable: yes++ executables:+ foo:+ main: Main.hs+ |]+ (`shouldBe` package {+ packageLibrary = Just (section library) {sectionBuildable = Just True}+ , packageExecutables = [(section $ executable "foo" "Main.hs") {sectionBuildable = Just False}]+ }+ )++ context "when reading library section" $ do+ it "warns on unknown fields" $ do+ withPackageWarnings_ [i|+ library:+ bar: 23+ baz: 42+ |]+ (`shouldBe` [+ "Ignoring unknown field \"bar\" in library section"+ , "Ignoring unknown field \"baz\" in library section"+ ]+ )++ it "accepts source-dirs" $ do+ withPackageConfig_ [i|+ library:+ source-dirs:+ - foo+ - bar+ |]+ (packageLibrary >>> (`shouldBe` Just (section library) {sectionSourceDirs = ["foo", "bar"]}))++ it "accepts build-tools" $ do+ withPackageConfig_ [i|+ library:+ build-tools:+ - alex+ - happy+ |]+ (packageLibrary >>> (`shouldBe` Just (section library) {sectionBuildTools = ["alex", "happy"]}))++ it "accepts default-extensions" $ do+ withPackageConfig_ [i|+ library:+ default-extensions:+ - Foo+ - Bar+ |]+ (packageLibrary >>> (`shouldBe` Just (section library) {sectionDefaultExtensions = ["Foo", "Bar"]}))++ it "accepts global default-extensions" $ do+ withPackageConfig_ [i|+ default-extensions:+ - Foo+ - Bar+ library: {}+ |]+ (packageLibrary >>> (`shouldBe` Just (section library) {sectionDefaultExtensions = ["Foo", "Bar"]}))++ it "accepts global source-dirs" $ do+ withPackageConfig_ [i|+ source-dirs:+ - foo+ - bar+ library: {}+ |]+ (packageLibrary >>> (`shouldBe` Just (section library) {sectionSourceDirs = ["foo", "bar"]}))++ it "accepts global build-tools" $ do+ withPackageConfig_ [i|+ build-tools:+ - alex+ - happy+ library: {}+ |]+ (packageLibrary >>> (`shouldBe` Just (section library) {sectionBuildTools = ["alex", "happy"]}))++ it "allows to specify exposed" $ do+ withPackageConfig_ [i|+ library:+ exposed: no+ |]+ (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|+ executables:+ foo:+ main: Main.hs+ bar: 42+ baz: 23+ |]+ (`shouldBe` [+ "Ignoring unknown field \"bar\" in executable section \"foo\""+ , "Ignoring unknown field \"baz\" in executable section \"foo\""+ ]+ )++ it "reads executable section" $ do+ withPackageConfig_ [i|+ executables:+ foo:+ main: driver/Main.hs+ |]+ (packageExecutables >>> (`shouldBe` [section $ executable "foo" "driver/Main.hs"]))++ 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:+ foo:+ main: Main.hs+ source-dirs:+ - foo+ - bar+ |]+ (packageExecutables >>> (`shouldBe` [(section $ executable "foo" "Main.hs") {sectionSourceDirs = ["foo", "bar"]}]))++ it "accepts build-tools" $ do+ withPackageConfig_ [i|+ executables:+ foo:+ main: Main.hs+ build-tools:+ - alex+ - happy+ |]+ (packageExecutables >>> (`shouldBe` [(section $ executable "foo" "Main.hs") {sectionBuildTools = ["alex", "happy"]}]))++ it "accepts global source-dirs" $ do+ withPackageConfig_ [i|+ source-dirs:+ - foo+ - bar+ executables:+ foo:+ main: Main.hs+ |]+ (packageExecutables >>> (`shouldBe` [(section $ executable "foo" "Main.hs") {sectionSourceDirs = ["foo", "bar"]}]))++ it "accepts global build-tools" $ do+ withPackageConfig_ [i|+ build-tools:+ - alex+ - happy+ executables:+ foo:+ main: Main.hs+ |]+ (packageExecutables >>> (`shouldBe` [(section $ executable "foo" "Main.hs") {sectionBuildTools = ["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"+ touch "src/Bar.hs"+ touch "src/Baz.lhs"+ )+ (map (executableOtherModules . sectionData) . packageExecutables >>> (`shouldBe` [["Bar", "Baz", "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"]]))++ it "accepts default-extensions" $ do+ withPackageConfig_ [i|+ executables:+ foo:+ main: driver/Main.hs+ default-extensions:+ - Foo+ - Bar+ |]+ (packageExecutables >>> (`shouldBe` [(section $ executable "foo" "driver/Main.hs") {sectionDefaultExtensions = ["Foo", "Bar"]}]))++ it "accepts global default-extensions" $ do+ withPackageConfig_ [i|+ default-extensions:+ - Foo+ - Bar+ executables:+ foo:+ main: driver/Main.hs+ |]+ (packageExecutables >>> (`shouldBe` [(section $ executable "foo" "driver/Main.hs") {sectionDefaultExtensions = ["Foo", "Bar"]}]))++ it "accepts GHC options" $ do+ withPackageConfig_ [i|+ executables:+ foo:+ main: driver/Main.hs+ ghc-options: -Wall+ |]+ (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionGhcOptions = ["-Wall"]}]})++ it "accepts global GHC options" $ do+ withPackageConfig_ [i|+ ghc-options: -Wall+ executables:+ foo:+ main: driver/Main.hs+ |]+ (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionGhcOptions = ["-Wall"]}]})++ it "accepts GHC profiling options" $ do+ withPackageConfig_ [i|+ executables:+ foo:+ main: driver/Main.hs+ ghc-prof-options: -fprof-auto+ |]+ (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionGhcProfOptions = ["-fprof-auto"]}]})++ it "accepts global GHC profiling options" $ do+ withPackageConfig_ [i|+ ghc-prof-options: -fprof-auto+ executables:+ foo:+ main: driver/Main.hs+ |]+ (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionGhcProfOptions = ["-fprof-auto"]}]})+++ context "when reading test section" $ do+ it "warns on unknown fields" $ do+ withPackageWarnings_ [i|+ tests:+ foo:+ main: Main.hs+ bar: 42+ baz: 23+ |]+ (`shouldBe` [+ "Ignoring unknown field \"bar\" in test section \"foo\""+ , "Ignoring unknown field \"baz\" in test section \"foo\""+ ]+ )++ it "reads test section" $ do+ withPackageConfig_ [i|+ tests:+ 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 = ["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 = ["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 = ["base", "hspec"]}]})++ context "when a specified source directory does not exist" $ do+ it "warns" $ do+ withPackageWarnings [i|+ source-dirs:+ - some-dir+ - some-existing-dir+ library:+ source-dirs: some-lib-dir+ executables:+ main:+ main: Main.hs+ source-dirs: some-exec-dir+ tests:+ spec:+ main: Main.hs+ source-dirs: some-test-dir+ |]+ (do+ touch "some-existing-dir/foo"+ )+ (`shouldBe` [+ "Specified source-dir \"some-dir\" does not exist"+ , "Specified source-dir \"some-exec-dir\" does not exist"+ , "Specified source-dir \"some-lib-dir\" does not exist"+ , "Specified source-dir \"some-test-dir\" does not exist"+ ]+ )++ around withTempDirectory $ do+ context "when package.yaml can not be parsed" $ do+ it "returns an error" $ \dir -> do+ let file = dir </> "package.yaml"+ writeFile file [i|+ foo: bar+ foo baz+ |]+ readPackageConfig file `shouldReturn` Left (file ++ ":3:12: could not find expected ':' while scanning a simple key")++ context "when package.yaml is invalid" $ do+ it "returns an error" $ \dir -> do+ let file = dir </> "package.yaml"+ writeFile file [i|+ executables:+ foo:+ ain: driver/Main.hs+ |]+ readPackageConfig file `shouldReturn` Left (file ++ ": Error in $.executables.foo: failed to parse field executables: The key \"main\" was not found")++ context "when package.yaml does not exist" $ do+ it "returns an error" $ \dir -> do+ let file = dir </> "package.yaml"+ readPackageConfig file `shouldReturn` Left [i|#{file}: Yaml file not found: #{file}|]++ context "toJSON :: Conditinal -> Value" $ do+ it "serializes conditionals properly" $ do+ let s = emptySection { sectionBuildable = Just False }+ toJSON (Conditional "os(darwin)" s Nothing)+ `shouldBe` object [ "condition" .= String "os(darwin)"+ , "buildable" .= Bool False+ ]++ it "serializes conditionals with an else branch properly" $ do+ let s = emptySection { sectionBuildable = Just False }+ toJSON (Conditional "os(darwin)" s (Just s))+ `shouldBe` object [ "condition" .= String "os(darwin)"+ , "then" .= object [ "buildable" .= Bool False+ ]+ , "else" .= object [ "buildable" .= Bool False+ ]+ ]+++ context "toJSON :: Section a -> Value" $+ it "serializes conditionals properly" $ do+ let s = emptySection { sectionConditionals = [ Conditional "os(darwin)" emptySection { sectionBuildable = Just False } Nothing]+ }+ toJSON s+ `shouldBe` object [ "when" .= array [ object [ "condition" .= String "os(darwin)"+ , "buildable" .= Bool False+ ]+ ]+ ]++emptySection :: Section ()+emptySection = Section { sectionData = ()+ , sectionSourceDirs = []+ , sectionDependencies = []+ , sectionDefaultExtensions = []+ , sectionOtherExtensions = []+ , sectionGhcOptions = []+ , sectionGhcProfOptions = []+ , sectionCppOptions = []+ , sectionCCOptions = []+ , sectionCSources = []+ , sectionExtraLibDirs = []+ , sectionExtraLibraries = []+ , sectionIncludeDirs = []+ , sectionInstallIncludes = []+ , sectionLdOptions = []+ , sectionBuildable = Nothing+ , sectionConditionals = []+ , sectionBuildTools = []+ }
+ test/Hpack/ConvertSpec.hs view
@@ -0,0 +1,449 @@+{-# LANGUAGE OverloadedStrings #-}+module Hpack.ConvertSpec (spec) where++import Prelude ()+import Prelude.Compat++import Control.Monad+import qualified Data.ByteString as ByteString hiding (pack, unpack)+import qualified Data.ByteString.Char8 as ByteString (unpack)+import System.Directory+import System.FilePath+import Test.Hspec++import Hpack.Config+import Hpack.Convert++spec :: Spec+spec =+ describe "fromPackageDescriptionString" $ do+ describe "generated from ./test/data/*.{cabal,yaml}" $ do+ cabalFiles <- runIO $ do+ fs <- getDirectoryContents "./test/data"+ return $ map ("./test/data" </>)+ (filter ((== ".cabal") . takeExtension) fs)++ forM_ cabalFiles $ \cabalFp -> do+ let expectationFp = cabalFp ++ ".yaml"+ readPackageFromCabal fp = do+ cc <- readFile fp+ let Right pkg = fromPackageDescriptionString cc+ return pkg+ expectationExists <- runIO $ doesFileExist expectationFp++ if not expectationExists+ then do+ it ("parses " ++ cabalFp)+ (pendingWith ("no expected output file at " ++ expectationFp))+ it ("produces the same output from " ++ cabalFp ++ " as from " ++ expectationFp)+ (pendingWith ("no expected output file at " ++ expectationFp))+ else do+ it ("parses " ++ cabalFp) $ do+ pkg <- readPackageFromCabal cabalFp+ ecc <- ByteString.readFile expectationFp+ -- ByteString.writeFile (cabalFp ++ ".yaml.out") bpkg+ encodePackage pkg `shouldBe` ecc++ it ("produces the same output from " ++ cabalFp ++ " as from " ++ expectationFp) $ do+ pkg <- readPackageFromCabal cabalFp+ Right (_, pkg') <- readPackageConfig expectationFp+ -- ByteString.writeFile (cabalFp ++ ".yaml.out.2") (encodePackage pkg')++ -- This is here to make sure encoding is consistent with the cabal+ -- file encoding+ ByteString.unpack (encodePackage pkg') `shouldBe` ByteString.unpack (encodePackage pkg)++ describe "simple generated cabal file" $ do+ it "cabal init -m" $ do+ pkgDescription <- readFile "./test/data/cabal-init-minimal.cabal"+ let pkg = fromPackageDescriptionString pkgDescription+ pkg `shouldBe` Right Package { packageName = "cabal-init-minimal"+ , packageVersion = "0.1.0.0"+ , packageSynopsis = Nothing+ , packageDescription = Nothing+ , packageHomepage = Nothing+ , packageBugReports = Nothing+ , packageCategory = Nothing+ , packageStability = Nothing+ , packageAuthor = [ "Pedro Tacla Yamada" ]+ , packageMaintainer = [ "tacla.yamada@gmail.com" ]+ , packageCopyright = []+ , packageLicense = Just "PublicDomain"+ , packageLicenseFile = Nothing+ , packageTestedWith = Nothing+ , packageFlags = []+ , packageExtraSourceFiles = ["ChangeLog.md"]+ , packageDataFiles = []+ , packageSourceRepository = Nothing+ , packageLibrary = Just Section { sectionData = Library { libraryExposed = Just True+ , libraryExposedModules = []+ , libraryOtherModules = []+ , libraryReexportedModules = []+ }+ , sectionSourceDirs = ["src"]+ , sectionDependencies = [ Dependency "base >=4.8 && <4.9" Nothing ]+ , sectionDefaultExtensions = []+ , sectionOtherExtensions = []+ , sectionGhcOptions = []+ , sectionGhcProfOptions = []+ , sectionCppOptions = []+ , sectionCCOptions = []+ , sectionCSources = []+ , sectionExtraLibDirs = []+ , sectionExtraLibraries = []+ , sectionIncludeDirs = []+ , sectionInstallIncludes = []+ , sectionLdOptions = []+ , sectionBuildable = Just True+ , sectionConditionals = []+ , sectionBuildTools = []+ }+ , packageExecutables = []+ , packageTests = []+ , packageBenchmarks = []+ }++ it "cabal init -m with executables" $ do+ pkgDescription <- readFile "./test/data/cabal-init-with-executables.cabal"+ let pkg = fromPackageDescriptionString pkgDescription+ pkg `shouldBe` Right Package { packageName = "cabal-init-minimal"+ , packageVersion = "0.1.0.0"+ , packageSynopsis = Nothing+ , packageDescription = Nothing+ , packageHomepage = Nothing+ , packageBugReports = Nothing+ , packageCategory = Nothing+ , packageStability = Nothing+ , packageAuthor = [ "Pedro Tacla Yamada" ]+ , packageMaintainer = [ "tacla.yamada@gmail.com" ]+ , packageCopyright = []+ , packageLicense = Just "PublicDomain"+ , packageLicenseFile = Nothing+ , packageTestedWith = Nothing+ , packageFlags = []+ , packageExtraSourceFiles = ["ChangeLog.md"]+ , packageDataFiles = []+ , packageSourceRepository = Nothing+ , packageLibrary = Nothing+ , packageExecutables = [+ Section { sectionData = Executable { executableName = "hello-world"+ , executableMain = "HelloWorld.hs"+ , executableOtherModules = []+ }+ , sectionSourceDirs = [ "src" ]+ , sectionDependencies = [ Dependency "base >=4.8 && <4.9" Nothing ]+ , sectionDefaultExtensions = []+ , sectionOtherExtensions = []+ , sectionGhcOptions = []+ , sectionGhcProfOptions = []+ , sectionCppOptions = []+ , sectionCCOptions = []+ , sectionCSources = []+ , sectionExtraLibDirs = []+ , sectionExtraLibraries = []+ , sectionIncludeDirs = []+ , sectionInstallIncludes = []+ , sectionLdOptions = []+ , sectionBuildable = Just True+ , sectionConditionals = []+ , sectionBuildTools = []+ }+ ]+ , packageTests = []+ , packageBenchmarks = []+ }++ it "cabal init -m with test-suites" $ do+ pkgDescription <- readFile "./test/data/cabal-init-with-tests.cabal"+ let pkg = fromPackageDescriptionString pkgDescription+ pkg `shouldBe` Right Package { packageName = "cabal-init-minimal"+ , packageVersion = "0.1.0.0"+ , packageSynopsis = Nothing+ , packageDescription = Nothing+ , packageHomepage = Nothing+ , packageBugReports = Nothing+ , packageCategory = Nothing+ , packageStability = Nothing+ , packageAuthor = [ "Pedro Tacla Yamada" ]+ , packageMaintainer = [ "tacla.yamada@gmail.com" ]+ , packageCopyright = []+ , packageLicense = Just "PublicDomain"+ , packageLicenseFile = Nothing+ , packageTestedWith = Nothing+ , packageFlags = []+ , packageExtraSourceFiles = ["ChangeLog.md"]+ , packageDataFiles = []+ , packageSourceRepository = Nothing+ , packageLibrary = Nothing+ , packageExecutables = [+ Section { sectionData = Executable { executableName = "hello-world"+ , executableMain = "HelloWorld.hs"+ , executableOtherModules = []+ }+ , sectionSourceDirs = [ "src" ]+ , sectionDependencies = [ Dependency "base >=4.8 && <4.9" Nothing ]+ , sectionDefaultExtensions = []+ , sectionOtherExtensions = []+ , sectionGhcOptions = []+ , sectionGhcProfOptions = []+ , sectionCppOptions = []+ , sectionCCOptions = []+ , sectionCSources = []+ , sectionExtraLibDirs = []+ , sectionExtraLibraries = []+ , sectionIncludeDirs = []+ , sectionInstallIncludes = []+ , sectionLdOptions = []+ , sectionBuildable = Just True+ , sectionConditionals = []+ , sectionBuildTools = []+ }+ ]+ , packageTests = [+ Section { sectionData = Executable { executableName = "hello-world-spec"+ , executableMain = "Spec.hs"+ , executableOtherModules = []+ }+ , sectionSourceDirs = [ "src", "test" ]+ , sectionDependencies = [ Dependency "base >=4.8 && <4.9" Nothing ]+ , sectionDefaultExtensions = []+ , sectionOtherExtensions = []+ , sectionGhcOptions = []+ , sectionGhcProfOptions = []+ , sectionCppOptions = []+ , sectionCCOptions = []+ , sectionCSources = []+ , sectionExtraLibDirs = []+ , sectionExtraLibraries = []+ , sectionIncludeDirs = []+ , sectionInstallIncludes = []+ , sectionLdOptions = []+ , sectionBuildable = Just True+ , sectionConditionals = []+ , sectionBuildTools = []+ }+ ]+ , packageBenchmarks = []+ }++ it "cabal init -m with benchmarks" $ do+ pkgDescription <- readFile "./test/data/cabal-init-with-benchmarks.cabal"+ let pkg = fromPackageDescriptionString pkgDescription+ pkg `shouldBe` Right Package { packageName = "cabal-init-minimal"+ , packageVersion = "0.1.0.0"+ , packageSynopsis = Nothing+ , packageDescription = Nothing+ , packageHomepage = Nothing+ , packageBugReports = Nothing+ , packageCategory = Nothing+ , packageStability = Nothing+ , packageAuthor = [ "Pedro Tacla Yamada" ]+ , packageMaintainer = [ "tacla.yamada@gmail.com" ]+ , packageCopyright = []+ , packageLicense = Just "PublicDomain"+ , packageLicenseFile = Nothing+ , packageTestedWith = Nothing+ , packageFlags = []+ , packageExtraSourceFiles = ["ChangeLog.md"]+ , packageDataFiles = []+ , packageSourceRepository = Nothing+ , packageLibrary = Nothing+ , packageExecutables = [+ Section { sectionData = Executable { executableName = "hello-world"+ , executableMain = "HelloWorld.hs"+ , executableOtherModules = []+ }+ , sectionSourceDirs = [ "src" ]+ , sectionDependencies = [ Dependency "base >=4.8 && <4.9" Nothing ]+ , sectionDefaultExtensions = []+ , sectionOtherExtensions = []+ , sectionGhcOptions = []+ , sectionGhcProfOptions = []+ , sectionCppOptions = []+ , sectionCCOptions = []+ , sectionCSources = []+ , sectionExtraLibDirs = []+ , sectionExtraLibraries = []+ , sectionIncludeDirs = []+ , sectionInstallIncludes = []+ , sectionLdOptions = []+ , sectionBuildable = Just True+ , sectionConditionals = []+ , sectionBuildTools = []+ }+ ]+ , packageTests = [+ Section { sectionData = Executable { executableName = "hello-world-spec"+ , executableMain = "Spec.hs"+ , executableOtherModules = []+ }+ , sectionSourceDirs = [ "src", "test" ]+ , sectionDependencies = [ Dependency "base >=4.8 && <4.9" Nothing ]+ , sectionDefaultExtensions = []+ , sectionOtherExtensions = []+ , sectionGhcOptions = []+ , sectionGhcProfOptions = []+ , sectionCppOptions = []+ , sectionCCOptions = []+ , sectionCSources = []+ , sectionExtraLibDirs = []+ , sectionExtraLibraries = []+ , sectionIncludeDirs = []+ , sectionInstallIncludes = []+ , sectionLdOptions = []+ , sectionBuildable = Just True+ , sectionConditionals = []+ , sectionBuildTools = []+ }+ ]+ , packageBenchmarks = [+ Section { sectionData = Executable { executableName = "hello-world-benchmark"+ , executableMain = "Bench.hs"+ , executableOtherModules = []+ }+ , sectionSourceDirs = [ "src", "benchmarks" ]+ , sectionDependencies = [ Dependency "base >=4.8 && <4.9" Nothing ]+ , sectionDefaultExtensions = []+ , sectionOtherExtensions = []+ , sectionGhcOptions = []+ , sectionGhcProfOptions = []+ , sectionCppOptions = []+ , sectionCCOptions = []+ , sectionCSources = []+ , sectionExtraLibDirs = []+ , sectionExtraLibraries = []+ , sectionIncludeDirs = []+ , sectionInstallIncludes = []+ , sectionLdOptions = []+ , sectionBuildable = Just True+ , sectionConditionals = []+ , sectionBuildTools = []+ }+ ]+ }++ it "cabal init -m with conditionals" $ do+ pkgDescription <- readFile "./test/data/cabal-init-with-conditionals.cabal"+ let pkg = fromPackageDescriptionString pkgDescription+ pkg `shouldBe` Right Package { packageName = "cabal-init-minimal"+ , packageVersion = "0.1.0.0"+ , packageSynopsis = Nothing+ , packageDescription = Nothing+ , packageHomepage = Nothing+ , packageBugReports = Nothing+ , packageCategory = Nothing+ , packageStability = Nothing+ , packageAuthor = [ "Pedro Tacla Yamada" ]+ , packageMaintainer = [ "tacla.yamada@gmail.com" ]+ , packageCopyright = []+ , packageLicense = Just "PublicDomain"+ , packageLicenseFile = Nothing+ , packageTestedWith = Nothing+ , packageFlags = []+ , packageExtraSourceFiles = ["ChangeLog.md"]+ , packageDataFiles = []+ , packageSourceRepository = Nothing+ , packageLibrary = Nothing+ , packageExecutables = [+ Section { sectionData = Executable { executableName = "hello-world"+ , executableMain = "HelloWorld.hs"+ , executableOtherModules = []+ }+ , sectionSourceDirs = [ "src" ]+ , sectionDependencies = [ Dependency "base >=4.8 && <4.9" Nothing ]+ , sectionDefaultExtensions = []+ , sectionOtherExtensions = []+ , sectionGhcOptions = []+ , sectionGhcProfOptions = []+ , sectionCppOptions = []+ , sectionCCOptions = []+ , sectionCSources = []+ , sectionExtraLibDirs = []+ , sectionExtraLibraries = []+ , sectionIncludeDirs = []+ , sectionInstallIncludes = []+ , sectionLdOptions = []+ , sectionBuildable = Just True+ , sectionConditionals = [ Conditional "os(osx)" (emptySection {sectionBuildable = Just False}) Nothing+ ]+ , sectionBuildTools = []+ }+ ]+ , packageTests = []+ , packageBenchmarks = []+ }++ it "cabal init -m with conditionals and an else branch" $ do+ pkgDescription <- readFile "./test/data/cabal-init-with-conditionals-and-else.cabal"+ let pkg = fromPackageDescriptionString pkgDescription+ pkg `shouldBe` Right Package { packageName = "cabal-init-minimal"+ , packageVersion = "0.1.0.0"+ , packageSynopsis = Nothing+ , packageDescription = Nothing+ , packageHomepage = Nothing+ , packageBugReports = Nothing+ , packageCategory = Nothing+ , packageStability = Nothing+ , packageAuthor = [ "Pedro Tacla Yamada" ]+ , packageMaintainer = [ "tacla.yamada@gmail.com" ]+ , packageCopyright = []+ , packageLicense = Just "PublicDomain"+ , packageLicenseFile = Nothing+ , packageTestedWith = Nothing+ , packageFlags = []+ , packageExtraSourceFiles = ["ChangeLog.md"]+ , packageDataFiles = []+ , packageSourceRepository = Nothing+ , packageLibrary = Nothing+ , packageExecutables = [+ Section { sectionData = Executable { executableName = "hello-world"+ , executableMain = "HelloWorld.hs"+ , executableOtherModules = []+ }+ , sectionSourceDirs = [ "src" ]+ , sectionDependencies = [ Dependency "base >=4.8 && <4.9" Nothing ]+ , sectionDefaultExtensions = []+ , sectionOtherExtensions = []+ , sectionGhcOptions = []+ , sectionGhcProfOptions = []+ , sectionCppOptions = []+ , sectionCCOptions = []+ , sectionCSources = []+ , sectionExtraLibDirs = []+ , sectionExtraLibraries = []+ , sectionIncludeDirs = []+ , sectionInstallIncludes = []+ , sectionLdOptions = []+ , sectionBuildable = Just True+ , sectionConditionals = [+ Conditional "os(osx)"+ (emptySection {sectionSourceDirs = ["osx"]})+ (Just emptySection {sectionSourceDirs = ["notosx"]})+ ]+ , sectionBuildTools = []+ }+ ]+ , packageTests = []+ , packageBenchmarks = []+ }++emptySection :: Section ()+emptySection = Section { sectionData = ()+ , sectionSourceDirs = []+ , sectionDependencies = []+ , sectionDefaultExtensions = []+ , sectionOtherExtensions = []+ , sectionGhcOptions = []+ , sectionGhcProfOptions = []+ , sectionCppOptions = []+ , sectionCCOptions = []+ , sectionCSources = []+ , sectionExtraLibDirs = []+ , sectionExtraLibraries = []+ , sectionIncludeDirs = []+ , sectionInstallIncludes = []+ , sectionLdOptions = []+ , sectionBuildable = Just True+ , sectionConditionals = []+ , sectionBuildTools = []+ }
+ test/Hpack/FormattingHintsSpec.hs view
@@ -0,0 +1,166 @@+module Hpack.FormattingHintsSpec (spec) where++import Test.Hspec++import Hpack.FormattingHints+import Hpack.Render++spec :: Spec+spec = do+ describe "extractFieldOrder" $ do+ it "extracts field order hints" $ do+ let input = [+ "name: cabalize"+ , "version: 0.0.0"+ , "license:"+ , "license-file: "+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ ]+ extractFieldOrder input `shouldBe` [+ "name"+ , "version"+ , "license"+ , "license-file"+ , "build-type"+ , "cabal-version"+ ]++ describe "extractSectionsFieldOrder" $ do+ it "splits input into sections" $ do+ let input = [+ "name: cabalize"+ , "version: 0.0.0"+ , ""+ , "library"+ , " foo: 23"+ , " bar: 42"+ , ""+ , "executable foo"+ , " bar: 23"+ , " baz: 42"+ ]+ extractSectionsFieldOrder input `shouldBe` [("library", ["foo", "bar"]), ("executable foo", ["bar", "baz"])]++ describe "breakLines" $ do+ it "breaks input into lines" $ do+ let input = unlines [+ "foo"+ , ""+ , " "+ , " bar "+ , " baz"+ ]+ breakLines input `shouldBe` [+ "foo"+ , " bar"+ , " baz"+ ]++ describe "unindent" $ do+ it "unindents" $ do+ let input = [+ " foo"+ , " bar"+ , " baz"+ ]+ unindent input `shouldBe` [+ " foo"+ , "bar"+ , " baz"+ ]++ describe "sniffAlignment" $ do+ it "sniffs field alignment from given cabal file" $ do+ let input = [+ "name: cabalize"+ , "version: 0.0.0"+ , "license: MIT"+ , "license-file: LICENSE"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ ]+ sniffAlignment input `shouldBe` Just 16++ it "ignores fields without a value on the same line" $ do+ let input = [+ "name: cabalize"+ , "version: 0.0.0"+ , "description: "+ , " foo"+ , " bar"+ ]+ sniffAlignment input `shouldBe` Just 16++ describe "splitField" $ do+ it "splits fields" $ do+ splitField "foo: bar" `shouldBe` Just ("foo", " bar")++ it "accepts fields names with dashes" $ do+ splitField "foo-bar: baz" `shouldBe` Just ("foo-bar", " baz")++ it "rejects fields names with spaces" $ do+ splitField "foo bar: baz" `shouldBe` Nothing++ it "rejects invalid fields" $ do+ splitField "foo bar" `shouldBe` Nothing++ describe "sniffIndentation" $ do+ it "sniff alignment from executable section" $ do+ let input = [+ "name: foo"+ , "version: 0.0.0"+ , ""+ , "executable foo"+ , " build-depends: bar"+ ]+ sniffIndentation input `shouldBe` Just 4++ it "sniff alignment from library section" $ do+ let input = [+ "name: foo"+ , "version: 0.0.0"+ , ""+ , "library"+ , " build-depends: bar"+ ]+ sniffIndentation input `shouldBe` Just 4++ it "ignores empty lines" $ do+ let input = [+ "executable foo"+ , ""+ , " build-depends: bar"+ ]+ sniffIndentation input `shouldBe` Just 4++ it "ignores whitespace lines" $ do+ let input = [+ "executable foo"+ , " "+ , " build-depends: bar"+ ]+ sniffIndentation input `shouldBe` Just 4++ describe "sniffCommaStyle" $ do+ it "detects leading commas" $ do+ let input = [+ "executable foo"+ , " build-depends:"+ , " bar"+ , " , baz"+ ]+ sniffCommaStyle input `shouldBe` Just LeadingCommas++ it "detects trailing commas" $ do+ let input = [+ "executable foo"+ , " build-depends:"+ , " bar, "+ , " baz"+ ]+ sniffCommaStyle input `shouldBe` Just TrailingCommas++ context "when detection fails" $ do+ it "returns Nothing" $ do+ sniffCommaStyle [] `shouldBe` Nothing
+ test/Hpack/GenericsUtilSpec.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE DeriveGeneric #-}+module Hpack.GenericsUtilSpec (spec) where++import Test.Hspec++import Data.Proxy+import GHC.Generics++import Hpack.GenericsUtil++data Person = Person {+ _personName :: String+, _personAge :: Int+} deriving Generic++spec :: Spec+spec = do+ describe "selectors" $ do+ it "returns a list of record selectors" $ do+ selectors (Proxy :: Proxy Person) `shouldBe` ["_personName", "_personAge"]++ describe "typeName" $ do+ it "gets datatype name" $ do+ typeName (Proxy :: Proxy Person) `shouldBe` "Person"
+ test/Hpack/HaskellSpec.hs view
@@ -0,0 +1,31 @@+module Hpack.HaskellSpec (spec) where++import Test.Hspec++import Hpack.Haskell++spec :: Spec+spec = do+ describe "isModule" $ do+ it "accepts module names" $ do+ isModule ["Foo", "Bar"] `shouldBe` True++ it "rejects the empty list" $ do+ isModule [] `shouldBe` False++ describe "isQualifiedIdentifier" $ do+ it "accepts qualified Haskell identifiers" $ do+ isQualifiedIdentifier ["Foo", "Bar", "baz"] `shouldBe` True++ it "rejects invalid input" $ do+ isQualifiedIdentifier ["Foo", "Bar", "Baz"] `shouldBe` False++ describe "isIdentifier" $ do+ it "accepts Haskell identifiers" $ do+ isIdentifier "foo" `shouldBe` True++ it "rejects reserved keywords" $ do+ isIdentifier "case" `shouldBe` False++ it "rejects invalid input" $ do+ isIdentifier "Foo" `shouldBe` False
+ test/Hpack/RenderSpec.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE OverloadedStrings #-}+module Hpack.RenderSpec where++import Prelude ()+import Prelude.Compat++import Test.Hspec+import Test.QuickCheck+import Data.List.Compat+import Data.Maybe++import Hpack.Render++spec :: Spec+spec = do+ describe "render" $ do+ let render_ = render defaultRenderSettings 0+ context "when rendering a Stanza" $ do+ it "renders stanza" $ do+ let stanza = Stanza "foo" [+ Field "bar" "23"+ , Field "baz" "42"+ ]+ render_ stanza `shouldBe` [+ "foo"+ , " bar: 23"+ , " baz: 42"+ ]++ it "omits empty fields" $ do+ let stanza = Stanza "foo" [+ Field "bar" "23"+ , Field "baz" (WordList [])+ ]+ render_ stanza `shouldBe` [+ "foo"+ , " bar: 23"+ ]++ it "allows to customize indentation" $ do+ let stanza = Stanza "foo" [+ Field "bar" "23"+ , Field "baz" "42"+ ]+ render defaultRenderSettings{renderSettingsIndentation = 4} 0 stanza `shouldBe` [+ "foo"+ , " bar: 23"+ , " baz: 42"+ ]++ it "renders nested stanzas" $ do+ let input = Stanza "foo" [Field "bar" "23", Stanza "baz" [Field "qux" "42"]]+ render_ input `shouldBe` [+ "foo"+ , " bar: 23"+ , " baz"+ , " qux: 42"+ ]++ context "when rendering a Field" $ do+ context "when rendering a MultipleLines value" $ do+ it "takes nesting into account" $ do+ let field = Field "foo" (CommaSeparatedList ["bar", "baz"])+ render defaultRenderSettings 1 field `shouldBe` [+ " foo:"+ , " bar"+ , " , baz"+ ]++ context "when value is empty" $ do+ it "returns an empty list" $ do+ let field = Field "foo" (CommaSeparatedList [])+ render_ field `shouldBe` []++ context "when rendering a SingleLine value" $ do+ it "returns a single line" $ do+ let field = Field "foo" (Literal "bar")+ render_ field `shouldBe` ["foo: bar"]++ it "takes nesting into account" $ do+ let field = Field "foo" (Literal "bar")+ render defaultRenderSettings 2 field `shouldBe` [" foo: bar"]++ it "takes alignment into account" $ do+ let field = Field "foo" (Literal "bar")+ render defaultRenderSettings {renderSettingsFieldAlignment = 10} 0 field `shouldBe` ["foo: bar"]++ context "when value is empty" $ do+ it "returns an empty list" $ do+ let field = Field "foo" (Literal "")+ render_ field `shouldBe` []++ describe "renderValue" $ do+ it "renders WordList" $ do+ renderValue defaultRenderSettings (WordList ["foo", "bar", "baz"]) `shouldBe` SingleLine "foo bar baz"++ it "renders CommaSeparatedList" $ do+ renderValue defaultRenderSettings (CommaSeparatedList ["foo", "bar", "baz"]) `shouldBe` MultipleLines [+ " foo"+ , ", bar"+ , ", baz"+ ]++ it "renders LineSeparatedList" $ do+ renderValue defaultRenderSettings (LineSeparatedList ["foo", "bar", "baz"]) `shouldBe` MultipleLines [+ " foo"+ , " bar"+ , " baz"+ ]++ context "when renderSettingsCommaStyle is TrailingCommas" $ do+ let settings = defaultRenderSettings{renderSettingsCommaStyle = TrailingCommas}++ it "renders CommaSeparatedList with trailing commas" $ do+ renderValue settings (CommaSeparatedList ["foo", "bar", "baz"]) `shouldBe` MultipleLines [+ "foo,"+ , "bar,"+ , "baz"+ ]++ it "renders LineSeparatedList without padding" $ do+ renderValue settings (LineSeparatedList ["foo", "bar", "baz"]) `shouldBe` MultipleLines [+ "foo"+ , "bar"+ , "baz"+ ]++ describe "sortFieldsBy" $ do+ let+ field name = Field name (Literal $ name ++ " value")+ arbitraryFieldNames = sublistOf ["foo", "bar", "baz", "qux", "foobar", "foobaz"] >>= shuffle++ it "sorts fields" $ do+ let fields = map field ["baz", "bar", "foo"]+ sortFieldsBy ["foo", "bar", "baz"] fields `shouldBe` map field ["foo", "bar", "baz"]++ it "keeps existing field order" $ do+ forAll (map field <$> arbitraryFieldNames) $ \fields -> do+ forAll arbitraryFieldNames $ \existingFieldOrder -> do+ let+ existingIndex :: Element -> Maybe Int+ existingIndex (Field name _) = name `elemIndex` existingFieldOrder+ existingIndex _ = Nothing++ indexes :: [Int]+ indexes = mapMaybe existingIndex (sortFieldsBy existingFieldOrder fields)++ sort indexes `shouldBe` indexes++ it "is stable" $ do+ forAll arbitraryFieldNames $ \fieldNames -> do+ forAll (elements $ subsequences fieldNames) $ \existingFieldOrder -> do+ let fields = map field fieldNames+ sortFieldsBy existingFieldOrder fields `shouldBe` fields++ describe "addSortKey" $ do+ it "adds sort key" $ do+ addSortKey [(Nothing, "foo"), (Just 3, "bar"), (Nothing, "baz")] `shouldBe` [((-1, 0), "foo"), ((3, 1), "bar"), ((3, 2), "baz" :: String)]
+ test/Hpack/RunSpec.hs view
@@ -0,0 +1,325 @@+{-# LANGUAGE OverloadedStrings #-}+module Hpack.RunSpec (spec) where++import Test.Hspec+import Data.List.Compat++import Hpack.ConfigSpec hiding (spec)+import Hpack.Config hiding (package)+import Hpack.Render+import Hpack.Run++spec :: Spec+spec = do+ describe "renderPackage" $ do+ let renderPackage_ = renderPackage defaultRenderSettings 0 [] []+ it "renders a package" $ do+ renderPackage_ package `shouldBe` unlines [+ "name: foo"+ , "version: 0.0.0"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ ]++ it "aligns fields" $ do+ renderPackage defaultRenderSettings 16 [] [] package `shouldBe` unlines [+ "name: foo"+ , "version: 0.0.0"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ ]++ it "includes description" $ do+ renderPackage_ package {packageDescription = Just "foo\n\nbar\n"} `shouldBe` unlines [+ "name: foo"+ , "version: 0.0.0"+ , "description: foo"+ , " ."+ , " bar"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ ]++ it "aligns description" $ do+ renderPackage defaultRenderSettings 16 [] [] package {packageDescription = Just "foo\n\nbar\n"} `shouldBe` unlines [+ "name: foo"+ , "version: 0.0.0"+ , "description: foo"+ , " ."+ , " bar"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ ]++ it "includes stability" $ do+ renderPackage_ package {packageStability = Just "experimental"} `shouldBe` unlines [+ "name: foo"+ , "version: 0.0.0"+ , "stability: experimental"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ ]++ it "includes copyright holder" $ do+ renderPackage_ package {packageCopyright = ["(c) 2015 Simon Hengel"]} `shouldBe` unlines [+ "name: foo"+ , "version: 0.0.0"+ , "copyright: (c) 2015 Simon Hengel"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ ]++ it "aligns copyright holders" $ do+ renderPackage defaultRenderSettings 16 [] [] package {packageCopyright = ["(c) 2015 Foo", "(c) 2015 Bar"]} `shouldBe` unlines [+ "name: foo"+ , "version: 0.0.0"+ , "copyright: (c) 2015 Foo,"+ , " (c) 2015 Bar"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ ]++ it "includes extra-source-files" $ do+ renderPackage_ package {packageExtraSourceFiles = ["foo", "bar"]} `shouldBe` unlines [+ "name: foo"+ , "version: 0.0.0"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ , ""+ , "extra-source-files:"+ , " foo"+ , " bar"+ ]++ it "includes buildable" $ do+ renderPackage_ package {packageLibrary = Just (section library){sectionBuildable = Just False}} `shouldBe` unlines [+ "name: foo"+ , "version: 0.0.0"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ , ""+ , "library"+ , " buildable: False"+ , " default-language: Haskell2010"+ ]++ context "when rendering library section" $ do+ it "renders library section" $ do+ renderPackage_ package {packageLibrary = Just $ section library} `shouldBe` unlines [+ "name: foo"+ , "version: 0.0.0"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ , ""+ , "library"+ , " 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 [+ "cabal-version: >= 1.10"+ , "version: 0.0.0"+ , "name: foo"+ , "build-type: Simple"+ ]++ it "uses default field order for new fields" $ do+ renderPackage defaultRenderSettings 16 ["name", "version", "cabal-version"] [] package `shouldBe` unlines [+ "name: foo"+ , "version: 0.0.0"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ ]++ 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 [+ "name: foo"+ , "version: 0.0.0"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ , ""+ , "executable foo"+ , " default-language: Haskell2010"+ , " main-is: Main.hs"+ , " ghc-options: -Wall -Werror"+ ]+++ context "when rendering executable section" $ do+ it "includes dependencies" $ do+ renderPackage_ package {packageExecutables = [(section $ executable "foo" "Main.hs") {sectionDependencies = ["foo", "bar", "foo", "baz"]}]} `shouldBe` unlines [+ "name: foo"+ , "version: 0.0.0"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ , ""+ , "executable foo"+ , " main-is: Main.hs"+ , " build-depends:"+ , " foo"+ , " , bar"+ , " , foo"+ , " , baz"+ , " default-language: Haskell2010"+ ]++ it "includes GHC options" $ do+ renderPackage_ package {packageExecutables = [(section $ executable "foo" "Main.hs") {sectionGhcOptions = ["-Wall", "-Werror"]}]} `shouldBe` unlines [+ "name: foo"+ , "version: 0.0.0"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ , ""+ , "executable foo"+ , " main-is: Main.hs"+ , " ghc-options: -Wall -Werror"+ , " default-language: Haskell2010"+ ]++ it "includes GHC profiling options" $ do+ renderPackage_ package {packageExecutables = [(section $ executable "foo" "Main.hs") {sectionGhcProfOptions = ["-fprof-auto", "-rtsopts"]}]} `shouldBe` unlines [+ "name: foo"+ , "version: 0.0.0"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ , ""+ , "executable foo"+ , " main-is: Main.hs"+ , " ghc-prof-options: -fprof-auto -rtsopts"+ , " default-language: Haskell2010"+ ]+ describe "renderConditional" $ do+ it "renders conditionals" $ do+ let conditional = Conditional "os(windows)" (section ()) {sectionDependencies = ["Win32"]} Nothing+ render defaultRenderSettings 0 (renderConditional conditional) `shouldBe` [+ "if os(windows)"+ , " build-depends:"+ , " Win32"+ ]++ it "renders conditionals with else-branch" $ do+ let conditional = Conditional "os(windows)" (section ()) {sectionDependencies = ["Win32"]} (Just $ (section ()) {sectionDependencies = ["unix"]})+ render defaultRenderSettings 0 (renderConditional conditional) `shouldBe` [+ "if os(windows)"+ , " build-depends:"+ , " Win32"+ , "else"+ , " build-depends:"+ , " unix"+ ]++ it "renders nested conditionals" $ do+ let conditional = Conditional "arch(i386)" (section ()) {sectionGhcOptions = ["-threaded"], sectionConditionals = [innerConditional]} Nothing+ innerConditional = Conditional "os(windows)" (section ()) {sectionDependencies = ["Win32"]} Nothing+ render defaultRenderSettings 0 (renderConditional conditional) `shouldBe` [+ "if arch(i386)"+ , " ghc-options: -threaded"+ , " if os(windows)"+ , " build-depends:"+ , " Win32"+ ]++ describe "renderFlag" $ do+ it "renders flags" $ do+ let flag = (Flag "foo" (Just "some flag") True False)+ render defaultRenderSettings 0 (renderFlag flag) `shouldBe` [+ "flag foo"+ , " description: some flag"+ , " manual: True"+ , " default: False"+ ]++ describe "formatDescription" $ do+ it "formats description" $ do+ let description = unlines [+ "foo"+ , "bar"+ ]+ "description: " ++ formatDescription 0 description `shouldBe` intercalate "\n" [+ "description: foo"+ , " bar"+ ]++ it "takes specified alignment into account" $ do+ let description = unlines [+ "foo"+ , "bar"+ , "baz"+ ]+ "description: " ++ formatDescription 15 description `shouldBe` intercalate "\n" [+ "description: foo"+ , " bar"+ , " baz"+ ]++ it "formats empty lines" $ do+ let description = unlines [+ "foo"+ , " "+ , "bar"+ ]+ "description: " ++ formatDescription 0 description `shouldBe` intercalate "\n" [+ "description: foo"+ , " ."+ , " bar"+ ]++ describe "renderSourceRepository" $ do+ it "renders source-repository without subdir correctly" $ do+ let repository = SourceRepository "https://github.com/hspec/hspec" Nothing+ (render defaultRenderSettings 0 $ renderSourceRepository repository)+ `shouldBe` [+ "source-repository head"+ , " type: git"+ , " location: https://github.com/hspec/hspec"+ ]++ it "renders source-repository with subdir" $ do+ let repository = SourceRepository "https://github.com/hspec/hspec" (Just "hspec-core")+ (render defaultRenderSettings 0 $ renderSourceRepository repository)+ `shouldBe` [+ "source-repository head"+ , " type: git"+ , " location: https://github.com/hspec/hspec"+ , " subdir: hspec-core"+ ]
+ test/Hpack/UtilSpec.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+module Hpack.UtilSpec (main, spec) where++import Data.Aeson+import Data.Aeson.QQ+import Data.Aeson.Types+import Helper+import System.Directory++import Hpack.Config+import Hpack.Util++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "sort" $ do+ it "sorts lexicographically" $ do+ sort ["foo", "Foo"] `shouldBe` ["Foo", "foo" :: String]++ describe "parseMain" $ do+ it "accepts source file" $ do+ parseMain "Main.hs" `shouldBe` ("Main.hs", [])++ it "accepts literate source file" $ do+ parseMain "Main.lhs" `shouldBe` ("Main.lhs", [])++ it "accepts module" $ do+ parseMain "Foo" `shouldBe` ("Foo.hs", ["-main-is Foo"])++ it "accepts hierarchical module" $ do+ parseMain "Foo.Bar.Baz" `shouldBe` ("Foo/Bar/Baz.hs", ["-main-is Foo.Bar.Baz"])++ it "accepts qualified identifier" $ do+ parseMain "Foo.bar" `shouldBe` ("Foo.hs", ["-main-is Foo.bar"])++ describe "toModule" $ do+ it "maps paths to module names" $ do+ toModule ["Foo", "Bar", "Baz.hs"] `shouldBe` Just "Foo.Bar.Baz"++ it "rejects invalid module names" $ do+ toModule ["resources", "hello.hs"] `shouldBe` Nothing++ describe "getFilesRecursive" $ do+ it "gets all files from given directory and all its subdirectories" $ do+ inTempDirectoryNamed "test" $ do+ touch "foo/bar"+ touch "foo/baz"+ touch "foo/foobar/baz"+ actual <- getFilesRecursive "foo"+ actual `shouldMatchList` [+ ["bar"]+ , ["baz"]+ , ["foobar", "baz"]+ ]++ describe "List" $ do+ let invalid = [aesonQQ|{+ name: "hpack",+ gi: "sol/hpack",+ ref: "master"+ }|]+ parseError :: String -> Either String (List Dependency)+ parseError prefix = Left (prefix ++ ": neither key \"git\" nor key \"github\" present")+ context "when parsing single values" $ do+ it "returns the value in a singleton list" $ do+ fromJSON (toJSON $ Number 23) `shouldBe` Success (List [23 :: Int])++ it "returns error messages from element parsing" $ do+ parseEither parseJSON invalid `shouldBe` parseError "Error in $"++ context "when parsing a list of values" $ do+ it "returns the list" $ do+ fromJSON (toJSON [Number 23, Number 42]) `shouldBe` Success (List [23, 42 :: Int])++ it "propagates parse error messages of invalid elements" $ do+ parseEither parseJSON (toJSON [String "foo", invalid]) `shouldBe` parseError "Error in $[1]"++ describe "tryReadFile" $ do+ it "reads file" $ do+ inTempDirectory $ do+ writeFile "foo" "bar"+ tryReadFile "foo" `shouldReturn` Just "bar"++ it "returns Nothing if file does not exist" $ do+ inTempDirectory $ do+ tryReadFile "foo" `shouldReturn` Nothing++ describe "expandGlobs" $ around withTempDirectory $ do+ it "accepts simple files" $ \dir -> do+ touch (dir </> "foo.js")+ expandGlobs dir ["foo.js"] `shouldReturn` ([], ["foo.js"])++ it "removes duplicates" $ \dir -> do+ touch (dir </> "foo.js")+ expandGlobs dir ["foo.js", "*.js"] `shouldReturn` ([], ["foo.js"])++ it "rejects directories" $ \dir -> do+ touch (dir </> "foo")+ createDirectory (dir </> "bar")+ expandGlobs dir ["*"] `shouldReturn` ([], ["foo"])++ it "rejects character ranges" $ \dir -> do+ touch (dir </> "foo1")+ touch (dir </> "foo2")+ touch (dir </> "foo[1,2]")+ expandGlobs dir ["foo[1,2]"] `shouldReturn` ([], ["foo[1,2]"])++ context "when expanding *" $ do+ it "expands by extension" $ \dir -> do+ let files = [+ "files/foo.js"+ , "files/bar.js"+ , "files/baz.js"]+ mapM_ (touch . (dir </>)) files+ touch (dir </> "files/foo.hs")+ expandGlobs dir ["files/*.js"] `shouldReturn` ([], sort files)++ it "rejects dot-files" $ \dir -> do+ touch (dir </> "foo/bar")+ touch (dir </> "foo/.baz")+ expandGlobs dir ["foo/*"] `shouldReturn` ([], ["foo/bar"])++ it "accepts dot-files when explicitly asked to" $ \dir -> do+ touch (dir </> "foo/bar")+ touch (dir </> "foo/.baz")+ expandGlobs dir ["foo/.*"] `shouldReturn` ([], ["foo/.baz"])++ it "matches at most one directory component" $ \dir -> do+ touch (dir </> "foo/bar/baz.js")+ touch (dir </> "foo/bar.js")+ expandGlobs dir ["*/*.js"] `shouldReturn` ([], ["foo/bar.js"])++ context "when expanding **" $ do+ it "matches arbitrary many directory components" $ \dir -> do+ let file = "foo/bar/baz.js"+ touch (dir </> file)+ expandGlobs dir ["**/*.js"] `shouldReturn` ([], [file])++ context "when a pattern does not match anything" $ do+ it "warns" $ \dir -> do+ expandGlobs dir ["foo"] `shouldReturn`+ (["Specified pattern \"foo\" for extra-source-files does not match any files"], [])++ context "when a pattern only matches a directory" $ do+ it "warns" $ \dir -> do+ createDirectory (dir </> "foo")+ expandGlobs dir ["foo"] `shouldReturn`+ (["Specified pattern \"foo\" for extra-source-files does not match any files"], [])
+ test/HpackSpec.hs view
@@ -0,0 +1,73 @@+module HpackSpec (spec) where++import Prelude ()+import Prelude.Compat++import Control.Monad.Compat+import Control.DeepSeq+import Data.Version (Version (..), showVersion)++import Test.Hspec+import Test.Mockery.Directory+import Test.QuickCheck++import Hpack+import Hpack.Config+import Hpack.Convert++makeVersion :: [Int] -> Version+makeVersion v = Version v []++spec :: Spec+spec = do+ describe "parseVerbosity" $ do+ it "returns True by default" $ do+ parseVerbosity ["foo"] `shouldBe` (True, ["foo"])++ context "with --silent" $ do+ it "returns False" $ do+ parseVerbosity ["--silent"] `shouldBe` (False, [])++ describe "extractVersion" $ do+ it "extracts Hpack version from a cabal file" $ do+ let cabalFile = ["-- This file has been generated from package.yaml by hpack version 0.10.0."]+ extractVersion cabalFile `shouldBe` Just (Version [0, 10, 0] [])++ it "is total" $ do+ let cabalFile = ["-- This file has been generated from package.yaml by hpack version "]+ extractVersion cabalFile `shouldBe` Nothing++ describe "parseVersion" $ do+ it "is inverse to showVersion" $ do+ let positive = getPositive <$> arbitrary+ forAll (replicateM 3 positive) $ \xs -> do+ let v = Version xs []+ parseVersion (showVersion v) `shouldBe` Just v++ describe "hpackWithVersion" $ do+ context "when only the hpack version in the cabal file header changed" $ do+ it "does not write a new cabal file" $ do+ inTempDirectory $ do+ writeFile "package.yaml" "name: foo"+ hpackWithVersion (makeVersion [0,8,0]) "." False+ old <- readFile "foo.cabal" >>= (return $!!)+ hpackWithVersion (makeVersion [0,10,0]) "." False+ readFile "foo.cabal" `shouldReturn` old++ context "when exsting cabal file was generated with a newer version of hpack" $ do+ it "does not re-generate" $ do+ inTempDirectory $ do+ writeFile "package.yaml" $ unlines [+ "name: foo"+ , "version: 0.1.0"+ ]+ hpackWithVersion (makeVersion [0,10,0]) "." False+ old <- readFile "foo.cabal" >>= (return $!!)++ writeFile "package.yaml" $ unlines [+ "name: foo"+ , "version: 0.2.0"+ ]++ hpackWithVersion (makeVersion [0,8,0]) "." False+ readFile "foo.cabal" `shouldReturn` old
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}