hpack 0.23.0 → 0.24.0

raw patch · 30 files changed

+1453/−1239 lines, 30 filesdep +HUnitdep +template-haskelldep +vectordep ~aesondep ~basedep ~yamlPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, template-haskell, vector

Dependency ranges changed: aeson, base, yaml

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• hpack.cabal +26/−18
• src/Data/Aeson/Config/FromValue.hs +138/−0
• src/Data/Aeson/Config/Parser.hs +145/−0
• src/Data/Aeson/Config/Types.hs +42/−0
• src/Data/Aeson/Config/Util.hs +8/−0
• src/Hpack/Config.hs +206/−332
• src/Hpack/Defaults.hs +1/−1
• src/Hpack/Dependency.hs +24/−18
• src/Hpack/Render.hs +2/−1
• src/Hpack/Run.hs +50/−13
• src/Hpack/Syntax.hs +0/−122
• src/Hpack/Syntax/Defaults.hs +114/−0
• src/Hpack/Syntax/GenericsUtil.hs +0/−45
• src/Hpack/Syntax/UnknownFields.hs +0/−83
• src/Hpack/Syntax/Util.hs +0/−36
• src/Hpack/Util.hs +1/−19
• src/Hpack/Yaml.hs +1/−1
• test/Data/Aeson/Config/FromValueSpec.hs +123/−0
• test/Data/Aeson/Config/TypesSpec.hs +36/−0
• test/Data/Aeson/Config/UtilSpec.hs +21/−0
• test/EndToEndSpec.hs +267/−26
• test/Helper.hs +6/−6
• test/Hpack/ConfigSpec.hs +31/−249
• test/Hpack/DependencySpec.hs +53/−53
• test/Hpack/Syntax/DefaultsSpec.hs +153/−0
• test/Hpack/Syntax/GenericsUtilSpec.hs +0/−24
• test/Hpack/Syntax/UtilSpec.hs +0/−21
• test/Hpack/SyntaxSpec.hs +0/−148
• test/Hpack/UtilSpec.hs +0/−23

@@ -1,3 +1,8 @@+## next+  - Add support for `verbatim` Cabal escape hatch+  - Allow `version` be a numbers+  - Ignore fields that start with an underscore everywhere, not just globally+ ## Changes in 0.23.0   - Add support for custom decoders to allow for alternate syntax (e.g. Dhall)   - `generated-exposed-modules` and `generated-other-modules`, for populating

@@ -1,11 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.22.0.+-- This file has been generated from package.yaml by hpack version 0.23.0. -- -- see: https://github.com/sol/hpack ----- hash: a810403afb86b045741c0bad9d0d0d278cd4582751e39f0912edd62038c29692+-- hash: 0260680387a428cfeb1d8d836b9a16adc24a270dd054e78b49d6b13693dcadcd  name:           hpack-version:        0.23.0+version:        0.24.0 synopsis:       An alternative format for Haskell packages description:    See README at <https://github.com/sol/hpack#readme> category:       Development@@ -31,7 +31,7 @@   build-depends:       Cabal     , Glob-    , aeson >=0.11+    , aeson >=1.0.0     , base >=4.8 && <5     , bifunctors     , bytestring@@ -48,6 +48,7 @@     , text     , transformers     , unordered-containers+    , vector     , yaml   exposed-modules:       Hpack@@ -55,6 +56,10 @@       Hpack.Run       Hpack.Yaml   other-modules:+      Data.Aeson.Config.FromValue+      Data.Aeson.Config.Parser+      Data.Aeson.Config.Types+      Data.Aeson.Config.Util       Hpack.CabalFile       Hpack.Defaults       Hpack.Dependency@@ -62,11 +67,8 @@       Hpack.Haskell       Hpack.Options       Hpack.Render-      Hpack.Syntax-      Hpack.Syntax.GenericsUtil+      Hpack.Syntax.Defaults       Hpack.Syntax.Git-      Hpack.Syntax.UnknownFields-      Hpack.Syntax.Util       Hpack.Utf8       Hpack.Util       Paths_hpack@@ -80,7 +82,7 @@   build-depends:       Cabal     , Glob-    , aeson >=0.11+    , aeson >=1.0.0     , base >=4.8 && <5     , bifunctors     , bytestring@@ -98,6 +100,7 @@     , text     , transformers     , unordered-containers+    , vector     , yaml   other-modules:       Paths_hpack@@ -114,8 +117,9 @@   build-depends:       Cabal     , Glob+    , HUnit     , QuickCheck-    , aeson >=0.11+    , aeson >=1.0.0     , base >=4.8 && <5     , bifunctors     , bytestring@@ -132,12 +136,17 @@     , mockery >=0.3     , pretty     , scientific+    , template-haskell     , temporary     , text     , transformers     , unordered-containers-    , yaml+    , vector+    , yaml >=0.8.28   other-modules:+      Data.Aeson.Config.FromValueSpec+      Data.Aeson.Config.TypesSpec+      Data.Aeson.Config.UtilSpec       EndToEndSpec       Helper       Hpack.CabalFileSpec@@ -149,13 +158,15 @@       Hpack.OptionsSpec       Hpack.RenderSpec       Hpack.RunSpec-      Hpack.Syntax.GenericsUtilSpec+      Hpack.Syntax.DefaultsSpec       Hpack.Syntax.GitSpec-      Hpack.Syntax.UtilSpec-      Hpack.SyntaxSpec       Hpack.Utf8Spec       Hpack.UtilSpec       HpackSpec+      Data.Aeson.Config.FromValue+      Data.Aeson.Config.Parser+      Data.Aeson.Config.Types+      Data.Aeson.Config.Util       Hpack       Hpack.CabalFile       Hpack.Config@@ -166,11 +177,8 @@       Hpack.Options       Hpack.Render       Hpack.Run-      Hpack.Syntax-      Hpack.Syntax.GenericsUtil+      Hpack.Syntax.Defaults       Hpack.Syntax.Git-      Hpack.Syntax.UnknownFields-      Hpack.Syntax.Util       Hpack.Utf8       Hpack.Util       Hpack.Yaml

@@ -0,0 +1,138 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE RecordWildCards #-}++{-# LANGUAGE ConstraintKinds #-}+module Data.Aeson.Config.FromValue (+  FromValue(..)+, Parser+, DecodeResult+, decodeValue++, Generic+, GenericDecode+, genericFromValue+, Options(..)+, genericFromValueWith++, typeMismatch+, withObject+, withText+, withString+, withArray+, withNumber+, withBool++, (.:)+, (.:?)++, Value(..)+, Object+, Array+) where++import           GHC.Generics++import           Control.Monad+import           Control.Applicative++import           Data.Map.Lazy (Map)+import qualified Data.Map.Lazy as Map+import           Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Vector as V+import qualified Data.HashMap.Strict as HashMap+import           Data.Aeson.Types (FromJSON(..))++import           Data.Aeson.Config.Util+import           Data.Aeson.Config.Parser++type DecodeResult a = Either String (a, [String])++decodeValue :: FromValue a => Value -> DecodeResult a+decodeValue = runParser fromValue++(.:) :: FromValue a => Object -> Text -> Parser a+(.:) = explicitParseField fromValue++(.:?) :: FromValue a => Object -> Text -> Parser (Maybe a)+(.:?) = explicitParseFieldMaybe fromValue++class FromValue a where+  fromValue :: Value -> Parser a+  default fromValue :: forall d m. (Generic a, Rep a ~ D1 d m, Datatype d, GenericDecode (Rep a)) => Value -> Parser a+  fromValue = genericFromValue++genericFromValue :: forall a d m. (Generic a, Rep a ~ D1 d m, Datatype d, GenericDecode (Rep a)) => Value -> Parser a+genericFromValue = genericFromValueWith (Options $ hyphenize name)+  where+    name :: String+    name = datatypeName (undefined :: D1 d m p)++instance FromValue Bool where+  fromValue = liftParser . parseJSON++instance FromValue Int where+  fromValue = liftParser . parseJSON++instance FromValue Text where+  fromValue = liftParser . parseJSON++instance {-# OVERLAPPING #-} FromValue String where+  fromValue = liftParser . parseJSON++instance FromValue a => FromValue (Maybe a) where+  fromValue value = liftParser (parseJSON value) >>= traverse fromValue++instance FromValue a => FromValue [a] where+  fromValue = withArray $ zipWithM (parseIndexed fromValue) [0..] . V.toList+    where+      parseIndexed :: (Value -> Parser a) -> Int -> Value -> Parser a+      parseIndexed p n value = p value <?> Index n++instance FromValue a => FromValue (Map String a) where+  fromValue = withObject $ \ o -> do+    xs <- forM (HashMap.toList o) $ \ (name, value) ->+      (,) (T.unpack name) <$> fromValue value <?> Key name+    return $ Map.fromList xs++instance (FromValue a, FromValue b) => FromValue (a, b) where+  fromValue v = (,) <$> fromValue v <*> fromValue v++instance (FromValue a, FromValue b) => FromValue (Either a b) where+  fromValue v = Left <$> fromValue v <|> Right <$> fromValue v++data Options = Options {+  optionsRecordSelectorModifier :: String -> String+}++genericFromValueWith :: (Generic a, GenericDecode (Rep a)) => Options -> Value -> Parser a+genericFromValueWith opts = fmap to . genericDecode  opts++class GenericDecode f where+  genericDecode :: Options -> Value -> Parser (f p)++instance (GenericDecode a) => GenericDecode (D1 d a) where+  genericDecode opts = fmap M1 . genericDecode opts++instance (GenericDecode a) => GenericDecode (C1 c a) where+  genericDecode opts = fmap M1 . genericDecode opts++instance (GenericDecode a, GenericDecode b) => GenericDecode (a :*: b) where+  genericDecode opts o = (:*:) <$> genericDecode opts o <*> genericDecode opts o++instance (Selector sel, FromValue a) => GenericDecode (S1 sel (Rec0 a)) where+  genericDecode = accessFieldWith (.:)++instance {-# OVERLAPPING #-} (Selector sel, FromValue a) => GenericDecode (S1 sel (Rec0 (Maybe a))) where+  genericDecode = accessFieldWith (.:?)++accessFieldWith :: forall sel a p. Selector sel => (Object -> Text -> Parser a) -> Options -> Value -> Parser (S1 sel (Rec0 a) p)+accessFieldWith op Options{..} v = M1 . K1 <$> withObject (`op` T.pack label) v+  where+    label = optionsRecordSelectorModifier $ selName (undefined :: S1 sel (Rec0 a) p)

@@ -0,0 +1,145 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+module Data.Aeson.Config.Parser (+  Parser+, runParser++, typeMismatch+, withObject+, withText+, withString+, withArray+, withNumber+, withBool++, explicitParseField+, explicitParseFieldMaybe++, Aeson.JSONPathElement(..)+, (<?>)++, Value(..)+, Object+, Array++, liftParser+) where++import           Control.Monad+import           Control.Applicative+import           Control.Monad.Trans.Class+import           Control.Monad.Trans.Writer+import           Data.Monoid ((<>))+import           Data.Scientific+import           Data.Set (Set, notMember)+import qualified Data.Set as Set+import           Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Vector as V+import qualified Data.HashMap.Strict as HashMap+import           Data.Aeson.Types (Value(..), Object, Array)+import qualified Data.Aeson.Types as Aeson+import           Data.Aeson.Internal (IResult(..), iparse)+import qualified Data.Aeson.Internal as Aeson++-- This is needed so that we have an Ord instance for aeson < 1.2.4.+data JSONPathElement = Key Text | Index Int+  deriving (Eq, Show, Ord)++type JSONPath = [JSONPathElement]++fromAesonPath :: Aeson.JSONPath -> JSONPath+fromAesonPath = reverse . map fromAesonPathElement++fromAesonPathElement :: Aeson.JSONPathElement -> JSONPathElement+fromAesonPathElement e = case e of+  Aeson.Key k -> Key k+  Aeson.Index n -> Index n++newtype Parser a = Parser {unParser :: WriterT (Set JSONPath) Aeson.Parser a}+  deriving (Functor, Applicative, Alternative, Monad)++liftParser :: Aeson.Parser a -> Parser a+liftParser = Parser . lift++runParser :: (Value -> Parser a) -> Value -> Either String (a, [String])+runParser p v = case iparse (runWriterT . unParser <$> p) v of+  IError path err -> Left ("Error while parsing " ++ formatPath (fromAesonPath path) ++ " - " ++ err)+  ISuccess (a, consumed) -> Right (a, map formatPath (determineUnconsumed consumed v))++formatPath :: JSONPath -> String+formatPath = go "$" . reverse+  where+    go :: String -> JSONPath -> String+    go acc path = case path of+      [] -> acc+      Index n : xs -> go (acc ++ "[" ++ show n ++ "]") xs+      Key key : xs -> go (acc ++ "." ++ T.unpack key) xs++determineUnconsumed :: Set JSONPath -> Value -> [JSONPath]+determineUnconsumed ((<> Set.singleton []) -> consumed) = Set.toList . execWriter . go []+  where+    go :: JSONPath -> Value -> Writer (Set JSONPath) ()+    go path value+      | path `notMember` consumed = tell (Set.singleton path)+      | otherwise = case value of+          Number _ -> return ()+          String _ -> return ()+          Bool _ -> return ()+          Null -> return ()+          Object o -> do+            forM_ (HashMap.toList o) $ \ (k, v) -> do+              unless ("_" `T.isPrefixOf` k) $ do+                go (Key k : path) v+          Array xs -> do+            forM_ (zip [0..] $ V.toList xs) $ \ (n, v) -> do+              go (Index n : path) v++(<?>) :: Parser a -> Aeson.JSONPathElement -> Parser a+(<?>) (Parser (WriterT p)) e = do+  Parser (WriterT (p Aeson.<?> e)) <* markConsumed (fromAesonPathElement e)++markConsumed :: JSONPathElement -> Parser ()+markConsumed e = do+  path <- getPath+  Parser $ tell (Set.singleton $ e : path)++getPath :: Parser JSONPath+getPath = liftParser $ Aeson.parserCatchError empty $ \ path _ -> return (fromAesonPath path)++explicitParseField :: (Value -> Parser a) -> Object -> Text -> Parser a+explicitParseField p o key = case HashMap.lookup key o of+  Nothing -> fail $ "key " ++ show key ++ " not present"+  Just v  -> p v <?> Aeson.Key key++explicitParseFieldMaybe :: (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)+explicitParseFieldMaybe p o key = case HashMap.lookup key o of+  Nothing -> pure Nothing+  Just v  -> Just <$> p v <?> Aeson.Key key++typeMismatch :: String -> Value -> Parser a+typeMismatch expected = liftParser . Aeson.typeMismatch expected++withObject :: (Object -> Parser a) -> Value -> Parser a+withObject p (Object o) = p o+withObject _ v = typeMismatch "Object" v++withText :: (Text -> Parser a) -> Value -> Parser a+withText p (String s) = p s+withText _ v = typeMismatch "String" v++withString :: (String -> Parser a) -> Value -> Parser a+withString p = withText (p . T.unpack)++withArray :: (Array -> Parser a) -> Value -> Parser a+withArray p (Array xs) = p xs+withArray _ v = typeMismatch "Array" v++withNumber :: (Scientific -> Parser a) -> Value -> Parser a+withNumber p (Number n) = p n+withNumber _ v = typeMismatch "Number" v++withBool :: (Bool -> Parser a) -> Value -> Parser a+withBool p (Bool b) = p b+withBool _ v = typeMismatch "Boolean" v

