hpack (empty) → 0.1.0
raw patch · 12 files changed
+1307/−0 lines, 12 filesdep +aesondep +basedep +base-compatsetup-changed
Dependencies added: aeson, base, base-compat, deepseq, directory, filepath, hspec, interpolate, mockery, unordered-containers, yaml
Files
- LICENSE +19/−0
- Setup.lhs +3/−0
- driver/Main.hs +16/−0
- hpack.cabal +60/−0
- src/Config.hs +247/−0
- src/Run.hs +192/−0
- src/Util.hs +94/−0
- test/ConfigSpec.hs +408/−0
- test/Helper.hs +15/−0
- test/RunSpec.hs +152/−0
- test/Spec.hs +1/−0
- test/UtilSpec.hs +100/−0
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2014 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,16 @@+module Main (main) where++import Prelude ()+import Prelude.Compat+import Control.Monad+import Control.DeepSeq+import Control.Exception+import System.IO.Error++import Run++main :: IO ()+main = do+ (name, new) <- run+ old <- force . either (const Nothing) Just <$> tryJust (guard . isDoesNotExistError) (readFile name)+ unless (old == Just new) (writeFile name new)
+ hpack.cabal view
@@ -0,0 +1,60 @@+-- This file has been generated from package.yaml by hpack version 0.1.0.+--+-- see: https://github.com/sol/hpack++name: hpack+version: 0.1.0+synopsis: An alternative format for Haskell packages+homepage: https://github.com/sol/hpack#readme+bug-reports: https://github.com/sol/hpack/issues+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10++source-repository head+ type: git+ location: https://github.com/sol/hpack++executable hpack+ hs-source-dirs: driver, src+ main-is: Main.hs+ build-depends:+ aeson >= 0.8+ , base == 4.*+ , base-compat >= 0.8+ , deepseq+ , directory+ , filepath+ , unordered-containers+ , yaml+ ghc-options: -Wall+ default-language: Haskell2010++test-suite spec+ type: exitcode-stdio-1.0+ hs-source-dirs: test, src+ main-is: Spec.hs+ other-modules:+ ConfigSpec+ Helper+ RunSpec+ UtilSpec+ Config+ Run+ Util+ build-depends:+ aeson >= 0.8+ , base == 4.*+ , base-compat >= 0.8+ , deepseq+ , directory+ , filepath+ , unordered-containers+ , yaml++ , hspec == 2.*+ , mockery+ , interpolate+ ghc-options: -Wall+ default-language: Haskell2010
+ src/Config.hs view
@@ -0,0 +1,247 @@+{-# LANGUAGE DeriveGeneric, RecordWildCards #-}+module Config (+ readPackageConfig+, Package(..)+, Dependency+, GhcOption+, Library(..)+, Executable(..)+) where++import Prelude ()+import Prelude.Compat+import Control.Applicative+import Control.Monad.Compat+import Data.List ((\\))+import Data.String+import Data.Maybe+import Data.Yaml+import GHC.Generics+import Data.HashMap.Lazy (HashMap)+import qualified Data.HashMap.Lazy as Map+import System.FilePath+import System.Directory++import Util++data LibrarySection = LibrarySection {+ librarySectionSourceDirs :: Maybe (List FilePath)+, librarySectionExposedModules :: Maybe (List String)+, librarySectionOtherModules :: Maybe (List String)+, librarySectionDependencies :: Maybe (List Dependency)+, librarySectionDefaultExtensions :: Maybe (List String)+, librarySectionGhcOptions :: Maybe (List GhcOption)+} deriving (Eq, Show, Generic)++instance FromJSON LibrarySection where+ parseJSON = genericParseJSON_ "LibrarySection"++data ExecutableSection = ExecutableSection {+ executableSectionMain :: FilePath+, executableSectionSourceDirs :: Maybe (List FilePath)+, executableSectionOtherModules :: Maybe (List String)+, executableSectionDependencies :: Maybe (List Dependency)+, executableSectionDefaultExtensions :: Maybe (List String)+, executableSectionGhcOptions :: Maybe (List GhcOption)+} deriving (Eq, Show, Generic)++instance FromJSON ExecutableSection where+ parseJSON = genericParseJSON_ "ExecutableSection"++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+, packageConfigExtraSourceFiles :: Maybe (List FilePath)+, packageConfigGithub :: Maybe String+, packageConfigSourceDirs :: Maybe (List FilePath)+, packageConfigDependencies :: Maybe (List Dependency)+, packageConfigDefaultExtensions :: Maybe (List String)+, packageConfigGhcOptions :: Maybe (List GhcOption)+, packageConfigLibrary :: Maybe LibrarySection+, packageConfigExecutables :: Maybe (HashMap String ExecutableSection)+, packageConfigTests :: Maybe (HashMap String ExecutableSection)+} deriving (Eq, Show, Generic)++instance FromJSON PackageConfig where+ parseJSON value = handleNullValues <$> genericParseJSON_ "PackageConfig" 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)++readPackageConfig :: FilePath -> IO (Either String Package)+readPackageConfig file = do+ config <- decodeFileEither file+ either (return . Left . errToString) (fmap Right . mkPackage) config+ where+ errToString err = file ++ case err of+ AesonException e -> ": " ++ e+ InvalidYaml (Just e) -> let loc = yamlProblemMark e in ":" ++ show (yamlLine loc) ++ ":" ++ show (yamlColumn loc) ++ ": " ++ yamlProblem e ++ " " ++ yamlContext e+ _ -> ": " ++ show err++type Dependency = String+type GhcOption = 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+, packageExtraSourceFiles :: [FilePath]+, packageSourceRepository :: Maybe String+, packageLibrary :: Maybe Library+, packageExecutables :: [Executable]+, packageTests :: [Executable]+} deriving (Eq, Show)++data Library = Library {+ librarySourceDirs :: [FilePath]+, libraryExposedModules :: [String]+, libraryOtherModules :: [String]+, libraryDependencies :: [[Dependency]]+, libraryDefaultExtensions :: [String]+, libraryGhcOptions :: [GhcOption]+} deriving (Eq, Show)++data Executable = Executable {+ executableName :: String+, executableMain :: FilePath+, executableSourceDirs :: [FilePath]+, executableOtherModules :: [String]+, executableDependencies :: [[Dependency]]+, executableDefaultExtensions :: [String]+, executableGhcOptions :: [GhcOption]+} deriving (Eq, Show)++mkPackage :: PackageConfig -> IO Package+mkPackage PackageConfig{..} = do+ let dependencies = fromMaybeList packageConfigDependencies+ let sourceDirs = fromMaybeList packageConfigSourceDirs+ let defaultExtensions = fromMaybeList packageConfigDefaultExtensions+ let ghcOptions = fromMaybeList packageConfigGhcOptions+ mLibrary <- mapM (mkLibrary sourceDirs dependencies defaultExtensions ghcOptions) packageConfigLibrary+ executables <- toExecutables sourceDirs dependencies defaultExtensions ghcOptions packageConfigExecutables+ tests <- toExecutables sourceDirs dependencies defaultExtensions ghcOptions packageConfigTests++ name <- maybe (takeBaseName <$> getCurrentDirectory) return packageConfigName++ licenseFileExists <- doesFileExist "LICENSE"++ let package = 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 = guard licenseFileExists >> Just "LICENSE"+ , packageExtraSourceFiles = fromMaybeList packageConfigExtraSourceFiles+ , packageSourceRepository = github+ , packageLibrary = mLibrary+ , packageExecutables = executables+ , packageTests = tests+ }+ return package+ where+ github = ("https://github.com/" ++) <$> packageConfigGithub++ homepage :: Maybe String+ homepage = case packageConfigHomepage of+ Just Nothing -> Nothing+ _ -> join packageConfigHomepage <|> fromGithub+ where+ fromGithub = ((++ "#readme") <$> github)++ bugReports :: Maybe String+ bugReports = case packageConfigBugReports of+ Just Nothing -> Nothing+ _ -> join packageConfigBugReports <|> fromGithub+ where+ fromGithub = ((++ "/issues") <$> github)++mkLibrary :: [FilePath] -> [Dependency] -> [String] -> [GhcOption] -> LibrarySection -> IO Library+mkLibrary globalSourceDirs globalDependencies globalDefaultExtensions globalGhcOptions LibrarySection{..} = do+ modules <- concat <$> mapM getModules sourceDirs++ let (exposedModules, otherModules) = determineModules modules librarySectionExposedModules librarySectionOtherModules++ return (Library sourceDirs exposedModules otherModules dependencies defaultExtensions ghcOptions)+ where+ sourceDirs = globalSourceDirs ++ fromMaybeList librarySectionSourceDirs+ dependencies = filter (not . null) [globalDependencies, fromMaybeList librarySectionDependencies]+ defaultExtensions = globalDefaultExtensions ++ fromMaybeList librarySectionDefaultExtensions+ ghcOptions = globalGhcOptions ++ fromMaybeList librarySectionGhcOptions++determineModules :: [String] -> Maybe (List String) -> Maybe (List String) -> ([String], [String])+determineModules modules mExposedModules mOtherModules = case (mExposedModules, mOtherModules) of+ (Nothing, Nothing) -> (modules, [])+ _ -> (exposedModules, otherModules)+ where+ otherModules = maybe (modules \\ exposedModules) fromList mOtherModules+ exposedModules = maybe (modules \\ otherModules) fromList mExposedModules++getModules :: FilePath -> IO [String]+getModules src = do+ exits <- doesDirectoryExist src+ if exits+ then toModules <$> getFilesRecursive src+ else return []+ where+ toModules :: [[FilePath]] -> [String]+ toModules = catMaybes . map toModule++toExecutables :: [FilePath] -> [Dependency] -> [String] -> [GhcOption] -> Maybe (HashMap String ExecutableSection) -> IO [Executable]+toExecutables globalSourceDirs globalDependencies globalDefaultExtensions globalGhcOptions executables = (mapM toExecutable . Map.toList) (fromMaybe mempty executables)+ where+ toExecutable (name, ExecutableSection{..}) = do+ modules <- maybe (filterMain . concat <$> mapM getModules sourceDirs) (return . fromList) executableSectionOtherModules+ return $ Executable name executableSectionMain sourceDirs modules dependencies defaultExtensions ghcOptions+ where+ dependencies = filter (not . null) [globalDependencies, fromMaybeList executableSectionDependencies]+ sourceDirs = globalSourceDirs ++ fromMaybeList executableSectionSourceDirs+ defaultExtensions = globalDefaultExtensions ++ fromMaybeList executableSectionDefaultExtensions+ ghcOptions = globalGhcOptions ++ fromMaybeList executableSectionGhcOptions++ filterMain :: [String] -> [String]+ filterMain = maybe id (filter . (/=)) (toModule $ splitDirectories executableSectionMain)++fromMaybeList :: Maybe (List a) -> [a]+fromMaybeList = maybe [] fromList
+ src/Run.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE QuasiQuotes, RecordWildCards #-}+module Run (+ run+-- exported for testing+, renderPackage+) where++import Control.Applicative+import Control.Monad+import Data.Maybe+import Data.List+import System.Exit.Compat+import Data.Version (showVersion)++import Paths_hpack (version)+import Util+import Config++configFile :: FilePath+configFile = "package.yaml"++run :: IO (FilePath, String)+run = do+ mPackage <- readPackageConfig configFile+ case mPackage of+ Right package -> do+ let cabalFile = packageName package ++ ".cabal"++ old <- tryReadFile cabalFile++ let alignment = fromMaybe 16 (old >>= sniffAlignment)+ output = concat [+ "-- This file has been generated from " ++ configFile ++ " by hpack version " ++ showVersion version ++ ".\n"+ , "--\n"+ , "-- see: https://github.com/sol/hpack\n"+ , "\n"+ , renderPackage alignment (maybe [] extractFieldOrderHint old) package+ ]+ return (cabalFile, output)+ Left err -> die err++renderPackage :: Int -> [String] -> Package -> String+renderPackage alignment existingFieldOrder Package{..} = intercalate "\n" sections+ where+ sections :: [String]+ sections = catMaybes [+ header+ , extraSourceFiles+ , sourceRepository+ , library+ ] ++ renderExecutables packageExecutables ++ renderTests packageTests++ header = Just (unlines $ map formatField sortedFields)++ extraSourceFiles = guard (not . null $ packageExtraSourceFiles) >> Just (unlines $ "extra-source-files:" : map (" " ++) packageExtraSourceFiles)++ sourceRepository = renderSourceRepository <$> packageSourceRepository++ library = renderLibrary <$> packageLibrary++ padding name = replicate (alignment - length name - 2) ' '++ formatField :: (String, String) -> String+ formatField (name, value) = name ++ ": " ++ padding name ++ value++ sortedFields :: [(String, String)]+ sortedFields = foldr insertByDefaultFieldOrder (sortBy orderingForExistingFields existing) new+ where+ (existing, new) = partition ((`elem` existingFieldOrder) . fst) fields++ insertByDefaultFieldOrder :: (String, a) -> [(String, a)] -> [(String, a)]+ insertByDefaultFieldOrder x@(key1, _) xs = case xs of+ [] -> [x]+ y@(key2, _) : ys -> if index key1 < index key2 then x : y : ys else y : insertByDefaultFieldOrder x ys+ where+ index :: String -> Maybe Int+ index = (`elemIndex` defaultFieldOrder)++ orderingForExistingFields :: (String, a) -> (String, a) -> Ordering+ orderingForExistingFields (key1, _) (key2, _) = index key1 `compare` index key2+ where+ index :: String -> Maybe Int+ index = (`elemIndex` existingFieldOrder)++ fields :: [(String, String)]+ fields = mapMaybe (\(name, value) -> (,) name <$> value) $ [+ ("name", Just packageName)+ , ("version", Just packageVersion)+ , ("synopsis", packageSynopsis)+ , ("description", (formatDescription <$> packageDescription))+ , ("category", packageCategory)+ , ("stability", packageStability)+ , ("homepage", packageHomepage)+ , ("bug-reports", packageBugReports)+ , ("author", formatList packageAuthor)+ , ("maintainer", formatList packageMaintainer)+ , ("copyright", formatList packageCopyright)+ , ("license", packageLicense)+ , ("license-file", packageLicenseFile)+ , ("build-type", Just "Simple")+ , ("cabal-version", Just ">= 1.10")+ ]++ formatList :: [String] -> Maybe String+ formatList xs = guard (not $ null xs) >> (Just $ intercalate separator xs)+ where+ separator = ",\n" ++ replicate alignment ' '++ defaultFieldOrder :: [String]+ defaultFieldOrder = map fst fields++ formatDescription = intercalate separator . intersperse "." . lines+ where+ n = max alignment $ length ("description: ")+ separator = "\n" ++ replicate n ' '++ renderSourceRepository :: String -> String+ renderSourceRepository url = "source-repository head\n type: git\n location: " ++ url ++ "\n"++renderExecutables :: [Executable] -> [String]+renderExecutables = map renderExecutable++renderExecutable :: Executable -> String+renderExecutable executable@Executable{..} =+ "executable "+ ++ executableName ++ "\n"+ ++ renderExecutableSection executable++renderTests :: [Executable] -> [String]+renderTests = map renderTest++renderTest :: Executable -> String+renderTest executable@Executable{..} =+ "test-suite " ++ executableName ++ "\n"+ ++ " type: exitcode-stdio-1.0\n"+ ++ renderExecutableSection executable++renderExecutableSection :: Executable -> String+renderExecutableSection Executable{..} = + renderSourceDirs executableSourceDirs+ ++ " main-is: " ++ executableMain ++ "\n"+ ++ renderOtherModules executableOtherModules+ ++ renderDependencies executableDependencies + ++ renderDefaultExtensions executableDefaultExtensions+ ++ renderGhcOptions executableGhcOptions+ ++ " default-language: Haskell2010\n"++renderLibrary :: Library -> String+renderLibrary Library{..} =+ "library\n"+ ++ renderSourceDirs librarySourceDirs+ ++ renderExposedModules libraryExposedModules+ ++ renderOtherModules libraryOtherModules+ ++ renderDependencies libraryDependencies+ ++ renderDefaultExtensions libraryDefaultExtensions+ ++ renderGhcOptions libraryGhcOptions+ ++ " default-language: Haskell2010\n"+++renderSourceDirs :: [String] -> String+renderSourceDirs dirs+ | null dirs = ""+ | otherwise = " hs-source-dirs: " ++ intercalate ", " dirs ++ "\n"++renderExposedModules :: [String] -> String+renderExposedModules modules+ | null modules = ""+ | otherwise = " exposed-modules:\n" ++ (unlines $ map (" " ++) modules)++renderOtherModules :: [String] -> String+renderOtherModules modules+ | null modules = ""+ | otherwise = " other-modules:\n" ++ (unlines $ map (" " ++) modules)++renderDependencies :: [[Dependency]] -> String+renderDependencies dependencies+ | null dependencies = ""+ | otherwise = concatMap render $ zip (True : repeat False) dependencies+ where+ render (isFirst, xs)+ | isFirst = " build-depends:\n " ++ intercalate "\n , " xs ++ "\n"+ | otherwise = "\n , " ++ intercalate "\n , " xs ++ "\n"++renderGhcOptions :: [GhcOption] -> String+renderGhcOptions ghcOptions+ | null ghcOptions = ""+ | otherwise = " ghc-options: " ++ unwords ghcOptions ++ "\n"++renderDefaultExtensions :: [String] -> String+renderDefaultExtensions defaultExtensions+ | null defaultExtensions = ""+ | otherwise = " default-extensions: " ++ unwords defaultExtensions ++ "\n"
+ src/Util.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE FlexibleContexts #-}+module Util (+ List(..)+, toModule+, genericParseJSON_+, getFilesRecursive+, tryReadFile+, sniffAlignment+, extractFieldOrderHint++-- exported for testing+, splitField+) where++import Control.Applicative+import Control.Monad+import Control.Exception+import Control.DeepSeq+import Data.Char+import Data.Maybe+import Data.List+import System.Directory+import System.FilePath++import GHC.Generics+import Data.Aeson.Types++genericParseJSON_ :: (Generic a, GFromJSON (Rep a)) => String -> Value -> Parser a+genericParseJSON_ name = genericParseJSON defaultOptions {fieldLabelModifier = camelTo '-' . drop (length name)}++newtype List a = List {fromList :: [a]}+ deriving (Eq, Show)++instance FromJSON a => FromJSON (List a) where+ parseJSON v = List <$> (parseJSON v <|> (return <$> parseJSON v))++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 (all isValidModuleName name) >> return (intercalate "." name)+ where+ stripSuffix :: String -> String -> Maybe String+ stripSuffix suffix x = reverse <$> stripPrefix (reverse suffix) (reverse x)++-- See `Cabal.Distribution.ModuleName` (http://git.io/bj34)+isValidModuleName :: String -> Bool+isValidModuleName [] = False+isValidModuleName (c:cs) = isUpper c && all isValidModuleChar cs++isValidModuleChar :: Char -> Bool+isValidModuleChar c = isAlphaNum c || c == '_' || c == '\''++getFilesRecursive :: FilePath -> IO [[FilePath]]+getFilesRecursive baseDir = sort <$> 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++extractFieldOrderHint :: String -> [String]+extractFieldOrderHint = map fst . catMaybes . map splitField . lines++sniffAlignment :: String -> Maybe Int+sniffAlignment input = case nub . catMaybes . map indentation . catMaybes . map splitField $ lines input of+ [n] -> Just 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'] ++ "-"
+ test/ConfigSpec.hs view
@@ -0,0 +1,408 @@+{-# LANGUAGE QuasiQuotes, OverloadedLists #-}+module ConfigSpec (+ main+, spec++, package+, executable+, library+) where++import Helper+import Test.Mockery.Directory++import Data.String.Interpolate++import Config++main :: IO ()+main = hspec spec++package :: Package+package = Package "foo" "0.0.0" Nothing Nothing Nothing Nothing Nothing Nothing [] [] [] Nothing Nothing [] Nothing Nothing [] []++executable :: String -> String -> Executable+executable name main_ = Executable name main_ [] [] [] [] []++library :: Library+library = Library [] [] [] [] [] []++spec :: Spec+spec = around_ (inTempDirectoryNamed "foo") $ do+ describe "readPackageConfig" $ do+ it "accepts name" $ do+ writeFile "package.yaml" [i|+ name: bar+ |]+ readPackageConfig "package.yaml" `shouldReturn` Right package {packageName = "bar"}++ it "accepts version" $ do+ writeFile "package.yaml" [i|+ version: 0.1.0+ |]+ readPackageConfig "package.yaml" `shouldReturn` Right package {packageVersion = "0.1.0"}++ it "accepts synopsis" $ do+ writeFile "package.yaml" [i|+ synopsis: some synopsis+ |]+ readPackageConfig "package.yaml" `shouldReturn` Right package {packageSynopsis = Just "some synopsis"}++ it "accepts description" $ do+ writeFile "package.yaml" [i|+ description: some description+ |]+ readPackageConfig "package.yaml" `shouldReturn` Right package {packageDescription = Just "some description"}++ it "accepts category" $ do+ writeFile "package.yaml" [i|+ category: Data+ |]+ readPackageConfig "package.yaml" `shouldReturn` Right package {packageCategory = Just "Data"}++ it "accepts author" $ do+ writeFile "package.yaml" [i|+ author: John Doe+ |]+ readPackageConfig "package.yaml" `shouldReturn` Right package {packageAuthor = ["John Doe"]}++ it "accepts maintainer" $ do+ writeFile "package.yaml" [i|+ maintainer: John Doe <john.doe@example.com>+ |]+ readPackageConfig "package.yaml" `shouldReturn` Right package {packageMaintainer = ["John Doe <john.doe@example.com>"]}++ it "accepts copyright" $ do+ writeFile "package.yaml" [i|+ copyright: (c) 2015 John Doe+ |]+ readPackageConfig "package.yaml" `shouldReturn` Right package {packageCopyright = ["(c) 2015 John Doe"]}++ it "accepts stability" $ do+ writeFile "package.yaml" [i|+ stability: experimental+ |]+ Right c <- readPackageConfig "package.yaml"+ packageStability c `shouldBe` Just "experimental"++ it "accepts homepage URL" $ do+ writeFile "package.yaml" [i|+ github: hspec/hspec+ homepage: https://example.com/+ |]+ Right c <- readPackageConfig "package.yaml"+ packageHomepage c `shouldBe` Just "https://example.com/"++ it "infers homepage URL from github" $ do+ writeFile "package.yaml" [i|+ github: hspec/hspec+ |]+ Right c <- readPackageConfig "package.yaml"+ packageHomepage c `shouldBe` Just "https://github.com/hspec/hspec#readme"++ it "omits homepage URL if it is null" $ do+ writeFile "package.yaml" [i|+ github: hspec/hspec+ homepage: null+ |]+ Right c <- readPackageConfig "package.yaml"+ packageHomepage c `shouldBe` Nothing++ it "accepts bug-reports URL" $ do+ writeFile "package.yaml" [i|+ github: hspec/hspec+ bug-reports: https://example.com/issues+ |]+ Right c <- readPackageConfig "package.yaml"+ packageBugReports c `shouldBe` Just "https://example.com/issues"++ it "infers bug-reports URL from github" $ do+ writeFile "package.yaml" [i|+ github: hspec/hspec+ |]+ Right c <- readPackageConfig "package.yaml"+ packageBugReports c `shouldBe` Just "https://github.com/hspec/hspec/issues"++ it "omits bug-reports URL if it is null" $ do+ writeFile "package.yaml" [i|+ github: hspec/hspec+ bug-reports: null+ |]+ Right c <- readPackageConfig "package.yaml"+ packageBugReports c `shouldBe` Nothing++ it "accepts license" $ do+ writeFile "package.yaml" [i|+ license: MIT+ |]+ readPackageConfig "package.yaml" `shouldReturn` Right package {packageLicense = Just "MIT"}++ it "infers license file" $ do+ writeFile "package.yaml" [i|+ name: foo+ |]+ touch "LICENSE"+ readPackageConfig "package.yaml" `shouldReturn` Right package {packageLicenseFile = Just "LICENSE"}++ it "accepts extra-source-files" $ do+ writeFile "package.yaml" [i|+ extra-source-files:+ - CHANGES.markdown+ - README.markdown+ |]+ Right c <- readPackageConfig "package.yaml"+ packageExtraSourceFiles c `shouldBe` ["CHANGES.markdown", "README.markdown"]++ it "accepts github" $ do+ writeFile "package.yaml" [i|+ github: hspec/hspec+ |]+ Right c <- readPackageConfig "package.yaml"+ packageSourceRepository c `shouldBe` Just "https://github.com/hspec/hspec"++ context "when reading library section" $ do+ it "accepts source-dirs" $ do+ writeFile "package.yaml" [i|+ library:+ source-dirs:+ - foo+ - bar+ |]+ Right c <- readPackageConfig "package.yaml"+ packageLibrary c `shouldBe` Just library {librarySourceDirs = ["foo", "bar"]}++ it "accepts default-extensions" $ do+ writeFile "package.yaml" [i|+ library:+ default-extensions:+ - Foo+ - Bar+ |]+ Right c <- readPackageConfig "package.yaml"+ packageLibrary c `shouldBe` Just library {libraryDefaultExtensions = ["Foo", "Bar"]}++ it "accepts global default-extensions" $ do+ writeFile "package.yaml" [i|+ default-extensions:+ - Foo+ - Bar+ library: {}+ |]+ Right c <- readPackageConfig "package.yaml"+ packageLibrary c `shouldBe` Just library {libraryDefaultExtensions = ["Foo", "Bar"]}++ it "accepts global source-dirs" $ do+ writeFile "package.yaml" [i|+ source-dirs:+ - foo+ - bar+ library: {}+ |]+ Right c <- readPackageConfig "package.yaml"+ packageLibrary c `shouldBe` Just library {librarySourceDirs = ["foo", "bar"]}++ it "allows to specify exposed-modules" $ do+ writeFile "package.yaml" [i|+ library:+ source-dirs: src+ exposed-modules: Foo+ |]+ touch "src/Foo.hs"+ touch "src/Bar.hs"+ Right c <- readPackageConfig "package.yaml"+ packageLibrary c `shouldBe` Just library {librarySourceDirs = ["src"], libraryExposedModules = ["Foo"], libraryOtherModules = ["Bar"]}++ it "allows to specify other-modules" $ do+ writeFile "package.yaml" [i|+ library:+ source-dirs: src+ other-modules: Bar+ |]+ touch "src/Foo.hs"+ touch "src/Bar.hs"+ Right c <- readPackageConfig "package.yaml"+ packageLibrary c `shouldBe` Just library {librarySourceDirs = ["src"], libraryExposedModules = ["Foo"], libraryOtherModules = ["Bar"]}++ it "allows to specify both exposed-modules and other-modules" $ do+ writeFile "package.yaml" [i|+ library:+ source-dirs: src+ exposed-modules: Foo+ other-modules: Bar+ |]+ touch "src/Baz.hs"+ Right c <- readPackageConfig "package.yaml"+ packageLibrary c `shouldBe` Just library {librarySourceDirs = ["src"], libraryExposedModules = ["Foo"], libraryOtherModules = ["Bar"]}++ context "when neither exposed-module nor other-module are specified" $ do+ it "exposes all modules" $ do+ writeFile "package.yaml" [i|+ library:+ source-dirs: src+ |]+ touch "src/Foo.hs"+ touch "src/Bar.hs"+ Right c <- readPackageConfig "package.yaml"+ packageLibrary c `shouldBe` Just library {librarySourceDirs = ["src"], libraryExposedModules = ["Bar", "Foo"]}++ context "when reading executable section" $ do+ it "reads executable section" $ do+ writeFile "package.yaml" [i|+ executables:+ foo:+ main: driver/Main.hs+ |]+ Right c <- readPackageConfig "package.yaml"+ packageExecutables c `shouldBe` [executable "foo" "driver/Main.hs"]++ it "accepts source-dirs" $ do+ writeFile "package.yaml" [i|+ executables:+ foo:+ main: Main.hs+ source-dirs:+ - foo+ - bar+ |]+ Right c <- readPackageConfig "package.yaml"+ packageExecutables c `shouldBe` [(executable "foo" "Main.hs") {executableSourceDirs = ["foo", "bar"]}]++ it "accepts global source-dirs" $ do+ writeFile "package.yaml" [i|+ source-dirs:+ - foo+ - bar+ executables:+ foo:+ main: Main.hs+ |]+ Right c <- readPackageConfig "package.yaml"+ packageExecutables c `shouldBe` [(executable "foo" "Main.hs") {executableSourceDirs = ["foo", "bar"]}]++ it "infers other-modules" $ do+ touch "src/Main.hs"+ touch "src/Foo.hs"+ touch "src/Bar.hs"+ touch "src/Baz.lhs"+ writeFile "package.yaml" [i|+ executables:+ foo:+ main: Main.hs+ source-dirs: src+ |]+ Right [r] <- fmap packageExecutables <$> readPackageConfig "package.yaml"+ executableOtherModules r `shouldBe` ["Bar", "Baz", "Foo"]++ it "allows to specify other-modules" $ do+ touch "src/Foo.hs"+ touch "src/Bar.hs"+ writeFile "package.yaml" [i|+ executables:+ foo:+ main: Main.hs+ source-dirs: src+ other-modules: Baz+ |]+ Right [r] <- fmap packageExecutables <$> readPackageConfig "package.yaml"+ executableOtherModules r `shouldBe` ["Baz"]++ it "accepts default-extensions" $ do+ writeFile "package.yaml" [i|+ executables:+ foo:+ main: driver/Main.hs+ default-extensions:+ - Foo+ - Bar+ |]+ Right c <- readPackageConfig "package.yaml"+ packageExecutables c `shouldBe` [(executable "foo" "driver/Main.hs") {executableDefaultExtensions = ["Foo", "Bar"]}]++ it "accepts global default-extensions" $ do+ writeFile "package.yaml" [i|+ default-extensions:+ - Foo+ - Bar+ executables:+ foo:+ main: driver/Main.hs+ |]+ Right c <- readPackageConfig "package.yaml"+ packageExecutables c `shouldBe` [(executable "foo" "driver/Main.hs") {executableDefaultExtensions = ["Foo", "Bar"]}]++ it "accepts GHC options" $ do+ writeFile "package.yaml" [i|+ executables:+ foo:+ main: driver/Main.hs+ ghc-options: -Wall+ |]+ readPackageConfig "package.yaml" `shouldReturn` Right package {packageExecutables = [(executable "foo" "driver/Main.hs") {executableGhcOptions = ["-Wall"]}]}++ it "accepts global GHC options" $ do+ writeFile "package.yaml" [i|+ ghc-options: -Wall+ executables:+ foo:+ main: driver/Main.hs+ |]+ readPackageConfig "package.yaml" `shouldReturn` Right package {packageExecutables = [(executable "foo" "driver/Main.hs") {executableGhcOptions = ["-Wall"]}]}++ context "when reading test section" $ do+ it "reads test section" $ do+ writeFile "package.yaml" [i|+ tests:+ spec:+ main: test/Spec.hs+ |]+ readPackageConfig "package.yaml" `shouldReturn` Right package {packageTests = [executable "spec" "test/Spec.hs"]}++ it "accepts single dependency" $ do+ writeFile "package.yaml" [i|+ tests:+ spec:+ main: test/Spec.hs+ dependencies: hspec+ |]+ readPackageConfig "package.yaml" `shouldReturn` Right package {packageTests = [(executable "spec" "test/Spec.hs") {executableDependencies = [["hspec"]]}]}++ it "accepts list of dependencies" $ do+ writeFile "package.yaml" [i|+ tests:+ spec:+ main: test/Spec.hs+ dependencies:+ - hspec+ - QuickCheck+ |]+ readPackageConfig "package.yaml" `shouldReturn` Right package {packageTests = [(executable "spec" "test/Spec.hs") {executableDependencies = [["hspec", "QuickCheck"]]}]}++ context "when both top-level and section specific dependencies are specified" $ do+ it "combines dependencies" $ do+ writeFile "package.yaml" [i|+ dependencies:+ - base++ tests:+ spec:+ main: test/Spec.hs+ dependencies: hspec+ |]+ readPackageConfig "package.yaml" `shouldReturn` Right package {packageTests = [(executable "spec" "test/Spec.hs") {executableDependencies = [["base"], ["hspec"]]}]}++ context "when package.yaml can not be parsed" $ do+ it "returns an error" $ do+ writeFile "package.yaml" [i|+ foo: bar+ foo baz+ |]+ readPackageConfig "package.yaml" `shouldReturn` Left "package.yaml:3:10: could not find expected ':' while scanning a simple key"++ context "when package.yaml is invalid" $ do+ it "returns an error" $ do+ writeFile "package.yaml" [i|+ executables:+ foo:+ ain: driver/Main.hs+ |]+ readPackageConfig "package.yaml" `shouldReturn` Left "package.yaml: The key \"main\" was not found"
+ test/Helper.hs view
@@ -0,0 +1,15 @@+module Helper (+ module Test.Hspec+, module Control.Applicative+, touch+) where++import Test.Hspec+import Control.Applicative+import System.Directory+import System.FilePath++touch :: FilePath -> IO ()+touch p = do+ createDirectoryIfMissing True (takeDirectory p)+ writeFile p ""
+ test/RunSpec.hs view
@@ -0,0 +1,152 @@+module RunSpec (main, spec) where++import Test.Hspec++import ConfigSpec hiding (main, spec)+import Config+import Run++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "renderPackage" $ do+ it "renders a package" $ do+ renderPackage 0 [] package `shouldBe` unlines [+ "name: foo"+ , "version: 0.0.0"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ ]++ it "aligns fields" $ do+ renderPackage 16 [] package `shouldBe` unlines [+ "name: foo"+ , "version: 0.0.0"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ ]++ it "includes description" $ do+ renderPackage 0 [] package {packageDescription = Just "foo\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 16 [] package {packageDescription = Just "foo\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 0 [] 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 0 [] 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 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 0 [] 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 source repository" $ do+ renderPackage 0 [] package {packageSourceRepository = Just "https://github.com/hspec/hspec"} `shouldBe` unlines [+ "name: foo"+ , "version: 0.0.0"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ , ""+ , "source-repository head"+ , " type: git"+ , " location: https://github.com/hspec/hspec"+ ]++ context "when given list of existing fields" $ do+ it "retains field order" $ do+ renderPackage 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 16 ["name", "version", "cabal-version"] package `shouldBe` unlines [+ "name: foo"+ , "version: 0.0.0"+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ ]++ context "when rendering executable section" $ do+ it "includes dependencies" $ do+ renderPackage 0 [] package {packageExecutables = [(executable "foo" "Main.hs") {executableDependencies = [["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 0 [] package {packageExecutables = [(executable "foo" "Main.hs") {executableGhcOptions = ["-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"+ ]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/UtilSpec.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE OverloadedStrings #-}+module UtilSpec (main, spec) where++import Helper+import Test.Mockery.Directory+import Data.Aeson++import Util++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ 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"+ getFilesRecursive "foo" `shouldReturn` [+ ["bar"]+ , ["baz"]+ , ["foobar", "baz"]+ ]++ describe "List" $ do+ it "can be a single value" $ do+ fromJSON (toJSON $ Number 23) `shouldBe` Success (List [23 :: Int])++ it "can be a list of values" $ do+ fromJSON (toJSON [Number 23, Number 42]) `shouldBe` Success (List [23, 42 :: Int])++ describe "tryReadFile" $ do+ it "reads file" $ do+ tryReadFile "test/asset/foo" `shouldReturn` Just "foo\n"++ it "returns Nothing if file does not exist" $ do+ tryReadFile "test/asset/bar" `shouldReturn` Nothing++ describe "extractFieldOrderHint" $ do+ it "extracts field order hints" $ do+ let input = unlines [+ "name: cabalize"+ , "version: 0.0.0"+ , "license:"+ , "license-file: "+ , "build-type: Simple"+ , "cabal-version: >= 1.10"+ ]+ extractFieldOrderHint input `shouldBe` [+ "name"+ , "version"+ , "license"+ , "license-file"+ , "build-type"+ , "cabal-version"+ ]++ describe "sniffAlignment" $ do+ it "sniffs field alignment from given cabal file" $ do+ let input = unlines [+ "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 = unlines [+ "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