hpack-0.18.1/0000755000000000000000000000000013123334565011062 5ustar0000000000000000hpack-0.18.1/LICENSE0000644000000000000000000000206713123334565012074 0ustar0000000000000000Copyright (c) 2014-2016 Simon Hengel 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. hpack-0.18.1/hpack.cabal0000644000000000000000000000475313123334565013145 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.18.0. -- -- see: https://github.com/sol/hpack name: hpack version: 0.18.1 synopsis: An alternative format for Haskell packages description: See README at category: Development homepage: https://github.com/sol/hpack#readme bug-reports: https://github.com/sol/hpack/issues maintainer: Simon Hengel license: MIT license-file: LICENSE build-type: Simple cabal-version: >= 1.10 extra-source-files: CHANGELOG.md source-repository head type: git location: https://github.com/sol/hpack library hs-source-dirs: src ghc-options: -Wall build-depends: base >= 4.7 && < 5 , base-compat >= 0.8 , bytestring , deepseq , directory , filepath , Glob , text , containers , unordered-containers , yaml , aeson >= 0.11 exposed-modules: Hpack Hpack.Config Hpack.Run Hpack.Yaml other-modules: Hpack.FormattingHints Hpack.GenericsUtil Hpack.Haskell Hpack.Options Hpack.Render Hpack.Util Paths_hpack default-language: Haskell2010 executable hpack main-is: Main.hs hs-source-dirs: driver ghc-options: -Wall build-depends: base >= 4.7 && < 5 , base-compat >= 0.8 , bytestring , deepseq , directory , filepath , Glob , text , containers , unordered-containers , yaml , aeson >= 0.11 , hpack 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 , bytestring , deepseq , directory , filepath , Glob , text , containers , unordered-containers , yaml , aeson >= 0.11 , hspec == 2.* , QuickCheck , temporary , mockery >= 0.3 , interpolate , aeson-qq other-modules: Helper Hpack.ConfigSpec Hpack.FormattingHintsSpec Hpack.GenericsUtilSpec Hpack.HaskellSpec Hpack.OptionsSpec Hpack.RenderSpec Hpack.RunSpec Hpack.UtilSpec HpackSpec Hpack Hpack.Config Hpack.FormattingHints Hpack.GenericsUtil Hpack.Haskell Hpack.Options Hpack.Render Hpack.Run Hpack.Util Hpack.Yaml default-language: Haskell2010 hpack-0.18.1/CHANGELOG.md0000644000000000000000000000163413123334565012677 0ustar0000000000000000## next - Output generated cabal file to `stdout` when `-` is given as a command-line option (see #113) - Recognize `.chs`, `.y`, `.ly` and `.x` as Haskell modules when inferring modules for ## Change in 0.18.0 - Make `executable` a shortcut of `executables: { package-name: ... }` - Add support for `ghcjs-options` and `js-sources` (see #161) - Allow `license-file` to be a list - Accept input file on command-line (see #106) - Add Paths_* when no modules are specified (see #86) ## Changes in 0.17.1 - Do not descend into irrelevant directories when inferring modules (see #165) ## Changes in 0.17.0 - Added custom-setup section - Add support for `!include` directives ## Changes in 0.16.0 - Warn when `name` is missing - Support globs in `c-sources` - Use binary I/O for cabal files avoiding problems with non-UTF-8 locales - Fix rendering of `.` as directory (cabal syntax issue) hpack-0.18.1/Setup.lhs0000644000000000000000000000011413123334565012666 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain hpack-0.18.1/test/0000755000000000000000000000000013123334565012041 5ustar0000000000000000hpack-0.18.1/test/HpackSpec.hs0000644000000000000000000000713713123334565014246 0ustar0000000000000000module HpackSpec (spec) where import Helper import Prelude () import Prelude.Compat import Control.Monad.Compat import Control.DeepSeq import Data.Version (Version(..), showVersion) import Test.QuickCheck import Hpack makeVersion :: [Int] -> Version makeVersion v = Version v [] spec :: Spec spec = do 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]) Nothing False old <- readFile "foo.cabal" >>= (return $!!) hpackWithVersion (makeVersion [0,10,0]) Nothing 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]) Nothing False old <- readFile "foo.cabal" >>= (return $!!) writeFile "package.yaml" $ unlines [ "name: foo" , "version: 0.2.0" ] hpackWithVersion (makeVersion [0,8,0]) Nothing False readFile "foo.cabal" `shouldReturn` old describe "splitDirectory" $ do context "when given Nothing" $ do it "defaults file name to package.yaml" $ do splitDirectory Nothing `shouldReturn` (Nothing, "package.yaml") context "when given a directory" $ do it "defaults file name to package.yaml" $ do withTempDirectory $ \dir -> do splitDirectory (Just dir) `shouldReturn` (Just dir, "package.yaml") context "when given a file name" $ do it "defaults directory to Nothing" $ do inTempDirectory $ do touch "foo.yaml" splitDirectory (Just "foo.yaml") `shouldReturn` (Nothing, "foo.yaml") context "when given a path to a file" $ do it "splits directory from file name" $ do withTempDirectory $ \dir -> do let file = dir "foo.yaml" touch file splitDirectory (Just file) `shouldReturn` (Just dir, "foo.yaml") context "when path does not exist" $ do it "defaults directory to Nothing" $ do inTempDirectory $ do splitDirectory (Just "test/foo.yaml") `shouldReturn` (Just "test", "foo.yaml") context "when file does not exist" $ do it "defaults directory to Nothing" $ do inTempDirectory $ do splitDirectory (Just "test") `shouldReturn` (Nothing, "test") context "when directory does not exist" $ do it "defaults directory to Nothing" $ do inTempDirectory $ do splitDirectory (Just "test/") `shouldReturn` (Just "test", "package.yaml") hpack-0.18.1/test/Spec.hs0000644000000000000000000000005413123334565013266 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} hpack-0.18.1/test/Helper.hs0000644000000000000000000000147613123334565013624 0ustar0000000000000000module 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 hpack-0.18.1/test/Hpack/0000755000000000000000000000000013123334565013067 5ustar0000000000000000hpack-0.18.1/test/Hpack/FormattingHintsSpec.hs0000644000000000000000000001073413123334565017363 0ustar0000000000000000module 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 hpack-0.18.1/test/Hpack/HaskellSpec.hs0000644000000000000000000000151513123334565015623 0ustar0000000000000000module 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 hpack-0.18.1/test/Hpack/RenderSpec.hs0000644000000000000000000001242713123334565015463 0ustar0000000000000000{-# 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)] hpack-0.18.1/test/Hpack/ConfigSpec.hs0000644000000000000000000012335413123334565015453 0ustar0000000000000000{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} module Hpack.ConfigSpec ( spec , package , executable ) 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 [] ["Paths_foo"] [] 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 js-sources" $ do let input = [i| js-sources: - foo.js - bar/*.js |] captureUnknownFieldsValue <$> decodeEither input `shouldBe` Right (section Empty){sectionJsSources = ["foo.js", "bar/*.js"]} it "accepts extra-lib-dirs" $ do let input = [i| extra-lib-dirs: - foo - bar |] captureUnknownFieldsValue <$> decodeEither input `shouldBe` Right (section Empty){sectionExtraLibDirs = ["foo", "bar"]} it "accepts extra-libraries" $ do let input = [i| extra-libraries: - foo - bar |] captureUnknownFieldsValue <$> decodeEither input `shouldBe` Right (section Empty){sectionExtraLibraries = ["foo", "bar"]} 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 "adds the Paths_* module to the other-modules when no modules are specified" $ do determineModules "foo" [] Nothing Nothing `shouldBe` ([], ["Paths_foo"]) it "replaces dashes with underscores in Paths_*" $ do determineModules "foo-bar" [] (Just $ List ["Foo"]) Nothing `shouldBe` (["Foo"], ["Paths_foo_bar"]) 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| name: foo bar: 23 baz: 42 _qux: 66 |] (`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| name: foo when: - condition: impl(ghc) bar: 23 baz: 42 _qux: 66 |] (`shouldBe` [ "Ignoring unknown field \"_qux\" in package description" , "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| name: foo 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 "warns on missing name" $ do withPackageWarnings_ [i| {} |] (`shouldBe` [ "Package name not specified, inferred \"foo\"" ] ) it "infers name" $ do withPackageConfig_ [i| {} |] (packageName >>> (`shouldBe` "foo")) 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 |] (`shouldBe` package {packageMaintainer = ["John Doe "]}) 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` ["LICENSE"])) it "accepts license file" $ do withPackageConfig_ [i| license-file: FOO |] (packageLicenseFile >>> (`shouldBe` ["FOO"])) it "accepts list of license files" $ do withPackageConfig_ [i| license-file: [FOO, BAR] |] (packageLicenseFile >>> (`shouldBe` ["FOO", "BAR"])) it "accepts build-type: Simple" $ do withPackageConfig_ [i| build-type: Simple |] (`shouldBe` package {packageBuildType = Simple}) it "accepts build-type: Configure" $ do withPackageConfig_ [i| build-type: Configure |] (`shouldBe` package {packageBuildType = Configure}) it "accepts build-type: Make" $ do withPackageConfig_ [i| build-type: Make |] (`shouldBe` package {packageBuildType = Make}) it "accepts build-type: Custom" $ do withPackageConfig_ [i| build-type: Custom |] (`shouldBe` package {packageBuildType = Custom}) it "rejects unknown build-type" $ do parseEither parseJSON (String "foobar") `shouldBe` (Left "Error in $: build-type must be one of: Simple, Configure, Make, Custom" :: Either String BuildType) 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| name: foo 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 ghcjs-options" $ do withPackageConfig_ [i| ghcjs-options: -dedupe library: ghcjs-options: -ghcjs1 executables: foo: main: Main.hs ghcjs-options: -ghcjs2 tests: spec: main: Spec.hs ghcjs-options: -ghcjs3 |] (`shouldBe` package { packageLibrary = Just (section library) {sectionGhcjsOptions = ["-dedupe", "-ghcjs1"]} , packageExecutables = [(section $ executable "foo" "Main.hs") {sectionGhcjsOptions = ["-dedupe", "-ghcjs2"]}] , packageTests = [(section $ executable "spec" "Spec.hs") {sectionGhcjsOptions = ["-dedupe", "-ghcjs3"]}] } ) 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 custom-setup section" $ do it "warns on unknown fields" $ do withPackageWarnings_ [i| name: foo custom-setup: foo: 1 bar: 2 |] (`shouldBe` [ "Ignoring unknown field \"bar\" in custom-setup section" , "Ignoring unknown field \"foo\" in custom-setup section" ]) it "sets build-type: Custom, if missing" $ do withPackageConfig_ [i| custom-setup: dependencies: - base |] (packageBuildType >>> (`shouldBe` Custom)) it "leaves build-type alone, if it exists" $ do withPackageConfig_ [i| name: foo build-type: Make custom-setup: dependencies: - base |] (packageBuildType >>> (`shouldBe` Make)) it "accepts dependencies" $ do withPackageConfig_ [i| custom-setup: dependencies: - foo >1.0 - bar ==2.0 |] (packageCustomSetup >>> fmap customSetupDependencies >>> (`shouldBe` Just ["foo >1.0", "bar ==2.0"])) it "allows yaml merging and overriding fields" $ do withPackageConfig_ [i| _common: &common name: n1 <<: *common name: n2 |] (packageName >>> (`shouldBe` "n2")) context "when reading library section" $ do it "warns on unknown fields" $ do withPackageWarnings_ [i| name: foo 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 "accepts c-sources" $ do withPackageConfig [i| library: c-sources: - cbits/*.c |] (do touch "cbits/foo.c" touch "cbits/bar.c" ) (packageLibrary >>> (`shouldBe` Just (section library) {sectionCSources = ["cbits/bar.c", "cbits/foo.c"]})) it "accepts global c-sources" $ do withPackageConfig [i| c-sources: - cbits/*.c library: {} |] (do touch "cbits/foo.c" touch "cbits/bar.c" ) (packageLibrary >>> (`shouldBe` Just (section library) {sectionCSources = ["cbits/bar.c", "cbits/foo.c"]})) it "accepts js-sources" $ do withPackageConfig [i| library: js-sources: - jsbits/*.js |] (do touch "jsbits/foo.js" touch "jsbits/bar.js" ) (packageLibrary >>> (`shouldBe` Just (section library) {sectionJsSources = ["jsbits/bar.js", "jsbits/foo.js"]})) it "accepts global js-sources" $ do withPackageConfig [i| js-sources: - jsbits/*.js library: {} |] (do touch "jsbits/foo.js" touch "jsbits/bar.js" ) (packageLibrary >>> (`shouldBe` Just (section library) {sectionJsSources = ["jsbits/bar.js", "jsbits/foo.js"]})) it "allows to specify exposed" $ do withPackageConfig_ [i| library: 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| name: foo 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 executables section" $ do withPackageConfig_ [i| executables: foo: main: driver/Main.hs |] (packageExecutables >>> (`shouldBe` [section $ executable "foo" "driver/Main.hs"])) it "reads executable section" $ do withPackageConfig_ [i| executable: main: driver/Main.hs |] (packageExecutables >>> (`shouldBe` [section $ executable "foo" "driver/Main.hs"])) it "warns on unknown executable fields" $ do withPackageWarnings_ [i| name: foo executable: main: Main.hs unknown: true |] (`shouldBe` ["Ignoring unknown field \"unknown\" in executable section"]) context "with both executable and executables" $ do it "gives executable precedence" $ do withPackageConfig_ [i| executable: main: driver/Main1.hs executables: foo2: main: driver/Main2.hs |] (packageExecutables >>> (`shouldBe` [section $ executable "foo" "driver/Main1.hs"])) it "warns" $ do withPackageWarnings_ [i| name: foo executable: main: driver/Main1.hs executables: foo2: main: driver/Main2.hs |] (`shouldBe` ["Ignoring field \"executables\" in favor of \"executable\""]) it "accepts arbitrary entry points as main" $ do withPackageConfig_ [i| executables: foo: main: Foo |] (packageExecutables >>> (`shouldBe` [ (section $ executable "foo" "Foo.hs") {sectionGhcOptions = ["-main-is Foo"]} ] )) it "accepts source-dirs" $ do withPackageConfig_ [i| executables: 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" ) (map (executableOtherModules . sectionData) . packageExecutables >>> (`shouldBe` [["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"]}]}) it "accepts c-sources" $ do withPackageConfig [i| executables: foo: main: driver/Main.hs c-sources: - cbits/*.c |] (do touch "cbits/foo.c" touch "cbits/bar.c" ) (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionCSources = ["cbits/bar.c", "cbits/foo.c"]}]}) it "accepts global c-sources" $ do withPackageConfig [i| c-sources: - cbits/*.c executables: foo: main: driver/Main.hs |] (do touch "cbits/foo.c" touch "cbits/bar.c" ) (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionCSources = ["cbits/bar.c", "cbits/foo.c"]}]}) it "accepts js-sources" $ do withPackageConfig [i| executables: foo: main: driver/Main.hs js-sources: - jsbits/*.js |] (do touch "jsbits/foo.js" touch "jsbits/bar.js" ) (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionJsSources = ["jsbits/bar.js", "jsbits/foo.js"]}]}) it "accepts global js-sources" $ do withPackageConfig [i| js-sources: - jsbits/*.js executables: foo: main: driver/Main.hs |] (do touch "jsbits/foo.js" touch "jsbits/bar.js" ) (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionJsSources = ["jsbits/bar.js", "jsbits/foo.js"]}]}) context "when reading benchmark section" $ do it "warns on unknown fields" $ do withPackageWarnings_ [i| name: foo benchmarks: foo: main: Main.hs bar: 42 baz: 23 |] (`shouldBe` [ "Ignoring unknown field \"bar\" in benchmark section \"foo\"" , "Ignoring unknown field \"baz\" in benchmark section \"foo\"" ] ) context "when reading test section" $ do it "warns on unknown fields" $ do withPackageWarnings_ [i| name: foo 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| name: foo 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 >>= (`shouldSatisfy` isLeft) context "when package.yaml does not exist" $ do it "returns an error" $ \dir -> do let file = dir "package.yaml" readPackageConfig file `shouldReturn` Left [i|#{file}: Yaml file not found: #{file}|] hpack-0.18.1/test/Hpack/UtilSpec.hs0000644000000000000000000001356313123334565015163 0ustar0000000000000000{-# 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 .hs paths to module names" $ do toModule ["Foo", "Bar", "Baz.hs"] `shouldBe` Just "Foo.Bar.Baz" it "maps .lhs paths to module names" $ do toModule ["Foo", "Bar", "Baz.lhs"] `shouldBe` Just "Foo.Bar.Baz" it "maps .hsc paths to module names" $ do toModule ["Foo", "Bar", "Baz.hsc"] `shouldBe` Just "Foo.Bar.Baz" it "rejects invalid module names" $ do toModule ["resources", "hello.hs"] `shouldBe` Nothing describe "getModuleFilesRecursive" $ do it "gets all files from given directory" $ do inTempDirectory $ do touch "foo/bar" touch "foo/baz" actual <- getModuleFilesRecursive "foo" actual `shouldMatchList` [ ["bar"] , ["baz"] ] it "descends into subdirectories" $ do inTempDirectory $ do touch "foo/Bar/baz" getModuleFilesRecursive "foo" `shouldReturn` [["Bar", "baz"]] context "when a subdirectory is not a valid module name" $ do it "does not descend" $ do inTempDirectory $ do touch "foo/bar/baz" getModuleFilesRecursive "foo" `shouldReturn` empty 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 "field-name" dir ["foo.js"] `shouldReturn` ([], ["foo.js"]) it "removes duplicates" $ \dir -> do touch (dir "foo.js") expandGlobs "field-name" dir ["foo.js", "*.js"] `shouldReturn` ([], ["foo.js"]) it "rejects directories" $ \dir -> do touch (dir "foo") createDirectory (dir "bar") expandGlobs "field-name" dir ["*"] `shouldReturn` ([], ["foo"]) it "rejects character ranges" $ \dir -> do touch (dir "foo1") touch (dir "foo2") touch (dir "foo[1,2]") expandGlobs "field-name" 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 "field-name" dir ["files/*.js"] `shouldReturn` ([], sort files) it "rejects dot-files" $ \dir -> do touch (dir "foo/bar") touch (dir "foo/.baz") expandGlobs "field-name" dir ["foo/*"] `shouldReturn` ([], ["foo/bar"]) it "accepts dot-files when explicitly asked to" $ \dir -> do touch (dir "foo/bar") touch (dir "foo/.baz") expandGlobs "field-name" 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 "field-name" 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 "field-name" dir ["**/*.js"] `shouldReturn` ([], [file]) context "when a pattern does not match anything" $ do it "warns" $ \dir -> do expandGlobs "field-name" dir ["foo"] `shouldReturn` (["Specified pattern \"foo\" for field-name does not match any files"], []) context "when a pattern only matches a directory" $ do it "warns" $ \dir -> do createDirectory (dir "foo") expandGlobs "field-name" dir ["foo"] `shouldReturn` (["Specified pattern \"foo\" for field-name does not match any files"], []) hpack-0.18.1/test/Hpack/OptionsSpec.hs0000644000000000000000000000233213123334565015671 0ustar0000000000000000module Hpack.OptionsSpec (spec) where import Helper import Prelude () import Prelude.Compat import Hpack.Options spec :: Spec spec = do describe "parseOptions" $ do context "with --help" $ do it "returns Help" $ do parseOptions ["--help"] `shouldBe` Help context "with --version" $ do it "returns PrintVersion" $ do parseOptions ["--version"] `shouldBe` PrintVersion context "by default" $ do it "returns Run" $ do parseOptions [] `shouldBe` Run (Options True False Nothing) it "includes target" $ do parseOptions ["foo"] `shouldBe` Run (Options True False (Just "foo")) context "with superfluous arguments" $ do it "returns ParseError" $ do parseOptions ["foo", "bar"] `shouldBe` ParseError context "with --silent" $ do it "sets optionsVerbose to False" $ do parseOptions ["--silent"] `shouldBe` Run (Options False False Nothing) context "with -" $ do it "sets optionsToStdout to True" $ do parseOptions ["-"] `shouldBe` Run (Options True True Nothing) it "rejects - for target" $ do parseOptions ["-", "-"] `shouldBe` ParseError hpack-0.18.1/test/Hpack/RunSpec.hs0000644000000000000000000003137413123334565015012 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Hpack.RunSpec (spec) where import Helper import Data.List.Compat import Hpack.ConfigSpec hiding (spec) import Hpack.Config hiding (package) import Hpack.Render import Hpack.Run library :: Library library = Library Nothing [] [] [] 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 license-file" $ do renderPackage_ package {packageLicenseFile = ["FOO"]} `shouldBe` unlines [ "name: foo" , "version: 0.0.0" , "license-file: FOO" , "build-type: Simple" , "cabal-version: >= 1.10" ] it "aligns license-files" $ do renderPackage defaultRenderSettings 16 [] [] package {packageLicenseFile = ["FOO", "BAR"]} `shouldBe` unlines [ "name: foo" , "version: 0.0.0" , "license-files: FOO," , " BAR" , "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 custom-setup section" $ do it "includes setup-depends" $ do let setup = CustomSetup { customSetupDependencies = ["foo >1.0", "bar ==2.0"] } renderPackage_ package {packageCustomSetup = Just setup} `shouldBe` unlines [ "name: foo" , "version: 0.0.0" , "build-type: Simple" , "cabal-version: >= 1.10" , "" , "custom-setup" , " setup-depends:" , " foo >1.0" , " , bar ==2.0" ] 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" ] describe "renderDirectories" $ do it "replaces . with ./. (for compatibility with cabal syntax)" $ do (render defaultRenderSettings 0 $ renderDirectories "name" ["."]) `shouldBe` [ "name:" , " ./." ] hpack-0.18.1/test/Hpack/GenericsUtilSpec.hs0000644000000000000000000000111413123334565016630 0ustar0000000000000000{-# 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" hpack-0.18.1/driver/0000755000000000000000000000000013123334565012355 5ustar0000000000000000hpack-0.18.1/driver/Main.hs0000644000000000000000000000012213123334565013570 0ustar0000000000000000module Main (main) where import qualified Hpack main :: IO () main = Hpack.main hpack-0.18.1/src/0000755000000000000000000000000013123334565011651 5ustar0000000000000000hpack-0.18.1/src/Hpack.hs0000644000000000000000000001071513123334565013237 0ustar0000000000000000{-# LANGUAGE CPP #-} module Hpack ( hpack , hpackResult , Result(..) , Status(..) , version , main #ifdef TEST , hpackWithVersion , extractVersion , parseVersion , splitDirectory #endif ) where import Prelude () import Prelude.Compat import Control.Monad.Compat import qualified Data.ByteString as B import Data.List.Compat import Data.Maybe import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Data.Version (Version) import qualified Data.Version as Version import System.Environment import System.Exit import System.IO import System.FilePath import System.Directory import Text.ParserCombinators.ReadP import Paths_hpack (version) import Hpack.Options import Hpack.Config import Hpack.Run import Hpack.Util programVersion :: Version -> String programVersion v = "hpack version " ++ Version.showVersion v header :: FilePath -> Version -> String header p v = unlines [ "-- This file has been generated from " ++ p ++ " by " ++ programVersion v ++ "." , "--" , "-- see: https://github.com/sol/hpack" , "" ] main :: IO () main = do args <- getArgs case parseOptions args of PrintVersion -> putStrLn (programVersion version) Help -> printHelp Run options -> case options of Options _verbose True dir -> hpackStdOut dir Options verbose False dir -> hpack dir verbose ParseError -> do printHelp exitFailure printHelp :: IO () printHelp = do hPutStrLn stderr $ unlines [ "Usage: hpack [ --silent ] [ dir ] [ - ]" , " hpack --version" ] 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 :: Maybe FilePath -> Bool -> IO () hpack = hpackWithVersion version hpackResult :: Maybe FilePath -> IO Result hpackResult = hpackWithVersionResult version data Result = Result { resultWarnings :: [String] , resultCabalFile :: String , resultStatus :: Status } data Status = Generated | AlreadyGeneratedByNewerHpack | OutputUnchanged hpackWithVersion :: Version -> Maybe FilePath -> Bool -> IO () hpackWithVersion v p verbose = do r <- hpackWithVersionResult v p printWarnings (resultWarnings r) 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." printWarnings :: [String] -> IO () printWarnings warnings = do forM_ warnings $ \warning -> hPutStrLn stderr ("WARNING: " ++ warning) splitDirectory :: Maybe FilePath -> IO (Maybe FilePath, FilePath) splitDirectory Nothing = return (Nothing, packageConfig) splitDirectory (Just p) = do isDirectory <- doesDirectoryExist p return $ if isDirectory then (Just p, packageConfig) else let file = takeFileName p dir = takeDirectory p in (guard (p /= file) >> Just dir, if null file then packageConfig else file) hpackWithVersionResult :: Version -> Maybe FilePath -> IO Result hpackWithVersionResult v p = do (dir, file) <- splitDirectory p (warnings, cabalFile, new) <- run dir file old <- fmap splitHeader <$> tryReadFile cabalFile let oldVersion = fmap fst old >>= extractVersion status <- if (oldVersion <= Just v) then if (fmap snd old == Just (lines new)) then return OutputUnchanged else do B.writeFile cabalFile $ encodeUtf8 $ T.pack $ header file 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 hpackStdOut :: Maybe FilePath -> IO () hpackStdOut p = do (dir, file) <- splitDirectory p (warnings, _cabalFile, new) <- run dir file B.putStr $ encodeUtf8 $ T.pack new printWarnings warnings hpack-0.18.1/src/Hpack/0000755000000000000000000000000013123334565012677 5ustar0000000000000000hpack-0.18.1/src/Hpack/FormattingHints.hs0000644000000000000000000000741313123334565016360 0ustar0000000000000000{-# 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) hpack-0.18.1/src/Hpack/Util.hs0000644000000000000000000001012313123334565014145 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Hpack.Util ( List(..) , GhcOption , GhcProfOption , GhcjsOption , CppOption , CcOption , LdOption , parseMain , toModule , getModuleFilesRecursive , tryReadFile , expandGlobs , sort , lexicographically ) where import Prelude () import Prelude.Compat import Control.Exception import Control.Monad.Compat import Data.Aeson.Types import qualified Data.ByteString as B import Data.Char import Data.Data import Data.List.Compat hiding (sort) import Data.Ord import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import System.IO.Error 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 GhcjsOption = 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 <- msum $ map (`stripSuffix` x) [ ".hs" , ".lhs" , ".chs" , ".hsc" , ".y" , ".ly" , ".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) getModuleFilesRecursive :: FilePath -> IO [[String]] getModuleFilesRecursive 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 . filter isModule 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 <- tryJust (guard . isDoesNotExistError) (B.readFile file) return $ either (const Nothing) (Just . T.unpack . decodeUtf8With lenientDecode) r toPosixFilePath :: FilePath -> FilePath toPosixFilePath = Posix.joinPath . splitDirectories expandGlobs :: String -> FilePath -> [String] -> IO ([String], [FilePath]) expandGlobs name 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 " ++ name ++ " 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 } hpack-0.18.1/src/Hpack/Run.hs0000644000000000000000000002476713123334565014017 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE CPP #-} module Hpack.Run ( run , renderPackage , RenderSettings(..) , Alignment(..) , CommaStyle(..) , defaultRenderSettings #ifdef TEST , renderConditional , renderFlag , renderSourceRepository , renderDirectories , 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 :: Maybe FilePath -> FilePath -> IO ([String], FilePath, String) run mDir c = do let dir = fromMaybe "" mDir mPackage <- readPackageConfig (dir c) 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 :: [Element] sourceRepository = maybe [] (return . renderSourceRepository) packageSourceRepository customSetup :: [Element] customSetup = maybe [] (return . renderCustomSetup) packageCustomSetup library :: [Element] library = maybe [] (return . renderLibrary) packageLibrary stanzas :: [Element] stanzas = extraSourceFiles : dataFiles : sourceRepository ++ concat [ customSetup , 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) , case packageLicenseFile of [file] -> ("license-file", Just file) files -> ("license-files", formatList files) , ("tested-with", packageTestedWith) , ("build-type", Just (show packageBuildType)) , ("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 renderCustomSetup :: CustomSetup -> Element renderCustomSetup CustomSetup{..} = Stanza "custom-setup" [renderSetupDepends customSetupDependencies] 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{..} = [ renderDirectories "hs-source-dirs" sectionSourceDirs , renderDefaultExtensions sectionDefaultExtensions , renderOtherExtensions sectionOtherExtensions , renderGhcOptions sectionGhcOptions , renderGhcProfOptions sectionGhcProfOptions , renderGhcjsOptions sectionGhcjsOptions , renderCppOptions sectionCppOptions , renderCcOptions sectionCcOptions , renderDirectories "include-dirs" sectionIncludeDirs , Field "install-includes" (LineSeparatedList sectionInstallIncludes) , Field "c-sources" (LineSeparatedList sectionCSources) , Field "js-sources" (LineSeparatedList sectionJsSources) , renderDirectories "extra-lib-dirs" 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" renderDirectories :: String -> [String] -> Element renderDirectories name = Field name . LineSeparatedList . replaceDots where replaceDots = map replaceDot replaceDot xs = case xs of "." -> "./." _ -> xs 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 renderGhcjsOptions :: [GhcjsOption] -> Element renderGhcjsOptions = Field "ghcjs-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 renderSetupDepends :: [Dependency] -> Element renderSetupDepends = Field "setup-depends" . CommaSeparatedList . map dependencyName hpack-0.18.1/src/Hpack/Render.hs0000644000000000000000000001026513123334565014456 0ustar0000000000000000{-# 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 hpack-0.18.1/src/Hpack/GenericsUtil.hs0000644000000000000000000000242613123334565015634 0ustar0000000000000000{-# 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 _ = [] hpack-0.18.1/src/Hpack/Yaml.hs0000644000000000000000000000125713123334565014142 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} module Hpack.Yaml where import Data.Yaml hiding (decodeFile, decodeFileEither) import Data.Yaml.Include 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 hpack-0.18.1/src/Hpack/Haskell.hs0000644000000000000000000000174513123334565014625 0ustar0000000000000000module 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 == '\'' hpack-0.18.1/src/Hpack/Config.hs0000644000000000000000000010021513123334565014437 0ustar0000000000000000{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} module Hpack.Config ( packageConfig , readPackageConfig , renamePackage , packageDependencies , package , section , Package(..) , Dependency(..) , AddSource(..) , GitUrl , GitRef , GhcOption , CustomSetup(..) , Section(..) , Library(..) , Executable(..) , Conditional(..) , Flag(..) , SourceRepository(..) #ifdef TEST , renameDependencies , HasFieldNames(..) , CaptureUnknownFields(..) , Empty(..) , getModules , determineModules , BuildType(..) #endif ) where import Control.Applicative import Control.Monad.Compat import Data.Aeson.Types 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 (nub, (\\), sortBy, isPrefixOf) import Data.Maybe import Data.Ord import Data.String import Data.Text (Text) import qualified Data.Text as T import GHC.Generics (Generic, Rep) import Prelude () import Prelude.Compat import System.Directory import System.FilePath import Hpack.GenericsUtil import Hpack.Util import Hpack.Yaml package :: String -> String -> Package package name version = Package { packageName = name , packageVersion = version , packageSynopsis = Nothing , packageDescription = Nothing , packageHomepage = Nothing , packageBugReports = Nothing , packageCategory = Nothing , packageStability = Nothing , packageAuthor = [] , packageMaintainer = [] , packageCopyright = [] , packageBuildType = Simple , packageLicense = Nothing , packageLicenseFile = [] , packageTestedWith = Nothing , packageFlags = [] , packageExtraSourceFiles = [] , packageDataFiles = [] , packageSourceRepository = Nothing , packageCustomSetup = Nothing , packageLibrary = Nothing , packageExecutables = [] , packageTests = [] , packageBenchmarks = [] } 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/" #if MIN_VERSION_aeson(1,0,0) genericParseJSON_ :: forall a. (Generic a, GFromJSON Zero (Rep a), HasTypeName a) => Value -> Parser a #else genericParseJSON_ :: forall a. (Generic a, GFromJSON (Rep a), HasTypeName a) => Value -> Parser a #endif genericParseJSON_ = genericParseJSON defaultOptions {fieldLabelModifier = hyphenize name} where name :: String name = typeName (Proxy :: Proxy a) hyphenize :: String -> String -> String hyphenize name = #if MIN_VERSION_aeson(0,10,0) camelTo2 #else camelTo #endif '-' . drop (length 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) ignoreUnderscoredUnknownFields :: Proxy a -> Bool ignoreUnderscoredUnknownFields _ = False data CaptureUnknownFields a = CaptureUnknownFields { captureUnknownFieldsFields :: [FieldName] , captureUnknownFieldsValue :: a } deriving (Eq, Show, Generic) captureUnknownFields :: forall a. (HasFieldNames a, FromJSON a) => Value -> Parser (CaptureUnknownFields a) captureUnknownFields v = CaptureUnknownFields unknown <$> parseJSON v where unknown = getUnknownFields v (Proxy :: Proxy a) instance (HasFieldNames a, FromJSON a) => FromJSON (CaptureUnknownFields (Section a)) where parseJSON v = do (unknownFields, sect) <- toSection <$> parseJSON v <*> parseJSON v return (CaptureUnknownFields (unknownSectionFields ++ unknownFields) sect) where unknownSectionFields = getUnknownFields v (Proxy :: Proxy (Section a)) instance FromJSON (CaptureUnknownFields CustomSetupSection) where parseJSON = captureUnknownFields instance FromJSON (CaptureUnknownFields FlagSection) where parseJSON = captureUnknownFields getUnknownFields :: forall a. HasFieldNames a => Value -> Proxy a -> [FieldName] getUnknownFields v _ = case v of Object o -> ignoreUnderscored unknown where unknown = keys \\ fields keys = map T.unpack (HashMap.keys o) fields = fieldNames (Proxy :: Proxy a) ignoreUnderscored | ignoreUnderscoredUnknownFields (Proxy :: Proxy a) = filter (not . isPrefixOf "_") | otherwise = id _ -> [] data CustomSetupSection = CustomSetupSection { customSetupSectionDependencies :: Maybe (List Dependency) } deriving (Eq, Show, Generic) instance HasFieldNames CustomSetupSection instance FromJSON CustomSetupSection where parseJSON = genericParseJSON_ 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) , commonOptionsGhcjsOptions :: Maybe (List GhcjsOption) , commonOptionsCppOptions :: Maybe (List CppOption) , commonOptionsCcOptions :: Maybe (List CcOption) , commonOptionsCSources :: Maybe (List FilePath) , commonOptionsJsSources :: 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) 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) instance FromJSON Empty where parseJSON _ = return Empty instance HasFieldNames Empty where fieldNames _ = [] -- From Cabal the library, copied here to avoid a dependency on Cabal. data BuildType = Simple | Configure | Make | Custom deriving (Eq, Show, Generic) instance FromJSON BuildType where parseJSON = withText "String" $ \case "Simple" -> return Simple "Configure" -> return Configure "Make" -> return Make "Custom" -> return Custom _ -> fail "build-type must be one of: Simple, Configure, Make, Custom" type ExecutableConfig = CaptureUnknownFields (Section 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) , packageConfigBuildType :: Maybe BuildType , packageConfigLicense :: Maybe String , packageConfigLicenseFile :: Maybe (List String) , packageConfigTestedWith :: Maybe String , packageConfigFlags :: Maybe (Map String (CaptureUnknownFields FlagSection)) , packageConfigExtraSourceFiles :: Maybe (List FilePath) , packageConfigDataFiles :: Maybe (List FilePath) , packageConfigGithub :: Maybe Text , packageConfigGit :: Maybe String , packageConfigCustomSetup :: Maybe (CaptureUnknownFields CustomSetupSection) , packageConfigLibrary :: Maybe (CaptureUnknownFields (Section LibrarySection)) , packageConfigExecutable :: Maybe ExecutableConfig , packageConfigExecutables :: Maybe (Map String ExecutableConfig) , packageConfigTests :: Maybe (Map String (CaptureUnknownFields (Section ExecutableSection))) , packageConfigBenchmarks :: Maybe (Map String (CaptureUnknownFields (Section ExecutableSection))) } deriving (Eq, Show, Generic) instance HasFieldNames PackageConfig where ignoreUnderscoredUnknownFields _ = True 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) 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) 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] , packageBuildType :: BuildType , packageLicense :: Maybe String , packageLicenseFile :: [FilePath] , packageTestedWith :: Maybe String , packageFlags :: [Flag] , packageExtraSourceFiles :: [FilePath] , packageDataFiles :: [FilePath] , packageSourceRepository :: Maybe SourceRepository , packageCustomSetup :: Maybe CustomSetup , packageLibrary :: Maybe (Section Library) , packageExecutables :: [Section Executable] , packageTests :: [Section Executable] , packageBenchmarks :: [Section Executable] } deriving (Eq, Show) data CustomSetup = CustomSetup { customSetupDependencies :: [Dependency] } deriving (Eq, Show) data Library = Library { libraryExposed :: Maybe Bool , libraryExposedModules :: [String] , libraryOtherModules :: [String] , libraryReexportedModules :: [String] } deriving (Eq, Show) data Executable = Executable { executableName :: String , executableMain :: FilePath , executableOtherModules :: [String] } deriving (Eq, Show) data Section a = Section { sectionData :: a , sectionSourceDirs :: [FilePath] , sectionDependencies :: [Dependency] , sectionDefaultExtensions :: [String] , sectionOtherExtensions :: [String] , sectionGhcOptions :: [GhcOption] , sectionGhcProfOptions :: [GhcProfOption] , sectionGhcjsOptions :: [GhcjsOption] , sectionCppOptions :: [CppOption] , sectionCcOptions :: [CcOption] , sectionCSources :: [FilePath] , sectionJsSources :: [FilePath] , sectionExtraLibDirs :: [FilePath] , sectionExtraLibraries :: [FilePath] , sectionIncludeDirs :: [FilePath] , sectionInstallIncludes :: [FilePath] , sectionLdOptions :: [LdOption] , sectionBuildable :: Maybe Bool , sectionConditionals :: [Conditional] , sectionBuildTools :: [Dependency] } deriving (Eq, Show, Functor, Foldable, Traversable) data Conditional = Conditional { conditionalCondition :: String , conditionalThen :: Section () , conditionalElse :: Maybe (Section ()) } deriving (Eq, Show) instance HasFieldNames a => HasFieldNames (Section a) where fieldNames Proxy = fieldNames (Proxy :: Proxy a) ++ fieldNames (Proxy :: Proxy CommonOptions) ignoreUnderscoredUnknownFields _ = ignoreUnderscoredUnknownFields (Proxy :: Proxy a) 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) 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) mkPackage :: FilePath -> (CaptureUnknownFields (Section PackageConfig)) -> IO ([String], Package) mkPackage dir (CaptureUnknownFields unknownFields globalOptions@Section{sectionData = PackageConfig{..}}) = do libraryResult <- mapM (toLibrary dir packageName_ globalOptions) mLibrarySection let executableWarnings :: [String] executableSections :: [(String, Section ExecutableSection)] (executableWarnings, executableSections) = (warnings, map (fmap captureUnknownFieldsValue) sections) where sections = case (packageConfigExecutable, packageConfigExecutables) of (Nothing, Nothing) -> [] (Just executable, _) -> [(packageName_, executable)] (Nothing, Just executables) -> Map.toList executables warnings = ignoringExecutablesWarning ++ unknownFieldWarnings ignoringExecutablesWarning = case (packageConfigExecutable, packageConfigExecutables) of (Just _, Just _) -> ["Ignoring field \"executables\" in favor of \"executable\""] _ -> [] unknownFieldWarnings = formatUnknownSectionFields (isJust packageConfigExecutables) "executable" sections mLibrary :: Maybe (Section Library) mLibrary = fmap snd libraryResult libraryWarnings :: [String] libraryWarnings = maybe [] fst libraryResult (executablesWarnings, executables) <- toExecutables dir globalOptions executableSections (testsWarnings, tests) <- toExecutables dir globalOptions (map (fmap captureUnknownFieldsValue) testsSections) (benchmarksWarnings, 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 "extra-source-files" dir (fromMaybeList packageConfigExtraSourceFiles) (dataFilesWarnings, dataFiles) <- expandGlobs "data-files" dir (fromMaybeList packageConfigDataFiles) let defaultBuildType :: BuildType defaultBuildType = maybe Simple (const Custom) mCustomSetup configLicenseFiles :: Maybe (List String) configLicenseFiles = packageConfigLicenseFile <|> do guard licenseFileExists Just (List ["LICENSE"]) pkg = Package { packageName = packageName_ , 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 , packageBuildType = fromMaybe defaultBuildType packageConfigBuildType , packageLicense = packageConfigLicense , packageLicenseFile = fromMaybeList configLicenseFiles , packageTestedWith = packageConfigTestedWith , packageFlags = flags , packageExtraSourceFiles = extraSourceFiles , packageDataFiles = dataFiles , packageSourceRepository = sourceRepository , packageCustomSetup = mCustomSetup , packageLibrary = mLibrary , packageExecutables = executables , packageTests = tests , packageBenchmarks = benchmarks } warnings = formatUnknownFields "package description" unknownFields ++ nameWarnings ++ flagWarnings ++ maybe [] (formatUnknownFields "custom-setup section") (captureUnknownFieldsFields <$> packageConfigCustomSetup) ++ maybe [] (formatUnknownFields "library section") (captureUnknownFieldsFields <$> packageConfigLibrary) ++ formatUnknownSectionFields True "test" testsSections ++ formatUnknownSectionFields True "benchmark" benchmarkSections ++ formatMissingSourceDirs missingSourceDirs ++ libraryWarnings ++ executableWarnings ++ executablesWarnings ++ testsWarnings ++ benchmarksWarnings ++ extraSourceFilesWarnings ++ dataFilesWarnings return (warnings, pkg) where nameWarnings :: [String] packageName_ :: String (nameWarnings, packageName_) = case packageConfigName of Nothing -> let inferredName = takeBaseName dir in (["Package name not specified, inferred " ++ show inferredName], inferredName) Just n -> ([], n) mCustomSetup :: Maybe CustomSetup mCustomSetup = toCustomSetup <$> mCustomSetupSection testsSections :: [(String, CaptureUnknownFields (Section ExecutableSection))] testsSections = toList packageConfigTests benchmarkSections :: [(String, CaptureUnknownFields (Section ExecutableSection))] benchmarkSections = toList packageConfigBenchmarks (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 mCustomSetupSection :: Maybe CustomSetupSection mCustomSetupSection = captureUnknownFieldsValue <$> packageConfigCustomSetup 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 :: Bool -> String -> [(String, CaptureUnknownFields a)] -> [String] formatUnknownSectionFields showSect sectionType = concatMap f . map (fmap captureUnknownFieldsFields) where f :: (String, [String]) -> [String] f (sect, fields) = formatUnknownFields (sectionType ++ " section" ++ if showSect then " " ++ show sect else "") fields 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 expandCSources :: FilePath -> Section a -> IO ([String], Section a) expandCSources dir sect@Section{..} = do (warnings, files) <- expandGlobs "c-sources" dir sectionCSources return (warnings, sect {sectionCSources = files}) expandJsSources :: FilePath -> Section a -> IO ([String], Section a) expandJsSources dir sect@Section{..} = do (warnings, files) <- expandGlobs "js-sources" dir sectionJsSources return (warnings, sect {sectionJsSources = files}) expandForeignSources :: FilePath -> Section a -> IO ([String], Section a) expandForeignSources dir sect = do (cWarnings, sect_) <- expandCSources dir sect (jsWarnings, sect__) <- expandJsSources dir sect_ return (cWarnings ++ jsWarnings, sect__) toCustomSetup :: CustomSetupSection -> CustomSetup toCustomSetup CustomSetupSection{..} = CustomSetup { customSetupDependencies = fromMaybeList customSetupSectionDependencies } toLibrary :: FilePath -> String -> Section global -> Section LibrarySection -> IO ([String], Section Library) toLibrary dir name globalOptions library = traverse fromLibrarySection sect >>= expandForeignSources dir 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 ([String], [Section Executable]) toExecutables dir globalOptions executables = do result <- mapM toExecutable sections >>= mapM (expandForeignSources dir) let (warnings, xs) = unzip result return (concat warnings, xs) 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 , sectionGhcjsOptions = sectionGhcjsOptions globalOptions ++ sectionGhcjsOptions options , sectionCppOptions = sectionCppOptions globalOptions ++ sectionCppOptions options , sectionCcOptions = sectionCcOptions globalOptions ++ sectionCcOptions options , sectionCSources = sectionCSources globalOptions ++ sectionCSources options , sectionJsSources = sectionJsSources globalOptions ++ sectionJsSources options , sectionExtraLibDirs = sectionExtraLibDirs globalOptions ++ sectionExtraLibDirs options , sectionExtraLibraries = sectionExtraLibraries globalOptions ++ sectionExtraLibraries options , 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 , sectionGhcjsOptions = fromMaybeList commonOptionsGhcjsOptions , sectionCppOptions = fromMaybeList commonOptionsCppOptions , sectionCcOptions = fromMaybeList commonOptionsCcOptions , sectionCSources = fromMaybeList commonOptionsCSources , sectionJsSources = fromMaybeList commonOptionsJsSources , 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, [pathsModuleFromPackageName name]) _ -> (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 <$> getModuleFilesRecursive 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 hpack-0.18.1/src/Hpack/Options.hs0000644000000000000000000000161413123334565014670 0ustar0000000000000000module Hpack.Options where import Prelude () import Prelude.Compat data ParseResult = Help | PrintVersion | Run Options | ParseError deriving (Eq, Show) data Options = Options { optionsVerbose :: Bool , optionsToStdout :: Bool , optionsTarget :: Maybe FilePath } deriving (Eq, Show) parseOptions :: [String] -> ParseResult parseOptions xs = case xs of ["--version"] -> PrintVersion ["--help"] -> Help _ -> case targets of Just (target, toStdout) -> Run (Options verbose toStdout target) Nothing -> ParseError where silentFlag = "--silent" verbose = not (silentFlag `elem` xs) ys = filter (/= silentFlag) xs targets = case ys of ["-"] -> Just (Nothing, True) ["-", "-"] -> Nothing [dir] -> Just (Just dir, False) [dir, "-"] -> Just (Just dir, True) [] -> Just (Nothing, False) _ -> Nothing