@@ -0,0 +1,42 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Data.Aeson.Config.Types where++import           Data.Monoid hiding (Product)+import           Data.Bitraversable+import           Data.Bifoldable+import           Data.Bifunctor++import           Data.Aeson.Config.FromValue++newtype List a = List {fromList :: [a]}+  deriving (Eq, Show, Functor, Foldable, Traversable, Monoid)++instance FromValue a => FromValue (List a) where+  fromValue v = List <$> case v of+    Array _ -> fromValue v+    _ -> return <$> fromValue v++fromMaybeList :: Maybe (List a) -> [a]+fromMaybeList = maybe [] fromList++data Product a b = Product a b+  deriving (Eq, Show, Functor, Foldable, Traversable)++instance (Monoid a, Monoid b) => Monoid (Product a b) where+  mempty = Product mempty mempty+  Product a1 b1 `mappend` Product a2 b2 = Product (a1 <> a2) (b1 <> b2)++instance Bifunctor Product where+  bimap fa fb (Product a b) = Product (fa a) (fb b)++instance Bifoldable Product where+  bifoldMap = bifoldMapDefault++instance Bitraversable Product where+  bitraverse fa fb (Product a b) = Product <$> fa a <*> fb b++instance (FromValue a, FromValue b) => FromValue (Product a b) where+  fromValue v = Product <$> fromValue v <*> fromValue v

@@ -0,0 +1,8 @@+module Data.Aeson.Config.Util where++import           Data.Aeson.Types (camelTo2)++hyphenize :: String -> String -> String+hyphenize name = camelTo2 '-' . dropPrefix . dropWhile (== '_')+  where+    dropPrefix = drop (length (dropWhile (== '_') $ reverse name))

@@ -2,6 +2,7 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}@@ -26,6 +27,8 @@ , GitRef , GitUrl , GhcOption+, Verbatim(..)+, VerbatimValue(..) , CustomSetup(..) , Section(..) , Library(..)@@ -43,15 +46,14 @@  , LibrarySection(..) , fromLibrarySectionInConditional+, formatOrList #endif ) where  import           Control.Applicative import           Control.Arrow ((>>>)) import           Control.Monad-import           Data.Data import           Data.Bifunctor-import           Data.Bifoldable import           Data.Bitraversable import           Data.Map.Lazy (Map) import qualified Data.Map.Lazy as Map@@ -60,20 +62,21 @@ import           Data.Maybe import           Data.Monoid hiding (Product) import           Data.Ord-import           Data.String import           Data.Text (Text) import qualified Data.Text as T+import           Data.Scientific (Scientific) import           System.Directory import           System.FilePath-import           Data.Functor.Identity import           Control.Monad.Trans.Class import           Control.Monad.Trans.Writer import           Control.Monad.Trans.Except import           Control.Monad.IO.Class -import           Hpack.Syntax.Util-import           Hpack.Syntax.UnknownFields-import           Hpack.Syntax+import           Data.Aeson.Config.Types+import           Data.Aeson.Config.FromValue hiding (decodeValue)+import qualified Data.Aeson.Config.FromValue as Config++import           Hpack.Syntax.Defaults import           Hpack.Util hiding (expandGlobs) import qualified Hpack.Util as Util import           Hpack.Defaults@@ -108,6 +111,7 @@   , packageExecutables = mempty   , packageTests = mempty   , packageBenchmarks = mempty+  , packageVerbatim = []   }  renamePackage :: String -> Package -> Package@@ -138,19 +142,14 @@     deps xs = [(name, version) | (name, version) <- (Map.toList . unDependencies . sectionDependencies) xs]  section :: a -> Section a-section a = Section a [] mempty [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] Nothing [] mempty+section a = Section a [] mempty [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] Nothing [] mempty []  packageConfig :: FilePath packageConfig = "package.yaml"  data CustomSetupSection = CustomSetupSection {   customSetupSectionDependencies :: Maybe Dependencies-} deriving (Eq, Show, Generic)--instance HasFieldNames CustomSetupSection--instance FromJSON CustomSetupSection where-  parseJSON = genericParseJSON+} deriving (Eq, Show, Generic, FromValue)  data LibrarySection = LibrarySection {   librarySectionExposed :: Maybe Bool@@ -160,7 +159,7 @@ , librarySectionGeneratedOtherModules :: Maybe (List String) , librarySectionReexportedModules :: Maybe (List String) , librarySectionSignatures :: Maybe (List String)-} deriving (Eq, Show, Generic)+} deriving (Eq, Show, Generic, FromValue)  instance Monoid LibrarySection where   mempty = LibrarySection Nothing Nothing Nothing Nothing Nothing Nothing Nothing@@ -174,16 +173,11 @@     , librarySectionSignatures = librarySectionSignatures a <> librarySectionSignatures b     } -instance HasFieldNames LibrarySection--instance FromJSON LibrarySection where-  parseJSON = genericParseJSON- data ExecutableSection = ExecutableSection {   executableSectionMain :: Maybe FilePath , executableSectionOtherModules :: Maybe (List String) , executableSectionGeneratedOtherModules :: Maybe (List String)-} deriving (Eq, Show, Generic)+} deriving (Eq, Show, Generic, FromValue)  instance Monoid ExecutableSection where   mempty = ExecutableSection Nothing Nothing Nothing@@ -193,12 +187,34 @@     , executableSectionGeneratedOtherModules = executableSectionGeneratedOtherModules a <> executableSectionGeneratedOtherModules b     } -instance HasFieldNames ExecutableSection+data VerbatimValue =+    VerbatimString String+  | VerbatimNumber Scientific+  | VerbatimBool Bool+  | VerbatimNull+  deriving (Eq, Show) -instance FromJSON ExecutableSection where-  parseJSON = genericParseJSON+instance FromValue VerbatimValue where+  fromValue v = case v of+    String s -> return (VerbatimString $ T.unpack s)+    Number n -> return (VerbatimNumber n)+    Bool b -> return (VerbatimBool b)+    Null -> return VerbatimNull+    Object _ -> err+    Array _ -> err+    where+      err = typeMismatch (formatOrList ["String", "Number", "Bool", "Null"]) v -data CommonOptions capture cSources jsSources a = CommonOptions {+data Verbatim = VerbatimLiteral String | VerbatimObject (Map String VerbatimValue)+  deriving (Eq, Show)++instance FromValue Verbatim where+  fromValue v =+        VerbatimLiteral <$> fromValue v+    <|> VerbatimObject <$> fromValue v+    <|> typeMismatch (formatOrList ["String", "Object"]) v++data CommonOptions cSources jsSources a = CommonOptions {   commonOptionsSourceDirs :: Maybe (List FilePath) , commonOptionsDependencies :: Maybe Dependencies , commonOptionsPkgConfigDependencies :: Maybe (List String)@@ -219,11 +235,15 @@ , commonOptionsInstallIncludes :: Maybe (List FilePath) , commonOptionsLdOptions :: Maybe (List LdOption) , commonOptionsBuildable :: Maybe Bool-, commonOptionsWhen :: Maybe (List (ConditionalSection capture cSources jsSources a))+, commonOptionsWhen :: Maybe (List (ConditionalSection cSources jsSources a)) , commonOptionsBuildTools :: Maybe Dependencies+, commonOptionsVerbatim :: Maybe (List Verbatim) } deriving (Functor, Generic) -instance (Monoid cSources, Monoid jsSources) => Monoid (CommonOptions capture cSources jsSources a) where+type ParseCommonOptions = CommonOptions ParseCSources ParseJsSources+instance FromValue a => FromValue (ParseCommonOptions a)++instance (Monoid cSources, Monoid jsSources) => Monoid (CommonOptions cSources jsSources a) where   mempty = CommonOptions {     commonOptionsSourceDirs = Nothing   , commonOptionsDependencies = Nothing@@ -247,6 +267,7 @@   , commonOptionsBuildable = Nothing   , commonOptionsWhen = Nothing   , commonOptionsBuildTools = Nothing+  , commonOptionsVerbatim = Nothing   }   mappend a b = CommonOptions {     commonOptionsSourceDirs = commonOptionsSourceDirs a <> commonOptionsSourceDirs b@@ -271,45 +292,31 @@   , commonOptionsBuildable = commonOptionsBuildable b <|> commonOptionsBuildable a   , commonOptionsWhen = commonOptionsWhen a <> commonOptionsWhen b   , commonOptionsBuildTools = commonOptionsBuildTools b <> commonOptionsBuildTools a+  , commonOptionsVerbatim = commonOptionsVerbatim a <> commonOptionsVerbatim b   } -type ParseCommonOptions = CommonOptions CaptureUnknownFields ParseCSources ParseJsSources--instance HasFieldNames (ParseCommonOptions a)--instance (FromJSON a, HasFieldNames a) => FromJSON (ParseCommonOptions a) where-  parseJSON = genericParseJSON- type ParseCSources = Maybe (List FilePath) type ParseJsSources = Maybe (List FilePath)  type CSources = [FilePath] type JsSources = [FilePath] -type WithCommonOptions capture cSources jsSources a = Product (CommonOptions capture cSources jsSources a) a+type WithCommonOptions cSources jsSources a = Product (CommonOptions cSources jsSources a) a -data Traverse m capture capture_ cSources cSources_ jsSources jsSources_ = Traverse {-  traverseCapture :: forall a. capture a -> m (capture_ a)-, traverseCSources :: cSources -> m cSources_+data Traverse m cSources cSources_ jsSources jsSources_ = Traverse {+  traverseCSources :: cSources -> m cSources_ , traverseJsSources :: jsSources -> m jsSources_ } -defaultTraverse :: Applicative m => Traverse m capture capture cSources cSources jsSources jsSources-defaultTraverse = Traverse {-  traverseCapture = pure-, traverseCSources = pure-, traverseJsSources = pure-}--type Traversal t = forall m capture capture_ cSources cSources_ jsSources jsSources_. (Monad m, Traversable capture_)-  => Traverse m capture capture_ cSources cSources_ jsSources jsSources_-  -> t capture cSources jsSources-  -> m (t capture_ cSources_ jsSources_)+type Traversal t = forall m cSources cSources_ jsSources jsSources_. Monad m+  => Traverse m cSources cSources_ jsSources jsSources_+  -> t cSources jsSources+  -> m (t cSources_ jsSources_) -type Traversal_ t = forall m capture capture_ cSources cSources_ jsSources jsSources_ a. (Monad m, Traversable capture_)-  => Traverse m capture capture_ cSources cSources_ jsSources jsSources_-  -> t capture cSources jsSources a-  -> m (t capture_ cSources_ jsSources_ a)+type Traversal_ t = forall m cSources cSources_ jsSources jsSources_ a. Monad m+  => Traverse m cSources cSources_ jsSources jsSources_+  -> t cSources jsSources a+  -> m (t cSources_ jsSources_ a)  traverseCommonOptions :: Traversal_ CommonOptions traverseCommonOptions t@Traverse{..} c@CommonOptions{..} = do@@ -324,60 +331,33 @@  traverseConditionalSection :: Traversal_ ConditionalSection traverseConditionalSection t@Traverse{..} = \ case-  ThenElseConditional c -> ThenElseConditional <$> (traverseCapture c >>= traverse (bitraverse (traverseThenElse t) return))-  FlatConditional c -> FlatConditional <$> (traverseCapture c >>= traverse (bitraverse (traverseWithCommonOptions t) return))+  ThenElseConditional c -> ThenElseConditional <$> bitraverse (traverseThenElse t) return c+  FlatConditional c -> FlatConditional <$> bitraverse (traverseWithCommonOptions t) return c  traverseThenElse :: Traversal_ ThenElse traverseThenElse t@Traverse{..} c@ThenElse{..} = do-  then_ <- traverseCapture thenElseThen >>= traverse (traverseWithCommonOptions t)-  else_ <- traverseCapture thenElseElse >>= traverse (traverseWithCommonOptions t)+  then_ <- traverseWithCommonOptions t thenElseThen+  else_ <- traverseWithCommonOptions t thenElseElse   return c{thenElseThen = then_, thenElseElse = else_}  traverseWithCommonOptions :: Traversal_ WithCommonOptions traverseWithCommonOptions t = bitraverse (traverseCommonOptions t) return -data Product a b = Product a b-  deriving (Eq, Show, Functor, Foldable, Traversable)--instance (Monoid a, Monoid b) => Monoid (Product a b) where-  mempty = Product mempty mempty-  Product a1 b1 `mappend` Product a2 b2 = Product (a1 <> a2) (b1 <> b2)--instance Bifunctor Product where-  bimap fa fb (Product a b) = Product (fa a) (fb b)--instance Bifoldable Product where-  bifoldMap = bifoldMapDefault--instance Bitraversable Product where-  bitraverse fa fb (Product a b) = Product <$> fa a <*> fb b--instance (FromJSON a, FromJSON b) => FromJSON (Product a b) where-  parseJSON value = Product <$> parseJSON value <*> parseJSON value--instance (HasFieldNames a, HasFieldNames b) => HasFieldNames (Product a b) where-  fieldNames Proxy =-       fieldNames (Proxy :: Proxy a)-    ++ fieldNames (Proxy :: Proxy b)-  ignoreUnderscoredUnknownFields Proxy =-       ignoreUnderscoredUnknownFields (Proxy :: Proxy a)-    || ignoreUnderscoredUnknownFields (Proxy :: Proxy b)--data ConditionalSection capture cSources jsSources a =-    ThenElseConditional (capture (Product (ThenElse capture cSources jsSources a) Condition))-  | FlatConditional (capture (Product (WithCommonOptions capture cSources jsSources a) Condition))+data ConditionalSection cSources jsSources a =+    ThenElseConditional (Product (ThenElse cSources jsSources a) Condition)+  | FlatConditional (Product (WithCommonOptions cSources jsSources a) Condition) -instance Functor capture => Functor (ConditionalSection capture cSources jsSources) where+instance Functor (ConditionalSection cSources jsSources) where   fmap f = \ case-    ThenElseConditional c -> ThenElseConditional (first (fmap f) <$> c)-    FlatConditional c -> FlatConditional (first (bimap (fmap f) f) <$> c)+    ThenElseConditional c -> ThenElseConditional (first (fmap f) c)+    FlatConditional c -> FlatConditional (first (bimap (fmap f) f) c) -type ParseConditionalSection = ConditionalSection CaptureUnknownFields ParseCSources ParseJsSources+type ParseConditionalSection = ConditionalSection ParseCSources ParseJsSources -instance (FromJSON a, HasFieldNames a) => FromJSON (ParseConditionalSection a) where-  parseJSON v-    | hasKey "then" v || hasKey "else" v = ThenElseConditional <$> parseJSON v-    | otherwise = FlatConditional <$> parseJSON v+instance FromValue a => FromValue (ParseConditionalSection a) where+  fromValue v+    | hasKey "then" v || hasKey "else" v = ThenElseConditional <$> fromValue v+    | otherwise = FlatConditional <$> fromValue v  hasKey :: Text -> Value -> Bool hasKey key (Object o) = HashMap.member key o@@ -385,39 +365,31 @@  newtype Condition = Condition {   _conditionCondition :: Cond-} deriving (Eq, Show, Generic)--instance FromJSON Condition where-  parseJSON = genericParseJSON--instance HasFieldNames Condition+} deriving (Eq, Show, Generic, FromValue)  newtype Cond = Cond String   deriving (Eq, Show) -instance FromJSON Cond where-  parseJSON v = case v of-    String _ -> Cond <$> parseJSON v+instance FromValue Cond where+  fromValue v = case v of+    String s -> return (Cond $ T.unpack s)     Bool True -> return (Cond "true")     Bool False -> return (Cond "false")     _ -> typeMismatch "Boolean or String" v -data ThenElse capture cSources jsSources a = ThenElse {-  thenElseThen :: capture (WithCommonOptions capture cSources jsSources a)-, thenElseElse :: capture (WithCommonOptions capture cSources jsSources a)+data ThenElse cSources jsSources a = ThenElse {+  thenElseThen :: WithCommonOptions cSources jsSources a+, thenElseElse :: WithCommonOptions cSources jsSources a } deriving Generic -instance Functor capture => Functor (ThenElse capture cSources jsSources) where+instance Functor (ThenElse cSources jsSources) where   fmap f c@ThenElse{..} = c{thenElseThen = map_ thenElseThen, thenElseElse = map_ thenElseElse}     where-      map_ = fmap (bimap (fmap f) f)--type ParseThenElse = ThenElse CaptureUnknownFields ParseCSources ParseJsSources+      map_ = bimap (fmap f) f -instance HasFieldNames (ParseThenElse a)+type ParseThenElse = ThenElse ParseCSources ParseJsSources -instance (FromJSON a, HasFieldNames a) => FromJSON (ParseThenElse a) where-  parseJSON = genericParseJSON+instance FromValue a => FromValue (ParseThenElse a)  data Empty = Empty   deriving (Eq, Show)@@ -426,45 +398,55 @@   mempty = Empty   mappend Empty Empty = Empty -instance FromJSON Empty where-  parseJSON _ = return Empty--instance HasFieldNames Empty where-  fieldNames _ = []+instance FromValue Empty where+  fromValue _ = return Empty --- From Cabal the library, copied here to avoid a dependency on Cabal.-data BuildType-  = Simple+data BuildType =+    Simple   | Configure   | Make   | Custom-  deriving (Eq, Show, Generic)+  deriving (Eq, Show, Generic, Enum, Bounded) -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"+instance FromValue BuildType where+  fromValue = withText $ \ (T.unpack -> t) -> do+    maybe err return (lookup t options)+    where+      err = fail ("expected one of " ++ formatOrList buildTypesAsString)+      buildTypes = [minBound .. maxBound]+      buildTypesAsString = map show buildTypes+      options = zip buildTypesAsString buildTypes -type SectionConfigWithDefaluts capture cSources jsSources a = capture (Product (DefaultsConfig capture) (WithCommonOptions capture cSources jsSources a))+formatOrList :: [String] -> String+formatOrList xs = case reverse xs of+  [] -> ""+  x : [] -> x+  y : x : [] -> x ++ " or " ++ y+  x : ys@(_:_:_) -> intercalate ", " . reverse $ ("or " ++ x) : ys -type PackageConfigWithDefaults capture cSources jsSources = PackageConfig_-  (SectionConfigWithDefaluts capture cSources jsSources LibrarySection)-  (SectionConfigWithDefaluts capture cSources jsSources ExecutableSection)-  capture cSources jsSources+type SectionConfigWithDefaluts cSources jsSources a = Product DefaultsConfig (WithCommonOptions cSources jsSources a) -type SectionConfig capture cSources jsSources a = capture (WithCommonOptions capture cSources jsSources a)+type PackageConfigWithDefaults cSources jsSources = PackageConfig_+  (SectionConfigWithDefaluts cSources jsSources LibrarySection)+  (SectionConfigWithDefaluts cSources jsSources ExecutableSection)+  cSources jsSources -type PackageConfig capture cSources jsSources = PackageConfig_-  (SectionConfig capture cSources jsSources LibrarySection)-  (SectionConfig capture cSources jsSources ExecutableSection)-  capture cSources jsSources+type PackageConfig cSources jsSources = PackageConfig_+  (WithCommonOptions cSources jsSources LibrarySection)+  (WithCommonOptions cSources jsSources ExecutableSection)+  cSources jsSources -data PackageConfig_ library executable capture cSources jsSources = PackageConfig {+data PackageVersion = PackageVersion {unPackageVersion :: String}++instance FromValue PackageVersion where+  fromValue v = PackageVersion <$> case v of+    Number n -> return (scientificToVersion n)+    String s -> return (T.unpack s)+    _ -> typeMismatch "Number or String" v++data PackageConfig_ library executable cSources jsSources = PackageConfig {   packageConfigName :: Maybe String-, packageConfigVersion :: Maybe String+, packageConfigVersion :: Maybe PackageVersion , packageConfigSynopsis :: Maybe String , packageConfigDescription :: Maybe String , packageConfigHomepage :: Maybe (Maybe String)@@ -478,13 +460,13 @@ , packageConfigLicense :: Maybe String , packageConfigLicenseFile :: Maybe (List String) , packageConfigTestedWith :: Maybe String-, packageConfigFlags :: Maybe (Map String (capture FlagSection))+, packageConfigFlags :: Maybe (Map String FlagSection) , packageConfigExtraSourceFiles :: Maybe (List FilePath) , packageConfigExtraDocFiles :: Maybe (List FilePath) , packageConfigDataFiles :: Maybe (List FilePath) , packageConfigGithub :: Maybe Text , packageConfigGit :: Maybe String-, packageConfigCustomSetup :: Maybe (capture CustomSetupSection)+, packageConfigCustomSetup :: Maybe CustomSetupSection , packageConfigLibrary :: Maybe library , packageConfigInternalLibraries :: Maybe (Map String library) , packageConfigExecutable :: Maybe executable@@ -493,29 +475,20 @@ , packageConfigBenchmarks :: Maybe (Map String executable) } deriving Generic -data DefaultsConfig capture = DefaultsConfig {-  defaultsConfigDefaults :: Maybe (List (capture Defaults))-} deriving Generic--instance HasFieldNames (DefaultsConfig a)--instance FromJSON (DefaultsConfig CaptureUnknownFields) where-  parseJSON = genericParseJSON+data DefaultsConfig = DefaultsConfig {+  defaultsConfigDefaults :: Maybe (List Defaults)+} deriving (Generic, FromValue)  traversePackageConfig :: Traversal PackageConfig traversePackageConfig t@Traverse{..} p@PackageConfig{..} = do-  flags <- traverse (traverse traverseCapture) packageConfigFlags-  customSetup <- traverse traverseCapture packageConfigCustomSetup-  library <- traverse (traverseSectionConfig t) packageConfigLibrary+  library <- traverse (traverseWithCommonOptions t) packageConfigLibrary   internalLibraries <- traverseNamedConfigs t packageConfigInternalLibraries-  executable <- traverse (traverseSectionConfig t) packageConfigExecutable+  executable <- traverse (traverseWithCommonOptions t) packageConfigExecutable   executables <- traverseNamedConfigs t packageConfigExecutables   tests <- traverseNamedConfigs t packageConfigTests   benchmarks <- traverseNamedConfigs t packageConfigBenchmarks   return p {-      packageConfigFlags = flags-    , packageConfigCustomSetup = customSetup-    , packageConfigLibrary = library+      packageConfigLibrary = library     , packageConfigInternalLibraries = internalLibraries     , packageConfigExecutable = executable     , packageConfigExecutables = executables@@ -523,45 +496,17 @@     , packageConfigBenchmarks = benchmarks     }   where-    traverseNamedConfigs = traverse . traverse . traverseSectionConfig--traverseSectionConfig :: Traversal_ SectionConfig-traverseSectionConfig t = traverseCapture t >=> traverse (traverseWithCommonOptions t)--traverseSectionConfigWithDefaluts :: Traversal_ SectionConfigWithDefaluts-traverseSectionConfigWithDefaluts t =-  traverseCapture t >=> traverse (bitraverse (traverseDefaultsConfig t) (traverseWithCommonOptions t))--type ParsePackageConfig = PackageConfigWithDefaults CaptureUnknownFields ParseCSources ParseJsSources--instance HasFieldNames ParsePackageConfig where-  ignoreUnderscoredUnknownFields _ = True--instance FromJSON ParsePackageConfig where-  parseJSON value = handleNullValues <$> genericParseJSON value-    where-      handleNullValues :: ParsePackageConfig -> ParsePackageConfig-      handleNullValues =-          ifNull "homepage" (\p -> p {packageConfigHomepage = Just Nothing})-        . ifNull "bug-reports" (\p -> p {packageConfigBugReports = Just Nothing})+    traverseNamedConfigs = traverse . traverse . traverseWithCommonOptions -      ifNull :: String -> (a -> a) -> a -> a-      ifNull name f-        | isNull name value = f-        | otherwise = id+type ParsePackageConfig = PackageConfigWithDefaults ParseCSources ParseJsSources -isNull :: String -> Value -> Bool-isNull name value = case parseMaybe p value of-  Just Null -> True-  _ -> False-  where-    p = parseJSON >=> (.: fromString name)+instance FromValue ParsePackageConfig  type Warnings m = WriterT [String] m type Errors = ExceptT String -decodeYaml :: FromJSON a => FilePath -> Warnings (Errors IO) a-decodeYaml = lift . ExceptT . Yaml.decodeYaml+decodeYaml :: FromValue a => FilePath -> Warnings (Errors IO) a+decodeYaml file = lift (ExceptT $ Yaml.decodeYaml file) >>= decodeValue file  readPackageConfig :: FilePath -> FilePath -> IO (Either String (Package, [String])) readPackageConfig = readPackageConfigWith Yaml.decodeYaml@@ -569,10 +514,19 @@ readPackageConfigWith :: (FilePath -> IO (Either String Value)) -> FilePath -> FilePath -> IO (Either String (Package, [String])) readPackageConfigWith readValue userDataDir file = runExceptT $ runWriterT $ do   value <- lift . ExceptT $ readValue file-  config <- lift . ExceptT . return $ first ((file ++ ": ") ++) (parseEither parseJSON value)+  config <- decodeValue file value   dir <- liftIO $ takeDirectory <$> canonicalizePath file   toPackage userDataDir dir config +decodeValue :: FromValue a => FilePath -> Value -> Warnings (Errors IO) a+decodeValue file value = do+  (a, unknown) <- lift . ExceptT . return $ first (prefix ++) (Config.decodeValue value)+  tell (map formatUnknownField unknown)+  return a+  where+    prefix = file ++ ": "+    formatUnknownField name = prefix ++ "Ignoring unrecognized field " ++ name+ data Package = Package {   packageName :: String , packageVersion :: String@@ -600,6 +554,7 @@ , packageExecutables :: Map String (Section Executable) , packageTests :: Map String (Section Executable) , packageBenchmarks :: Map String (Section Executable)+, packageVerbatim :: [Verbatim] } deriving (Eq, Show)  data CustomSetup = CustomSetup {@@ -645,6 +600,7 @@ , sectionBuildable :: Maybe Bool , sectionConditionals :: [Conditional (Section a)] , sectionBuildTools :: Dependencies+, sectionVerbatim :: [Verbatim] } deriving (Eq, Show, Functor, Foldable, Traversable)  data Conditional a = Conditional {@@ -657,12 +613,7 @@   _flagSectionDescription :: Maybe String , _flagSectionManual :: Bool , _flagSectionDefault :: Bool-} deriving (Eq, Show, Generic)--instance HasFieldNames FlagSection--instance FromJSON FlagSection where-  parseJSON = genericParseJSON+} deriving (Eq, Show, Generic, FromValue)  data Flag = Flag {   flagName :: String@@ -679,57 +630,49 @@ , sourceRepositorySubdir :: Maybe String } deriving (Eq, Show) -type Config capture cSources jsSources =-  Product (CommonOptions capture cSources jsSources Empty) (PackageConfig capture cSources jsSources)+type Config cSources jsSources =+  Product (CommonOptions cSources jsSources Empty) (PackageConfig cSources jsSources)  traverseConfig :: Traversal Config traverseConfig t = bitraverse (traverseCommonOptions t) (traversePackageConfig t) -type ConfigWithDefaults capture = Product-  (CommonOptionsWithDefaults capture Empty)-  (PackageConfigWithDefaults capture ParseCSources ParseJsSources)--type CommonOptionsWithDefaults capture a = Product-  (DefaultsConfig capture)-  (CommonOptions capture ParseCSources ParseJsSources a)--type WithCommonOptionsWithDefaults capture a = Product-  (DefaultsConfig capture)-  (WithCommonOptions capture ParseCSources ParseJsSources a)+type ConfigWithDefaults = Product+  (CommonOptionsWithDefaults Empty)+  (PackageConfigWithDefaults ParseCSources ParseJsSources) -type ParseConfig = CaptureUnknownFields (ConfigWithDefaults CaptureUnknownFields)+type CommonOptionsWithDefaults a = Product DefaultsConfig (CommonOptions ParseCSources ParseJsSources a)+type WithCommonOptionsWithDefaults a = Product DefaultsConfig (WithCommonOptions ParseCSources ParseJsSources a) -toPackage :: FilePath -> FilePath -> ParseConfig -> Warnings (Errors IO) Package+toPackage :: FilePath -> FilePath -> ConfigWithDefaults -> Warnings (Errors IO) Package toPackage userDataDir dir =-      warnUnknownFieldsInConfig-  >=> expandDefaultsInConfig userDataDir+      expandDefaultsInConfig userDataDir   >=> traverseConfig (expandForeignSources dir)   >=> toPackage_ dir  expandDefaultsInConfig   :: FilePath-  -> ConfigWithDefaults Identity-  -> Warnings (Errors IO) (Config Identity ParseCSources ParseJsSources)+  -> ConfigWithDefaults+  -> Warnings (Errors IO) (Config ParseCSources ParseJsSources) expandDefaultsInConfig userDataDir = bitraverse (expandGlobalDefaults userDataDir) (expandSectionDefaults userDataDir)  expandGlobalDefaults   :: FilePath-  -> CommonOptionsWithDefaults Identity Empty-  -> Warnings (Errors IO) (CommonOptions Identity ParseCSources ParseJsSources Empty)+  -> CommonOptionsWithDefaults Empty+  -> Warnings (Errors IO) (CommonOptions ParseCSources ParseJsSources Empty) expandGlobalDefaults userDataDir = do   fmap (`Product` Empty) >>> expandDefaults userDataDir >=> \ (Product c Empty) -> return c  expandSectionDefaults   :: FilePath-  -> PackageConfigWithDefaults Identity ParseCSources ParseJsSources-  -> Warnings (Errors IO) (PackageConfig Identity ParseCSources ParseJsSources)+  -> PackageConfigWithDefaults ParseCSources ParseJsSources+  -> Warnings (Errors IO) (PackageConfig ParseCSources ParseJsSources) expandSectionDefaults userDataDir p@PackageConfig{..} = do-  library <- traverse (traverse (expandDefaults userDataDir)) packageConfigLibrary-  internalLibraries <- traverse (traverse (traverse (expandDefaults userDataDir))) packageConfigInternalLibraries-  executable <- traverse (traverse (expandDefaults userDataDir)) packageConfigExecutable-  executables <- traverse (traverse (traverse (expandDefaults userDataDir))) packageConfigExecutables-  tests <- traverse (traverse (traverse (expandDefaults userDataDir))) packageConfigTests-  benchmarks <- traverse (traverse (traverse (expandDefaults userDataDir))) packageConfigBenchmarks+  library <- traverse (expandDefaults userDataDir) packageConfigLibrary+  internalLibraries <- traverse (traverse (expandDefaults userDataDir)) packageConfigInternalLibraries+  executable <- traverse (expandDefaults userDataDir) packageConfigExecutable+  executables <- traverse (traverse (expandDefaults userDataDir)) packageConfigExecutables+  tests <- traverse (traverse (expandDefaults userDataDir)) packageConfigTests+  benchmarks <- traverse (traverse (expandDefaults userDataDir)) packageConfigBenchmarks   return p{       packageConfigLibrary = library     , packageConfigInternalLibraries = internalLibraries@@ -740,28 +683,28 @@     }  expandDefaults-  :: (HasFieldNames a, FromJSON a, Monoid a)+  :: (FromValue a, Monoid a)   => FilePath-  -> WithCommonOptionsWithDefaults Identity a-  -> Warnings (Errors IO) (WithCommonOptions Identity ParseCSources ParseJsSources a)+  -> WithCommonOptionsWithDefaults a+  -> Warnings (Errors IO) (WithCommonOptions ParseCSources ParseJsSources a) expandDefaults userDataDir = expand []   where-    expand :: (HasFieldNames a, FromJSON a, Monoid a) =>+    expand :: (FromValue a, Monoid a) =>          [FilePath]-      -> WithCommonOptionsWithDefaults Identity a-      -> Warnings (Errors IO) (WithCommonOptions Identity ParseCSources ParseJsSources a)+      -> WithCommonOptionsWithDefaults a+      -> Warnings (Errors IO) (WithCommonOptions ParseCSources ParseJsSources a)     expand seen (Product DefaultsConfig{..} c) = do-      d <- mconcat <$> mapM (get seen . runIdentity) (fromMaybeList defaultsConfigDefaults)+      d <- mconcat <$> mapM (get seen) (fromMaybeList defaultsConfigDefaults)       return (d <> c) -    get :: (HasFieldNames a, FromJSON a, Monoid a) =>+    get :: forall a. (FromValue a, Monoid a) =>          [FilePath]       -> Defaults-      -> Warnings (Errors IO) (WithCommonOptions Identity ParseCSources ParseJsSources a)+      -> Warnings (Errors IO) (WithCommonOptions ParseCSources ParseJsSources a)     get seen defaults = do       file <- lift $ ExceptT (ensure userDataDir defaults)       seen_ <- lift (checkCycle seen file)-      decodeYaml file >>= warnUnknownFieldsInDefaults file >>= expand seen_+      decodeYaml file >>= expand seen_      checkCycle :: [FilePath] -> FilePath -> Errors IO [FilePath]     checkCycle seen file = do@@ -780,10 +723,14 @@       return $ Just (Map.fromList [(name, executable)])     Nothing -> return executables -type GlobalOptions = CommonOptions Identity CSources JsSources Empty+type GlobalOptions = CommonOptions CSources JsSources Empty -toPackage_ :: MonadIO m => FilePath -> Product GlobalOptions (PackageConfig Identity CSources JsSources) -> Warnings m Package-toPackage_ dir (Product globalOptions PackageConfig{..}) = do+toPackage_ :: MonadIO m => FilePath -> Product GlobalOptions (PackageConfig CSources JsSources) -> Warnings m Package+toPackage_ dir (Product g PackageConfig{..}) = do+  let+    globalVerbatim = commonOptionsVerbatim g+    globalOptions = g {commonOptionsVerbatim = Nothing}+   mLibrary <- liftIO $ traverse (toLibrary dir packageName_ globalOptions) packageConfigLibrary    internalLibraries <- liftIO $ toInternalLibraries dir packageName_ globalOptions packageConfigInternalLibraries@@ -818,7 +765,7 @@        pkg = Package {         packageName = packageName_-      , packageVersion = fromMaybe "0.0.0" packageConfigVersion+      , packageVersion = maybe "0.0.0" unPackageVersion packageConfigVersion       , packageSynopsis = packageConfigSynopsis       , packageDescription = packageConfigDescription       , packageHomepage = homepage@@ -843,6 +790,7 @@       , packageExecutables = executables       , packageTests = tests       , packageBenchmarks = benchmarks+      , packageVerbatim = fromMaybeList globalVerbatim       }    tell nameWarnings@@ -857,9 +805,9 @@       Just n -> ([], n)      mCustomSetup :: Maybe CustomSetup-    mCustomSetup = toCustomSetup . runIdentity <$> packageConfigCustomSetup+    mCustomSetup = toCustomSetup <$> packageConfigCustomSetup -    flags = map (toFlag . fmap runIdentity) $ toList packageConfigFlags+    flags = map toFlag $ toList packageConfigFlags      toList :: Maybe (Map String a) -> [(String, a)]     toList = Map.toList . fromMaybe mempty@@ -894,80 +842,11 @@       where         fromGithub = (++ "/issues") . sourceRepositoryUrl <$> github -sequenceUnknownFields :: Applicative capture => Traverse capture capture Identity cSources cSources jsSources jsSources-sequenceUnknownFields = defaultTraverse{traverseCapture = fmap Identity}--warnUnknownFieldsInDefaults-  :: Monad m-  => String-  -> CaptureUnknownFields (WithCommonOptionsWithDefaults CaptureUnknownFields a)-  -> Warnings m (WithCommonOptionsWithDefaults Identity a)-warnUnknownFieldsInDefaults name =-  (warnUnknownFields In name . (>>= bitraverse sequenceDefaults (traverseWithCommonOptions sequenceUnknownFields)))--traverseDefaultsConfig-  :: Applicative m-  => Traverse m capture capture_ cSources cSources_ jsSources jsSources_-  -> DefaultsConfig capture -> m (DefaultsConfig capture_)-traverseDefaultsConfig Traverse{..} (DefaultsConfig defaults) = do-  DefaultsConfig <$> traverse (traverse $ traverseCapture) defaults--sequenceDefaults :: Applicative capture => DefaultsConfig capture -> capture (DefaultsConfig Identity)-sequenceDefaults = traverseDefaultsConfig sequenceUnknownFields--warnUnknownFieldsInConfig :: forall m. Monad m => ParseConfig -> Warnings m (ConfigWithDefaults Identity)-warnUnknownFieldsInConfig =-      warnGlobal-  >=> bitraverse (bitraverse warnDefaults return) return-  >=> traverse warnSections-  where-    t = sequenceUnknownFields--    warnGlobal c = warnUnknownFields In "package description" (c >>= bitraverse (traverse (traverseCommonOptions t)) return)--    warnDefaults :: DefaultsConfig CaptureUnknownFields -> Warnings m (DefaultsConfig Identity)-    warnDefaults = warnUnknownFields In "defaults section" . sequenceDefaults--    warnSections :: ParsePackageConfig -> Warnings m (PackageConfigWithDefaults Identity ParseCSources ParseJsSources)-    warnSections p@PackageConfig{..} = do-      flags <- traverse (warnNamed For "flag" . fmap (traverseCapture t)) packageConfigFlags-      customSetup <- warnUnknownFields In "custom-setup section" (traverse (traverseCapture t) packageConfigCustomSetup)-      library <- warnUnknownFields In "library section" (traverse (traverseSectionConfigWithDefaluts t) packageConfigLibrary)-      internalLibraries <- warnNamedSection "internal-libraries" packageConfigInternalLibraries-      executable <- warnUnknownFields In "executable section" (traverse (traverseSectionConfigWithDefaluts t) packageConfigExecutable)-      executables <- warnNamedSection "executable" packageConfigExecutables-      tests <- warnNamedSection "test" packageConfigTests-      benchmarks <- warnNamedSection "benchmark" packageConfigBenchmarks-      return p {-          packageConfigFlags = flags-        , packageConfigCustomSetup = customSetup-        , packageConfigLibrary = library-        , packageConfigInternalLibraries = internalLibraries-        , packageConfigExecutable = executable-        , packageConfigExecutables = executables-        , packageConfigTests = tests-        , packageConfigBenchmarks = benchmarks-        }--    warnNamedSection-      :: String-      -> Maybe (Map String (SectionConfigWithDefaluts CaptureUnknownFields cSources jsSources a))-      -> Warnings m (Maybe (Map String (SectionConfigWithDefaluts Identity cSources jsSources a)))-    warnNamedSection sectionType = traverse (warnNamed In (sectionType ++ " section") . fmap (traverseSectionConfigWithDefaluts t))--    warnNamed :: Preposition -> String -> Map String (CaptureUnknownFields a) -> Warnings m (Map String a)-    warnNamed preposition sect = fmap Map.fromList . mapM f . Map.toList-      where-        f (name, fields) = (,) name <$> (warnUnknownFields preposition (sect ++ " " ++ show name) fields)--warnUnknownFields :: forall m a. Monad m => Preposition -> String -> CaptureUnknownFields a -> Warnings m a-warnUnknownFields preposition name = fmap snd . bitraverse tell return . formatUnknownFields preposition name- expandForeignSources   :: MonadIO m   => FilePath-  -> Traverse (Warnings m) capture capture ParseCSources CSources ParseJsSources JsSources-expandForeignSources dir = defaultTraverse {+  -> Traverse (Warnings m) ParseCSources CSources ParseJsSources JsSources+expandForeignSources dir = Traverse {     traverseCSources = expand "c-sources"   , traverseJsSources = expand "js-sources"   }@@ -1028,10 +907,10 @@         r = fromConfig pathsModule inferableModules conf       return (outerModules ++ getInferredModules r, r) -toLibrary :: FilePath -> String -> GlobalOptions -> SectionConfig Identity CSources JsSources LibrarySection -> IO (Section Library)+toLibrary :: FilePath -> String -> GlobalOptions -> WithCommonOptions CSources JsSources LibrarySection -> IO (Section Library) toLibrary dir name globalOptions =     inferModules dir name getMentionedLibraryModules getLibraryModules fromLibrarySectionTopLevel fromLibrarySectionInConditional-  . toSectionI (mempty <$ globalOptions)+  . toSection (mempty <$ globalOptions)   where     getLibraryModules :: Library -> [String]     getLibraryModules Library{..} = libraryExposedModules ++ libraryOtherModules@@ -1070,21 +949,21 @@   , librarySignatures = fromMaybeList librarySectionSignatures   } -toInternalLibraries :: FilePath -> String -> GlobalOptions -> Maybe (Map String (SectionConfig Identity CSources JsSources LibrarySection)) -> IO (Map String (Section Library))+toInternalLibraries :: FilePath -> String -> GlobalOptions -> Maybe (Map String (WithCommonOptions CSources JsSources LibrarySection)) -> IO (Map String (Section Library)) toInternalLibraries dir packageName_ globalOptions = traverse (toLibrary dir packageName_ globalOptions) . fromMaybe mempty -toExecutables :: FilePath -> String -> GlobalOptions -> Maybe (Map String (SectionConfig Identity CSources JsSources ExecutableSection)) -> IO (Map String (Section Executable))+toExecutables :: FilePath -> String -> GlobalOptions -> Maybe (Map String (WithCommonOptions CSources JsSources ExecutableSection)) -> IO (Map String (Section Executable)) toExecutables dir packageName_ globalOptions = traverse (toExecutable dir packageName_ globalOptions) . fromMaybe mempty  getMentionedExecutableModules :: ExecutableSection -> [String] getMentionedExecutableModules (ExecutableSection main otherModules generatedModules)=   maybe id (:) (main >>= toModule . splitDirectories) $ fromMaybeList (otherModules <> generatedModules) -toExecutable :: FilePath -> String -> GlobalOptions -> SectionConfig Identity CSources JsSources ExecutableSection -> IO (Section Executable)+toExecutable :: FilePath -> String -> GlobalOptions -> WithCommonOptions CSources JsSources ExecutableSection -> IO (Section Executable) toExecutable dir packageName_ globalOptions =     inferModules dir packageName_ getMentionedExecutableModules executableOtherModules fromExecutableSection (fromExecutableSection [])   . expandMain-  . toSectionI (mempty <$ globalOptions)+  . toSection (mempty <$ globalOptions)   where     fromExecutableSection :: [String] -> [String] -> ExecutableSection -> Executable     fromExecutableSection pathsModule inferableModules ExecutableSection{..} =@@ -1112,13 +991,10 @@       , sectionConditionals = map (fmap flatten) sectionConditionals       } -toSectionI :: CommonOptions Identity CSources JsSources a -> Identity (WithCommonOptions Identity CSources JsSources a) -> Section a-toSectionI globalOptions = toSection globalOptions . runIdentity--toSection :: CommonOptions Identity CSources JsSources a -> WithCommonOptions Identity CSources JsSources a -> Section a+toSection :: CommonOptions CSources JsSources a -> WithCommonOptions CSources JsSources a -> Section a toSection globalOptions (Product options a) = toSection_ (Product (globalOptions <> options) a) -toSection_ :: WithCommonOptions Identity CSources JsSources a -> Section a+toSection_ :: WithCommonOptions CSources JsSources a -> Section a toSection_ (Product CommonOptions{..} a) = Section {         sectionData = a       , sectionSourceDirs = fromMaybeList commonOptionsSourceDirs@@ -1143,17 +1019,15 @@       , sectionPkgConfigDependencies = fromMaybeList commonOptionsPkgConfigDependencies       , sectionConditionals = conditionals       , sectionBuildTools = fromMaybe mempty commonOptionsBuildTools+      , sectionVerbatim = fromMaybeList commonOptionsVerbatim       }   where-    toSectionI_ :: Identity (WithCommonOptions Identity CSources JsSources a) -> Section a-    toSectionI_ = toSection_ . runIdentity-     conditionals = map toConditional (fromMaybeList commonOptionsWhen) -    toConditional :: ConditionalSection Identity CSources JsSources a -> Conditional (Section a)+    toConditional :: ConditionalSection CSources JsSources a -> Conditional (Section a)     toConditional x = case x of-      FlatConditional (Identity (Product sect c)) -> conditional c (toSection_ sect) Nothing-      ThenElseConditional (Identity (Product (ThenElse then_ else_) c)) -> conditional c (toSectionI_ then_) (Just $ toSectionI_ else_)+      ThenElseConditional (Product (ThenElse then_ else_) c) -> conditional c (toSection_ then_) (Just $ toSection_ else_)+      FlatConditional (Product sect c) -> conditional c (toSection_ sect) Nothing       where         conditional (Condition (Cond c)) = Conditional c 

@@ -21,7 +21,7 @@ import           System.FilePath import           System.Directory -import           Hpack.Syntax+import           Hpack.Syntax.Defaults  type URL = String 

@@ -9,6 +9,7 @@ , GitRef , GitUrl , githubBaseUrl+, scientificToVersion ) where  import qualified Data.Text as T@@ -21,10 +22,11 @@ import           Data.Map.Lazy (Map) import qualified Data.Map.Lazy as Map import           Data.Scientific-import           Data.Aeson.Types import           Control.Applicative import           GHC.Exts +import           Data.Aeson.Config.FromValue+ githubBaseUrl :: String githubBaseUrl = "https://github.com/" @@ -49,11 +51,11 @@ type GitUrl = String type GitRef = String -instance FromJSON Dependencies where-  parseJSON v = case v of-    String _ -> dependenciesFromList . return <$> parseJSON v-    Array _ -> dependenciesFromList <$> parseJSON v-    Object _ -> Dependencies <$> parseJSON v+instance FromValue Dependencies where+  fromValue v = case v of+    String _ -> dependenciesFromList . return <$> fromValue v+    Array _ -> dependenciesFromList <$> fromValue v+    Object _ -> Dependencies <$> fromValue v     _ -> typeMismatch "Array, Object, or String" v     where       fromDependency :: Dependency -> (String, DependencyVersion)@@ -62,10 +64,11 @@       dependenciesFromList :: [Dependency] -> Dependencies       dependenciesFromList = Dependencies . Map.fromList . map fromDependency -instance FromJSON DependencyVersion where-  parseJSON v = case v of++instance FromValue DependencyVersion where+  fromValue v = case v of     Null -> return AnyVersion-    Object _ -> SourceDependency <$> parseJSON v+    Object _ -> SourceDependency <$> fromValue v     Number n -> return (scientificToDependencyVersion n)     String s -> parseVersionRange ("== " ++ input) <|> parseVersionRange input       where@@ -76,14 +79,19 @@ scientificToDependencyVersion :: Scientific -> DependencyVersion scientificToDependencyVersion n = VersionRange ("==" ++ version)   where+    version = scientificToVersion n++scientificToVersion :: Scientific -> String+scientificToVersion n = version+  where     version = formatScientific Fixed (Just decimalPlaces) n     decimalPlaces       | e < 0 = abs e       | otherwise = 0     e = base10Exponent n -instance FromJSON SourceDependency where-  parseJSON = withObject "SourceDependency" (\o -> let+instance FromValue SourceDependency where+  fromValue = withObject (\o -> let     local :: Parser SourceDependency     local = Local <$> o .: "path" @@ -109,15 +117,13 @@ , _dependencyVersion :: DependencyVersion } deriving (Eq, Show) -instance FromJSON Dependency where-  parseJSON v = case v of-    String _ -> do-      (name, versionRange) <- parseJSON v >>= parseDependency-      return (Dependency name versionRange)+instance FromValue Dependency where+  fromValue v = case v of+    String s -> uncurry Dependency <$> parseDependency (T.unpack s)     Object o -> addSourceDependency o-    _ -> typeMismatch "String or an Object" v+    _ -> typeMismatch "Object or String" v     where-      addSourceDependency o = Dependency <$> name <*> (SourceDependency <$> parseJSON v)+      addSourceDependency o = Dependency <$> name <*> (SourceDependency <$> fromValue v)         where           name :: Parser String           name = o .: "name"

@@ -34,7 +34,7 @@   | WordList [String]   deriving (Eq, Show) -data Element = Stanza String [Element] | Group Element Element | Field String Value+data Element = Stanza String [Element] | Group Element Element | Field String Value | Verbatim String   deriving (Eq, Show)  data Lines = SingleLine String | MultipleLines [String]@@ -62,6 +62,7 @@ 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+render settings nesting (Verbatim str) = map (indent settings nesting) (lines str)  renderElements :: RenderSettings -> Nesting -> [Element] -> [String] renderElements settings nesting = concatMap (render settings nesting)

@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-}@@ -37,6 +38,7 @@  import           Hpack.Util import           Hpack.Config+import           Hpack.Dependency (scientificToVersion) import           Hpack.Render import           Hpack.FormattingHints import           Hpack.Yaml@@ -78,7 +80,7 @@     chunks = map unlines . filter (not . null) . map (render settings 0) $ sortSectionFields sectionsFieldOrder stanzas      header :: [String]-    header = concatMap (render settings {renderSettingsFieldAlignment = alignment} 0) fields+    header = concatMap (render settings {renderSettingsFieldAlignment = alignment} 0) (filterVerbatim packageVerbatim $ fields)      extraSourceFiles :: Element     extraSourceFiles = Field "extra-source-files" (LineSeparatedList packageExtraSourceFiles)@@ -99,7 +101,7 @@     library = maybe [] (return . renderLibrary) packageLibrary      stanzas :: [Element]-    stanzas =+    stanzas = addVerbatim packageVerbatim $       extraSourceFiles       : extraDocFiles       : dataFiles@@ -231,7 +233,7 @@  renderExecutable :: (String, Section Executable) -> Element renderExecutable (name, sect@(sectionData -> Executable{..})) =-  Stanza ("executable " ++ name) (renderExecutableSection sect)+  Stanza ("executable " ++ name) (renderExecutableSection [] sect)  renderTests :: Map String (Section Executable) -> [Element] renderTests = map renderTest . Map.toList@@ -239,7 +241,7 @@ renderTest :: (String, Section Executable) -> Element renderTest (name, sect) =   Stanza ("test-suite " ++ name)-    (Field "type" "exitcode-stdio-1.0" : renderExecutableSection sect)+    (renderExecutableSection [Field "type" "exitcode-stdio-1.0"] sect)  renderBenchmarks :: Map String (Section Executable) -> [Element] renderBenchmarks = map renderBenchmark . Map.toList@@ -247,10 +249,10 @@ renderBenchmark :: (String, Section Executable) -> Element renderBenchmark (name, sect) =   Stanza ("benchmark " ++ name)-    (Field "type" "exitcode-stdio-1.0" : renderExecutableSection sect)+    (renderExecutableSection [Field "type" "exitcode-stdio-1.0"] sect) -renderExecutableSection :: Section Executable -> [Element]-renderExecutableSection sect = renderSection renderExecutableFields sect ++ [defaultLanguage]+renderExecutableSection :: [Element] -> Section Executable -> [Element]+renderExecutableSection extraFields = renderSection renderExecutableFields extraFields [defaultLanguage]  renderExecutableFields :: Executable -> [Element] renderExecutableFields Executable{..} = mainIs ++ [otherModules, generatedModules]@@ -267,7 +269,7 @@ renderLibrary sect = Stanza "library" $ renderLibrarySection sect  renderLibrarySection :: Section Library -> [Element]-renderLibrarySection sect = renderSection renderLibraryFields sect ++ [defaultLanguage]+renderLibrarySection = renderSection renderLibraryFields [] [defaultLanguage]  renderLibraryFields :: Library -> [Element] renderLibraryFields Library{..} =@@ -282,9 +284,10 @@ renderExposed :: Bool -> Element renderExposed = Field "exposed" . Literal . show -renderSection :: (a -> [Element]) -> Section a -> [Element]-renderSection renderSectionData Section{..} =-  renderSectionData sectionData ++ [+renderSection :: (a -> [Element]) -> [Element] -> [Element] -> Section a -> [Element]+renderSection renderSectionData extraFieldsStart extraFieldsEnd Section{..} = addVerbatim sectionVerbatim $+     extraFieldsStart+  ++ renderSectionData sectionData ++ [     renderDirectories "hs-source-dirs" sectionSourceDirs   , renderDefaultExtensions sectionDefaultExtensions   , renderOtherExtensions sectionOtherExtensions@@ -308,13 +311,47 @@   ]   ++ maybe [] (return . renderBuildable) sectionBuildable   ++ map (renderConditional renderSectionData) sectionConditionals+  ++ extraFieldsEnd +addVerbatim :: [Verbatim] -> [Element] -> [Element]+addVerbatim verbatim fields = filterVerbatim verbatim fields ++ renderVerbatim verbatim++filterVerbatim :: [Verbatim] -> [Element] -> [Element]+filterVerbatim verbatim = filter p+  where+    p :: Element -> Bool+    p = \ case+      Field name _ -> name `notElem` fields+      _ -> True+    fields = concatMap verbatimFieldNames verbatim++verbatimFieldNames :: Verbatim -> [String]+verbatimFieldNames verbatim = case verbatim of+  VerbatimLiteral _ -> []+  VerbatimObject o -> Map.keys o++renderVerbatim :: [Verbatim] -> [Element]+renderVerbatim = concatMap $ \ case+  VerbatimLiteral s -> [Verbatim s]+  VerbatimObject o -> renderVerbatimObject o++renderVerbatimObject :: Map String VerbatimValue -> [Element]+renderVerbatimObject = map renderPair . Map.toList+  where+    renderPair (key, value) = case value of+      VerbatimString s -> case lines s of+        [x] -> Field key (Literal x)+        xs -> Field key (LineSeparatedList xs)+      VerbatimNumber n -> Field key (Literal $ scientificToVersion n)+      VerbatimBool b -> Field key (Literal $ show b)+      VerbatimNull -> Field key (Literal "")+ renderConditional :: (a -> [Element]) -> Conditional (Section a) -> Element renderConditional renderSectionData (Conditional condition sect mElse) = case mElse of   Nothing -> if_-  Just else_ -> Group if_ (Stanza "else" $ renderSection renderSectionData else_)+  Just else_ -> Group if_ (Stanza "else" $ renderSection renderSectionData [] [] else_)   where-    if_ = Stanza ("if " ++ condition) (renderSection renderSectionData sect)+    if_ = Stanza ("if " ++ condition) (renderSection renderSectionData [] [] sect)  defaultLanguage :: Element defaultLanguage = Field "default-language" "Haskell2010"

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

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

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

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

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

@@ -1,12 +1,6 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Hpack.Util (-  List(..)-, fromMaybeList-, GhcOption+  GhcOption , GhcProfOption , GhcjsOption , CppOption@@ -25,7 +19,6 @@  import           Control.Exception import           Control.Monad-import           Data.Aeson.Types import           Data.Char import           Data.List hiding (sort) import           Data.Ord@@ -44,17 +37,6 @@  lexicographically :: String -> (String, String) lexicographically x = (map toLower x, x)--newtype List a = List {fromList :: [a]}-  deriving (Eq, Show, Functor, Foldable, Traversable, Monoid)--instance FromJSON a => FromJSON (List a) where-  parseJSON v = List <$> case v of-    Array _ -> parseJSON v-    _ -> return <$> parseJSON v--fromMaybeList :: Maybe (List a) -> [a]-fromMaybeList = maybe [] fromList  type GhcOption = String type GhcProfOption = String

@@ -4,7 +4,7 @@ import           Data.Yaml hiding (decodeFile, decodeFileEither) import           Data.Yaml.Include -decodeYaml :: FromJSON a => FilePath -> IO (Either String a)+decodeYaml :: FilePath -> IO (Either String Value) decodeYaml file = do   result <- decodeFileEither file   return $ either (Left . errToString) Right result

@@ -0,0 +1,123 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}+module Data.Aeson.Config.FromValueSpec where++import           Helper++import           GHC.Generics+import qualified Data.Map.Lazy as Map++import           Data.Aeson.Config.FromValue++shouldDecodeTo :: (HasCallStack, Eq a, Show a, FromValue a) => Value -> DecodeResult a -> Expectation+shouldDecodeTo value expected = decodeValue value `shouldBe` expected++shouldDecodeTo_ :: (HasCallStack, Eq a, Show a, FromValue a) => Value -> a -> Expectation+shouldDecodeTo_ value expected = decodeValue value `shouldBe` Right (expected, [])++data Person = Person {+  personName :: String+, personAge :: Int+, personAddress :: Maybe Address+} deriving (Eq, Show, Generic, FromValue)++data Address = Address {+  addressRegion :: String+, addressZip :: String+} deriving (Eq, Show, Generic, FromValue)++data Job = Job {+  jobRole :: String+, jobSalary :: Int+} deriving (Eq, Show, Generic, FromValue)++spec :: Spec+spec = do+  describe "fromValue" $ do+    context "with a record" $ do+      let+        left :: String -> DecodeResult Person+        left = Left+      it "decodes a record" $ do+        [yaml|+        name: "Joe"+        age: 23+        |] `shouldDecodeTo_` Person "Joe" 23 Nothing++      it "captures unrecognized fields" $ do+        [yaml|+        name: "Joe"+        age: 23+        foo: bar+        |] `shouldDecodeTo` Right (Person "Joe" 23 Nothing, ["$.foo"])++      it "captures nested unrecognized fields" $ do+        [yaml|+        name: "Joe"+        age: 23+        address:+          region: somewhere+          zip: "123456"+          foo:+            bar: 23+        |] `shouldDecodeTo` Right (Person "Joe" 23 (Just (Address "somewhere" "123456")), ["$.address.foo"])++      it "ignores fields that start with an underscore" $ do+        [yaml|+        name: "Joe"+        age: 23+        address:+          region: somewhere+          zip: "123456"+          _foo:+            bar: 23+        |] `shouldDecodeTo_` Person "Joe" 23 (Just (Address "somewhere" "123456"))++      it "fails on missing field" $ do+        [yaml|+        name: "Joe"+        |] `shouldDecodeTo` left "Error while parsing $ - key \"age\" not present"++      it "fails on invalid field value" $ do+        [yaml|+        name: "Joe"+        age: "23"+        |] `shouldDecodeTo` left "Error while parsing $.age - expected Int, encountered String"++    context "with (,)" $ do+      it "captures unrecognized fields" $ do+        [yaml|+        name: Joe+        age: 23+        role: engineer+        salary: 100000+        foo: bar+        |] `shouldDecodeTo` Right ((Person "Joe" 23 Nothing, Job "engineer" 100000), ["$.foo"])++    context "with []" $ do+      it "captures unrecognized fields" $ do+        let+          expected = [Person "Joe" 23 (Just (Address "somewhere" "123456")), Person "Marry" 25 Nothing]+        [yaml|+        - name: "Joe"+          age: 23+          address:+            region: somewhere+            zip: "123456"+            foo: 23+        - name: "Marry"+          age: 25+          bar: 42+        |] `shouldDecodeTo` Right (expected, ["$[1].bar", "$[0].address.foo"])++    context "with Map" $ do+      it "captures unrecognized fields" $ do+        [yaml|+        Joe:+          region: somewhere+          zip: '123456'+          foo: bar+        |] `shouldDecodeTo` Right (Map.fromList [("Joe", Address "somewhere" "123456")], ["$.Joe.foo"])

@@ -0,0 +1,36 @@+{-# LANGUAGE QuasiQuotes #-}+module Data.Aeson.Config.TypesSpec (spec) where++import           Helper+import           Data.Aeson.Config.FromValueSpec (shouldDecodeTo, shouldDecodeTo_)++import           Data.Aeson.Config.FromValue+import           Data.Aeson.Config.Types++spec :: Spec+spec = do+  describe "fromValue" $ do+    context "List" $ do+      let+        parseError :: String -> DecodeResult (List Int)+        parseError prefix = Left (prefix ++ " - expected Int, encountered String")++      context "when parsing single values" $ do+        it "returns the value in a singleton list" $ do+          [yaml|23|] `shouldDecodeTo_` (List [23 :: Int])++        it "returns error messages from element parsing" $ do+          [yaml|foo|] `shouldDecodeTo` parseError "Error while parsing $"++      context "when parsing a list of values" $ do+        it "returns the list" $ do+          [yaml|+          - 23+          - 42+          |] `shouldDecodeTo_` List [23, 42 :: Int]++        it "propagates parse error messages of invalid elements" $ do+          [yaml|+          - 23+          - foo+          |] `shouldDecodeTo` parseError "Error while parsing $[1]"

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

@@ -9,9 +9,9 @@ import qualified Prelude  import           Helper+import           Test.HUnit  import           System.Directory (canonicalizePath)-import           Control.Exception import           Data.Maybe import           Data.List import           Data.String.Interpolate@@ -27,6 +27,104 @@ spec :: Spec spec = around_ (inTempDirectoryNamed "foo") $ do   describe "hpack" $ do+    it "ignores fields that start with an underscore" $ do+      [i|+      _foo:+        bar: 23+      library: {}+      |] `shouldRenderTo` library [i|+      other-modules:+          Paths_foo+      |]++    describe "github" $ do+      it "accepts owner/repo" $ do+        [i|+        github: hspec/hspec+        |] `shouldRenderTo` package [i|+        homepage: https://github.com/hspec/hspec#readme+        bug-reports: https://github.com/hspec/hspec/issues+        source-repository head+          type: git+          location: https://github.com/hspec/hspec+        |]++      it "accepts owner/repo/path" $ do+        [i|+        github: hspec/hspec/hspec-core+        |] `shouldRenderTo` package [i|+        homepage: https://github.com/hspec/hspec#readme+        bug-reports: https://github.com/hspec/hspec/issues+        source-repository head+          type: git+          location: https://github.com/hspec/hspec+          subdir: hspec-core+        |]++    describe "homepage" $ do+      it "accepts homepage URL" $ do+        [i|+        homepage: https://example.com/+        |] `shouldRenderTo` package [i|+        homepage: https://example.com/+        |]++      context "with github" $ do+        it "gives homepage URL precedence" $ do+          [i|+          github: hspec/hspec+          homepage: https://example.com/+          |] `shouldRenderTo` package [i|+          homepage: https://example.com/+          bug-reports: https://github.com/hspec/hspec/issues+          source-repository head+            type: git+            location: https://github.com/hspec/hspec+          |]++        it "omits homepage URL if it is null" $ do+          [i|+          github: hspec/hspec+          homepage: null+          |] `shouldRenderTo` package [i|+          bug-reports: https://github.com/hspec/hspec/issues+          source-repository head+            type: git+            location: https://github.com/hspec/hspec+          |]++    describe "bug-reports" $ do+      it "accepts bug-reports URL" $ do+        [i|+        bug-reports: https://example.com/+        |] `shouldRenderTo` package [i|+        bug-reports: https://example.com/+        |]++      context "with github" $ do+        it "gives bug-reports URL precedence" $ do+          [i|+          github: hspec/hspec+          bug-reports: https://example.com/+          |] `shouldRenderTo` package [i|+          homepage: https://github.com/hspec/hspec#readme+          bug-reports: https://example.com/+          source-repository head+            type: git+            location: https://github.com/hspec/hspec+          |]++        it "omits bug-reports URL if it is null" $ do+          [i|+          github: hspec/hspec+          bug-reports: null+          |] `shouldRenderTo` package [i|+          homepage: https://github.com/hspec/hspec#readme+          source-repository head+            type: git+            location: https://github.com/hspec/hspec+          |]+     describe "defaults" $ do       it "accepts global defaults" $ do         writeFile "defaults/sol/hpack-template/2017/defaults.yaml" [i|@@ -116,24 +214,68 @@           path: defaults.yaml           ref: "2017"         library: {}-        |] `shouldFailWith` (file ++ ": Error in $: expected record (:*:), encountered Array")+        |] `shouldFailWith` (file ++ ": Error while parsing $ - expected Object, encountered Array")        it "warns on unknown fields" $ do         let file = joinPath ["defaults", "sol", "hpack-template", "2017", "defaults.yaml"]         writeFile file "foo: bar"         [i|+        name: foo         defaults:           github: sol/hpack-template           path: defaults.yaml           ref: "2017"           bar: baz-        name: foo         library: {}         |] `shouldWarn` [-            "Ignoring unknown field \"bar\" in defaults section"-          , "Ignoring unknown field \"foo\" in " ++ file+            "package.yaml: Ignoring unrecognized field $.defaults.bar"+          , file ++ ": Ignoring unrecognized field $.foo"           ] +    describe "version" $ do+      it "accepts string" $ do+        [i|+        version: 0.1.0+        |] `shouldRenderTo` (package "") {packageVersion = "0.1.0"}++      it "accepts number" $ do+        [i|+        version: 0.1+        |] `shouldRenderTo` (package [i|+        |]) {packageVersion = "0.1"}++      it "rejects other values" $ do+        [i|+        version: {}+        |] `shouldFailWith` "package.yaml: Error while parsing $.version - expected Number or String, encountered Object"++    describe "build-type" $ do+      it "accept Simple" $ do+        [i|+        build-type: Simple+        |] `shouldRenderTo` (package "") {packageBuildType = "Simple"}++      it "accept Configure" $ do+        [i|+        build-type: Configure+        |] `shouldRenderTo` (package "") {packageBuildType = "Configure"}++      it "accept Make" $ do+        [i|+        build-type: Make+        |] `shouldRenderTo` (package "") {packageBuildType = "Make"}++      it "accept Custom" $ do+        [i|+        build-type: Custom+        |] `shouldRenderTo` (package "") {packageBuildType = "Custom"}++      it "rejects invalid values" $ do+        [i|+        build-type: foo+        |] `shouldFailWith` "package.yaml: Error while parsing $.build-type - expected one of Simple, Configure, Make, or Custom"++     describe "extra-doc-files" $ do       it "accepts a list of files" $ do         touch "CHANGES.markdown"@@ -403,8 +545,8 @@           foo: 1           bar: 2         |] `shouldWarn` [-            "Ignoring unknown field \"bar\" in custom-setup section"-          , "Ignoring unknown field \"foo\" in custom-setup section"+            "package.yaml: Ignoring unrecognized field $.custom-setup.bar"+          , "package.yaml: Ignoring unrecognized field $.custom-setup.foo"           ]        it "accepts dependencies" $ do@@ -684,7 +826,7 @@         internal-libraries:           bar:             baz: 42-        |] `shouldWarn` pure "Ignoring unknown field \"baz\" in internal-libraries section \"bar\""+        |] `shouldWarn` pure "package.yaml: Ignoring unrecognized field $.internal-libraries.bar.baz"        it "warns on missing source-dirs" $ do         [i|@@ -866,10 +1008,10 @@           - condition: os(windows)             baz: 23         |] `shouldWarn` [-            "Ignoring unknown field \"foo\" in package description"-          , "Ignoring unknown field \"bar\" in package description"-          , "Ignoring unknown field \"bar2\" in package description"-          , "Ignoring unknown field \"baz\" in package description"+            "package.yaml: Ignoring unrecognized field $.foo"+          , "package.yaml: Ignoring unrecognized field $.when[0].bar"+          , "package.yaml: Ignoring unrecognized field $.when[0].when.bar2"+          , "package.yaml: Ignoring unrecognized field $.when[1].baz"           ]        context "when parsing conditionals with else-branch" $ do@@ -898,8 +1040,15 @@             then:               dependencies: Win32             else: null-          |] `shouldFailWith` "package.yaml: Error in $.when.else: expected record (:*:), encountered Null"+          |] `shouldFailWith` "package.yaml: Error while parsing $.when.else - expected Object, encountered Null" +        it "rejects invalid conditionals" $ do+          [i|+            dependencies:+              - foo+              - 23+          |] `shouldFailWith` "package.yaml: Error while parsing $.dependencies[1] - expected Object or String, encountered Number"+         it "warns on unknown fields" $ do           [i|           name: foo@@ -915,14 +1064,105 @@                 else:                   baz: null           |] `shouldWarn` [-              "Ignoring unknown field \"foo\" in package description"-            , "Ignoring unknown field \"bar\" in package description"-            , "Ignoring unknown field \"baz\" in package description"+              "package.yaml: Ignoring unrecognized field $.when.foo"+            , "package.yaml: Ignoring unrecognized field $.when.then.bar"+            , "package.yaml: Ignoring unrecognized field $.when.else.when.else.baz"             ] -run :: FilePath -> String -> IO ([String], String)-run c old = run_ c old >>= either (throwIO . ErrorCall) return+    describe "verbatim" $ do+      it "accepts strings" $ do+        [i|+        library:+          verbatim: |+            foo: 23+            bar: 42+        |] `shouldRenderTo` package [i|+        library+          other-modules:+              Paths_foo+          default-language: Haskell2010+          foo: 23+          bar: 42+        |] +      it "accepts multi-line strings as field values" $ do+        [i|+        library:+          verbatim:+            build-depneds: |+              foo+              bar+              baz+        |] `shouldRenderTo` package [i|+        library+          other-modules:+              Paths_foo+          default-language: Haskell2010+          build-depneds:+              foo+              bar+              baz+        |]++      it "allows to null out existing fields" $ do+        [i|+        library:+          verbatim:+            default-language: null+        |] `shouldRenderTo` package [i|+        library+          other-modules:+              Paths_foo+        |]++      context "when specified globally" $ do+        it "overrides header fields" $ do+          [i|+          verbatim:+            cabal-version: ">= 2.0"+          |] `shouldRenderTo` (package "") {packageCabalVersion = ">= 2.0"}++        it "overrides other fields" $ do+          touch "foo"+          [i|+          extra-source-files: foo+          verbatim:+            extra-source-files: bar+          |] `shouldRenderTo` package [i|+          extra-source-files: bar+          |]++        it "is not propagated into sections" $ do+          [i|+          verbatim:+            foo: 23+          library: {}+          |] `shouldRenderTo` package [i|+          library+            other-modules:+                Paths_foo+            default-language: Haskell2010+          foo: 23+          |]++      context "within a section" $ do+        it "overrides section fields" $ do+          [i|+          tests:+            spec:+              verbatim:+                type: detailed-0.9+          |] `shouldRenderTo` package [i|+          test-suite spec+            type: detailed-0.9+            other-modules:+                Paths_foo+            default-language: Haskell2010+          |]++run :: HasCallStack => FilePath -> String -> IO ([String], String)+run c old = run_ c old >>= either assertFailure return+ run_ :: FilePath -> String -> IO (Either String ([String], String)) run_ c old = do   mPackage <- readPackageConfig "" c@@ -937,17 +1177,17 @@         Right (warnings, output)     Left err -> Left err -newtype PlainString = PlainString String+data RenderResult = RenderResult [String] String   deriving Eq -instance Show PlainString where-  show (PlainString xs) = xs+instance Show RenderResult where+  show (RenderResult warnings output) = unlines (map ("WARNING in " ++) warnings) ++ output  shouldRenderTo :: HasCallStack => String -> Package -> Expectation shouldRenderTo input p = do-  writeFile packageConfig input-  (_ , output) <- run packageConfig expected-  PlainString (dropEmptyLines output) `shouldBe` PlainString expected+  writeFile packageConfig ("name: foo\n" ++ unindent input)+  (warnings, output) <- run packageConfig expected+  RenderResult warnings (dropEmptyLines output) `shouldBe` RenderResult [] expected   where     expected = dropEmptyLines (renderPackage p)     dropEmptyLines = unlines . filter (not . null) . lines@@ -1021,10 +1261,11 @@ |]  package :: String -> Package-package = Package "foo" "Simple" ">= 1.10"+package = Package "foo" "0.0.0" "Simple" ">= 1.10"  data Package = Package {   packageName :: String+, packageVersion :: String , packageBuildType :: String , packageCabalVersion :: String , packageContent :: String@@ -1033,7 +1274,7 @@ renderPackage :: Package -> String renderPackage Package{..} = unindent [i| name: #{packageName}-version: 0.0.0+version: #{packageVersion} build-type: #{packageBuildType} cabal-version: #{packageCabalVersion} 

@@ -7,10 +7,8 @@ , withTempDirectory , module System.FilePath , withCurrentDirectory-, shouldParseAs+, yaml ) where-import           Data.Yaml-import           Data.ByteString (ByteString)  import           Test.Hspec import           Test.Mockery.Directory@@ -20,6 +18,9 @@ import qualified System.IO.Temp as Temp import           System.FilePath +import           Data.Yaml.TH (yamlQQ)+import           Language.Haskell.TH.Quote (QuasiQuoter)+ withCurrentDirectory :: FilePath -> IO a -> IO a withCurrentDirectory dir action = do   bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do@@ -30,6 +31,5 @@ withTempDirectory action = Temp.withSystemTempDirectory "hspec" $ \dir -> do   canonicalizePath dir >>= action -shouldParseAs :: (HasCallStack, Show a, Eq a, FromJSON a) => ByteString -> Either String a -> Expectation-shouldParseAs input expected = do-  decodeEither input `shouldBe` expected+yaml :: Language.Haskell.TH.Quote.QuasiQuoter+yaml = yamlQQ

@@ -4,6 +4,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Hpack.ConfigSpec (   spec@@ -13,7 +15,8 @@ ) where  import           Helper-import           Data.Aeson.Types+import           Data.Aeson.Config.FromValueSpec hiding (spec)+ import           Data.String.Interpolate.IsString import           Control.Arrow import qualified GHC.Exts as Exts@@ -21,11 +24,14 @@ import           Data.Either import qualified Data.Map.Lazy as Map -import           Hpack.Util import           Hpack.Dependency import           Hpack.Config hiding (package) import qualified Hpack.Config as Config +import           Data.Aeson.Config.Types+import           Data.Aeson.Config.FromValue++ instance Exts.IsList (Maybe (List a)) where   type Item (Maybe (List a)) = a   fromList = Just . List@@ -43,7 +49,7 @@ library :: Library library = Library Nothing [] ["Paths_foo"] [] [] [] -withPackage :: String -> IO () -> ((Package, [String]) -> Expectation) -> Expectation+withPackage :: HasCallStack => String -> IO () -> ((Package, [String]) -> Expectation) -> Expectation withPackage content beforeAction expectation = withTempDirectory $ \dir_ -> do   let dir = dir_ </> "foo"   createDirectory dir@@ -58,10 +64,10 @@ withPackageConfig_ :: String -> (Package -> Expectation) -> Expectation withPackageConfig_ content = withPackageConfig content (return ()) -withPackageWarnings :: String -> IO () -> ([String] -> Expectation) -> Expectation+withPackageWarnings :: HasCallStack => String -> IO () -> ([String] -> Expectation) -> Expectation withPackageWarnings content beforeAction expectation = withPackage content beforeAction (expectation . snd) -withPackageWarnings_ :: String -> ([String] -> Expectation) -> Expectation+withPackageWarnings_ :: HasCallStack => String -> ([String] -> Expectation) -> Expectation withPackageWarnings_ content = withPackageWarnings content (return ())  spec :: Spec@@ -150,78 +156,6 @@         getModules dir  "./." `shouldReturn` ["Foo"]    describe "readPackageConfig" $ do-    it "warns on unknown fields" $ do-      withPackageWarnings_ [i|-        name: foo-        bar: 23-        baz: 42-        _qux: 66-        |]-        (`shouldMatchList` [-          "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-        |]-        (`shouldMatchList` [-          "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-        |]-        (`shouldMatchList` [-          "Ignoring unknown field \"baz\" in package description"-        , "Ignoring unknown field \"github\" in package description"-        ]-        )--    it "warns on unknown fields in when block in library section" $ do-      withPackageWarnings_ [i|-        name: foo-        library:-          when:-            condition: impl(ghc)-            baz: 42-        |]-        (`shouldBe` [-          "Ignoring unknown field \"baz\" in library section"-        ]-        )--    it "warns on unknown fields in when block in executable section" $ do-      withPackageWarnings_ [i|-        name: foo-        executables:-          foo:-            main: Main.hs-            when:-              condition: impl(ghc)-              baz: 42-        |]-        (`shouldBe` [-          "Ignoring unknown field \"baz\" in executable section \"foo\""-        ]-        )-     it "warns on missing name" $ do       withPackageWarnings_ [i|         {}@@ -291,46 +225,6 @@         |]         (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@@ -358,33 +252,6 @@         |]         (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:@@ -395,21 +262,6 @@         |]         (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:@@ -433,18 +285,6 @@         )         (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@@ -560,19 +400,6 @@         (packageName >>> (`shouldBe` "n2"))      context "when reading library section" $ do-      it "warns on unknown fields" $ do-        withPackageWarnings_ [i|-          name: foo-          library:-            bar: 23-            baz: 42-          |]-          (`shouldMatchList` [-            "Ignoring unknown field \"bar\" in library section"-          , "Ignoring unknown field \"baz\" in library section"-          ]-          )-       it "accepts source-dirs" $ do         withPackageConfig_ [i|           library:@@ -635,21 +462,6 @@           (packageLibrary >>> (`shouldBe` Just (section library{libraryExposed = Just False})))      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-          |]-          (`shouldMatchList` [-            "Ignoring unknown field \"bar\" in executable section \"foo\""-          , "Ignoring unknown field \"baz\" in executable section \"foo\""-          ]-          )-       it "reads executables section" $ do         withPackageConfig_ [i|           executables:@@ -665,15 +477,6 @@           |]           (packageExecutables >>> (`shouldBe` Map.fromList [("foo", section $ executable "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|@@ -798,38 +601,7 @@           |]           (`shouldBe` package {packageExecutables = Map.fromList [("foo", (section $ executable "driver/Main.hs") {sectionGhcProfOptions = ["-fprof-auto"]})]}) -    context "when reading benchmark section" $ do-      it "warns on unknown fields" $ do-        withPackageWarnings_ [i|-          name: foo-          benchmarks:-            foo:-              main: Main.hs-              bar: 42-              baz: 23-          |]-          (`shouldMatchList` [-            "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-          |]-          (`shouldMatchList` [-            "Ignoring unknown field \"bar\" in test section \"foo\""-          , "Ignoring unknown field \"baz\" in test section \"foo\""-          ]-          )-       it "reads test section" $ do         withPackageConfig_ [i|           tests:@@ -891,24 +663,34 @@           let file = dir </> "package.yaml"           readPackageConfig undefined file `shouldReturn` Left [i|#{file}: Yaml file not found: #{file}|] -  describe "parseJSON" $ do-    context "when parsing Cond" $ do+  describe "fromValue" $ do+    context "with Cond" $ do       it "accepts Strings" $ do-        [i|+        [yaml|         os(windows)-        |] `shouldParseAs` Right (Cond "os(windows)")+        |] `shouldDecodeTo_` Cond "os(windows)"        it "accepts True" $ do-        [i|+        [yaml|         yes-        |] `shouldParseAs` Right (Cond "true")+        |] `shouldDecodeTo_` Cond "true"        it "accepts False" $ do-        [i|+        [yaml|         no-        |] `shouldParseAs` Right (Cond "false")+        |] `shouldDecodeTo_` Cond "false"        it "rejects other values" $ do-        [i|+        [yaml|         23-        |] `shouldParseAs` (Left "Error in $: expected Boolean or String, encountered Number" :: Either String Cond)+        |] `shouldDecodeTo` (Left "Error while parsing $ - expected Boolean or String, encountered Number" :: DecodeResult Cond)++  describe "formatOrList" $ do+    it "formats a singleton list" $ do+      formatOrList ["foo"] `shouldBe` "foo"++    it "formats a 2-element list" $ do+      formatOrList ["foo", "bar"] `shouldBe` "foo or bar"++    it "formats an n-element list" $ do+      formatOrList ["foo", "bar", "baz"] `shouldBe` "foo, bar, or baz"

@@ -6,164 +6,164 @@  import           Helper -import           Data.String.Interpolate.IsString-import           Data.ByteString (ByteString)+import           Data.Aeson.Config.FromValueSpec (shouldDecodeTo, shouldDecodeTo_) +import           Data.Aeson.Config.FromValue import           Hpack.Dependency -parsesAs :: HasCallStack => ByteString -> Either String Dependencies -> Expectation-parsesAs = shouldParseAs+left :: String -> DecodeResult Dependencies+left = Left  spec :: Spec spec = do-  describe "parseJSON" $ do+  describe "fromValue" $ do     context "when parsing Dependencies" $ do       context "with a scalar" $ do         it "accepts dependencies without constraints" $ do-          [i|+          [yaml|             hpack-          |] `parsesAs` Right [("hpack", AnyVersion)]+          |] `shouldDecodeTo_` Dependencies [("hpack", AnyVersion)]          it "accepts dependencies with constraints" $ do-          [i|+          [yaml|             hpack >= 2 && < 3-          |] `parsesAs` Right [("hpack", VersionRange ">=2 && <3")]+          |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange ">=2 && <3")]          context "with invalid constraint" $ do           it "returns an error message" $ do-            [i|+            [yaml|               hpack ==-            |] `parsesAs` Left "Error in $: invalid dependency \"hpack ==\""+            |] `shouldDecodeTo` left "Error while parsing $ - invalid dependency \"hpack ==\""        context "with a list" $ do         it "accepts dependencies without constraints" $ do-          [i|+          [yaml|             - hpack-          |] `parsesAs` Right [("hpack", AnyVersion)]+          |] `shouldDecodeTo_` Dependencies [("hpack", AnyVersion)]          it "accepts dependencies with constraints" $ do-          [i|+          [yaml|             - hpack >= 2 && < 3-          |] `parsesAs` Right [("hpack", VersionRange ">=2 && <3")]+          |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange ">=2 && <3")]          it "accepts git dependencies" $ do           let source = GitRef "https://github.com/sol/hpack" "master" Nothing-          [i|+          [yaml|             - name: hpack               git: https://github.com/sol/hpack               ref: master-          |] `parsesAs` Right [("hpack", SourceDependency source)]+          |] `shouldDecodeTo_` Dependencies [("hpack", SourceDependency source)]          it "accepts github dependencies" $ do           let source = GitRef "https://github.com/sol/hpack" "master" Nothing-          [i|+          [yaml|             - name: hpack               github: sol/hpack               ref: master-          |] `parsesAs` Right [("hpack", SourceDependency source)]+          |] `shouldDecodeTo_` Dependencies [("hpack", SourceDependency source)]          it "accepts an optional subdirectory for git dependencies" $ do           let source = GitRef "https://github.com/yesodweb/wai" "master" (Just "warp")-          [i|+          [yaml|             - name: warp               github: yesodweb/wai               ref: master               subdir: warp-          |] `parsesAs` Right [("warp", SourceDependency source)]+          |] `shouldDecodeTo_` Dependencies [("warp", SourceDependency source)]          it "accepts local dependencies" $ do           let source = Local "../hpack"-          [i|+          [yaml|             - name: hpack               path: ../hpack-          |] `parsesAs` Right [("hpack", SourceDependency source)]+          |] `shouldDecodeTo_` Dependencies [("hpack", SourceDependency source)]          context "when ref is missing" $ do           it "produces accurate error messages" $ do-            [i|+            [yaml|               - name: hpack                 git: sol/hpack                 ef: master-            |] `parsesAs` Left "Error in $[0]: key \"ref\" not present"+            |] `shouldDecodeTo` left "Error while parsing $[0] - key \"ref\" not present"          context "when both git and github are missing" $ do           it "produces accurate error messages" $ do-            [i|+            [yaml|               - name: hpack                 gi: sol/hpack                 ref: master-            |] `parsesAs` Left "Error in $[0]: neither key \"git\" nor key \"github\" present"+            |] `shouldDecodeTo` left "Error while parsing $[0] - neither key \"git\" nor key \"github\" present"        context "with a mapping from dependency names to constraints" $ do         it "accepts dependencies without constraints" $ do-          [i|+          [yaml|             array:-          |] `parsesAs` Right [("array", AnyVersion)]+          |] `shouldDecodeTo_` Dependencies [("array", AnyVersion)]          it "rejects invalid values" $ do-          [i|+          [yaml|             hpack: []-          |] `parsesAs` Left "Error in $.hpack: expected Null, Object, Number, or String, encountered Array"+          |] `shouldDecodeTo` left "Error while parsing $.hpack - expected Null, Object, Number, or String, encountered Array"          context "when the constraint is a Number" $ do           it "accepts 1" $ do-            [i|+            [yaml|               hpack: 1-            |] `parsesAs` Right [("hpack", VersionRange "==1")]+            |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange "==1")]            it "accepts 1.0" $ do-            [i|+            [yaml|               hpack: 1.0-            |] `parsesAs` Right [("hpack", VersionRange "==1.0")]+            |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange "==1.0")]            it "accepts 0.11" $ do-            [i|+            [yaml|               hpack: 0.11-            |] `parsesAs` Right [("hpack", VersionRange "==0.11")]+            |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange "==0.11")]            it "accepts 0.110" $ do-            [i|+            [yaml|               hpack: 0.110-            |] `parsesAs` Right [("hpack", VersionRange "==0.110")]+            |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange "==0.110")]            it "accepts 1e2" $ do-            [i|+            [yaml|               hpack: 1e2-            |] `parsesAs` Right [("hpack", VersionRange "==100")]+            |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange "==100")]          context "when the constraint is a String" $ do           it "accepts version ranges" $ do-            [i|+            [yaml|               hpack: '>=2'-            |] `parsesAs` Right [("hpack", VersionRange ">=2")]+            |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange ">=2")]            it "accepts specific versions" $ do-            [i|+            [yaml|               hpack: 0.10.8.2-            |] `parsesAs` Right [("hpack", VersionRange "==0.10.8.2")]+            |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange "==0.10.8.2")]            it "accepts wildcard versions" $ do-            [i|+            [yaml|               hpack: 2.*-            |] `parsesAs` Right [("hpack", VersionRange "==2.*")]+            |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange "==2.*")]            it "reports parse errors" $ do-            [i|+            [yaml|               hpack: foo-            |] `parsesAs` Left "Error in $.hpack: invalid constraint \"foo\""+            |] `shouldDecodeTo` left "Error while parsing $.hpack - invalid constraint \"foo\""          context "when the constraint is an Object" $ do           it "accepts github dependencies" $ do-            [i|+            [yaml|               Cabal:                 github: haskell/cabal                 ref: d53b6e0d908dfedfdf4337b2935519fb1d689e76                 subdir: Cabal-            |] `parsesAs` Right [("Cabal", SourceDependency (GitRef "https://github.com/haskell/cabal" "d53b6e0d908dfedfdf4337b2935519fb1d689e76" (Just "Cabal")))]+            |] `shouldDecodeTo_` Dependencies [("Cabal", SourceDependency (GitRef "https://github.com/haskell/cabal" "d53b6e0d908dfedfdf4337b2935519fb1d689e76" (Just "Cabal")))]            it "ignores names in nested hashes" $ do-            [i|+            [yaml|               outer-name:                 name: inner-name                 path: somewhere-            |] `parsesAs` Right [("outer-name", SourceDependency (Local "somewhere"))]+            |] `shouldDecodeTo` Right (Dependencies [("outer-name", SourceDependency (Local "somewhere"))], ["$.outer-name.name"])

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

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

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

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

@@ -1,9 +1,5 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-} module Hpack.UtilSpec (main, spec) where -import           Data.Aeson-import           Data.Aeson.Types import           Helper import           System.Directory @@ -68,25 +64,6 @@         inTempDirectory $ do           touch "foo/bar/baz"           getModuleFilesRecursive "foo" `shouldReturn` empty--  describe "List" $ do-    let-      parseError :: String -> Either String (List Int)-      parseError prefix = Left (prefix ++ ": expected Int, encountered String")--    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 (String "foo") `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 [Number 23, String "foo"]) `shouldBe` parseError "Error in $[1]"    describe "tryReadFile" $ do     it "reads file" $ do