packages feed

hpack 0.11.2 → 0.12.0

raw patch · 14 files changed

+605/−287 lines, 14 filesdep +QuickCheck

Dependencies added: QuickCheck

Files

LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2014 Simon Hengel <sol@typeful.net>+Copyright (c) 2014-2016 Simon Hengel <sol@typeful.net>  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal
hpack.cabal view
@@ -1,9 +1,9 @@--- This file has been generated from package.yaml by hpack version 0.11.0.+-- This file has been generated from package.yaml by hpack version 0.11.2. -- -- see: https://github.com/sol/hpack  name:           hpack-version:        0.11.2+version:        0.12.0 synopsis:       An alternative format for Haskell packages category:       Development homepage:       https://github.com/sol/hpack#readme@@ -40,6 +40,7 @@       Hpack.Run       Hpack.Yaml   other-modules:+      Hpack.FormattingHints       Hpack.GenericsUtil       Hpack.Haskell       Hpack.Render@@ -87,6 +88,7 @@     , unordered-containers     , yaml     , hspec == 2.*+    , QuickCheck     , temporary     , mockery >= 0.3     , interpolate@@ -95,6 +97,7 @@   other-modules:       Helper       Hpack.ConfigSpec+      Hpack.FormattingHintsSpec       Hpack.GenericsUtilSpec       Hpack.HaskellSpec       Hpack.RenderSpec@@ -103,6 +106,7 @@       HpackSpec       Hpack       Hpack.Config+      Hpack.FormattingHints       Hpack.GenericsUtil       Hpack.Haskell       Hpack.Render
src/Hpack.hs view
@@ -4,7 +4,10 @@ , version , main #ifdef TEST+, hpackWithVersion , parseVerbosity+, extractVersion+, parseVersion #endif ) where @@ -15,22 +18,25 @@ import           Control.Exception import           Control.Monad.Compat import           Data.List.Compat-import           Data.Version (showVersion)+import           Data.Maybe+import           Data.Version (Version)+import qualified Data.Version as Version import           System.Environment import           System.Exit import           System.IO import           System.IO.Error+import           Text.ParserCombinators.ReadP  import           Paths_hpack (version) import           Hpack.Config import           Hpack.Run -programVersion :: String-programVersion = "hpack version " ++ showVersion version+programVersion :: Version -> String+programVersion v = "hpack version " ++ Version.showVersion v -header :: String-header = unlines [-    "-- This file has been generated from " ++ packageConfig ++ " by " ++ programVersion ++ "."+header :: Version -> String+header v = unlines [+    "-- This file has been generated from " ++ packageConfig ++ " by " ++ programVersion v ++ "."   , "--"   , "-- see: https://github.com/sol/hpack"   , ""@@ -40,11 +46,11 @@ main = do   args <- getArgs   case args of-    ["--version"] -> putStrLn programVersion+    ["--version"] -> putStrLn (programVersion version)     ["--help"] -> printHelp     _ -> case parseVerbosity args of       (verbose, [dir]) -> hpack dir verbose-      (verbose, []) -> hpack "." verbose+      (verbose, []) -> hpack "" verbose       _ -> do         printHelp         exitFailure@@ -63,19 +69,42 @@     verbose = not (silentFlag `elem` xs)     ys = filter (/= silentFlag) xs +safeInit :: [a] -> [a]+safeInit [] = []+safeInit xs = init xs++extractVersion :: [String] -> Maybe Version+extractVersion = listToMaybe . mapMaybe (stripPrefix prefix >=> parseVersion . safeInit)+  where+    prefix = "-- This file has been generated from package.yaml by hpack version "++parseVersion :: String -> Maybe Version+parseVersion xs = case [v | (v, "") <- readP_to_S Version.parseVersion xs] of+  [v] -> Just v+  _ -> Nothing+ hpack :: FilePath -> Bool -> IO ()-hpack dir verbose = do+hpack = hpackWithVersion version++hpackWithVersion :: Version -> FilePath -> Bool -> IO ()+hpackWithVersion v dir verbose = do   (warnings, name, new) <- run dir   forM_ warnings $ \warning -> hPutStrLn stderr ("WARNING: " ++ warning)-  old <- force . either (const Nothing) (Just . stripHeader) <$> tryJust (guard . isDoesNotExistError) (readFile name)-  if (old == Just (lines new)) then do-    output (name ++ " is up-to-date")++  old <- either (const Nothing) (Just . splitHeader) <$> tryJust (guard . isDoesNotExistError) (readFile name >>= (return $!!))+  let oldVersion = fmap fst old >>= extractVersion++  if (oldVersion <= Just v) then do+    if (fmap snd old == Just (lines new)) then do+      output (name ++ " is up-to-date")+    else do+      (writeFile name $ header v ++ new)+      output ("generated " ++ name)   else do-    (writeFile name $ header ++ new)-    output ("generated " ++ name)+    output (name ++ " was generated with a newer version of hpack, please upgrade and try again.")   where-    stripHeader :: String -> [String]-    stripHeader = dropWhile null . dropWhile ("--" `isPrefixOf`) . lines+    splitHeader :: String -> ([String], [String])+    splitHeader = fmap (dropWhile null) . span ("--" `isPrefixOf`) . lines      output :: String -> IO ()     output message
src/Hpack/Config.hs view
@@ -46,7 +46,7 @@ import           Data.Map.Lazy (Map) import qualified Data.Map.Lazy as Map import qualified Data.HashMap.Lazy as HashMap-import           Data.List (nub, (\\), sortBy)+import           Data.List.Compat (nub, (\\), sortBy) import           Data.Maybe import           Data.Ord import           Data.String@@ -313,12 +313,12 @@           name :: Parser String           name = o .: "name" -          git :: Parser AddSource-          git = GitRef <$> url <*> ref-           local :: Parser AddSource           local = Local <$> o .: "path" +          git :: Parser AddSource+          git = GitRef <$> url <*> ref <*> subdir+           url :: Parser String           url =                 ((githubBaseUrl ++) <$> o .: "github")@@ -328,7 +328,10 @@           ref :: Parser String           ref = o .: "ref" -data AddSource = GitRef GitUrl GitRef | Local FilePath+          subdir :: Parser (Maybe FilePath)+          subdir = o .:? "subdir"++data AddSource = GitRef GitUrl GitRef (Maybe FilePath) | Local FilePath   deriving (Eq, Show, Ord)  type GitUrl = String
+ src/Hpack/FormattingHints.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ViewPatterns #-}+module Hpack.FormattingHints (+  FormattingHints (..)+, sniffFormattingHints+#ifdef TEST+, extractFieldOrder+, extractSectionsFieldOrder+, breakLines+, unindent+, sniffAlignment+, splitField+, sniffIndentation+, sniffCommaStyle+#endif+) where++import           Prelude ()+import           Prelude.Compat++import           Data.Char+import           Data.Maybe+import           Data.List.Compat+import           Control.Applicative++import           Hpack.Render+-- import           Hpack.Util++data FormattingHints = FormattingHints {+  formattingHintsFieldOrder :: [String]+, formattingHintsSectionsFieldOrder :: [(String, [String])]+, formattingHintsAlignment :: Maybe Alignment+, formattingHintsRenderSettings :: RenderSettings+} deriving (Eq, Show)++sniffFormattingHints :: String -> FormattingHints+sniffFormattingHints (breakLines -> input) = FormattingHints {+  formattingHintsFieldOrder = extractFieldOrder input+, formattingHintsSectionsFieldOrder = extractSectionsFieldOrder input+, formattingHintsAlignment = sniffAlignment input+, formattingHintsRenderSettings = sniffRenderSettings input+}++breakLines :: String -> [String]+breakLines = filter (not . null) . map (reverse . dropWhile isSpace . reverse) . lines++extractFieldOrder :: [String] -> [String]+extractFieldOrder = map fst . catMaybes . map splitField++extractSectionsFieldOrder :: [String] -> [(String, [String])]+extractSectionsFieldOrder = map (fmap extractFieldOrder) . splitSections+  where+    splitSections input = case break startsWithSpace input of+      ([], []) -> []+      (xs, ys) -> case span startsWithSpace ys of+        (fields, zs) -> case reverse xs of+          name : _ -> (name, unindent fields) : splitSections zs+          _ -> splitSections zs++    startsWithSpace :: String -> Bool+    startsWithSpace xs = case xs of+      y : _ -> isSpace y+      _ -> False++unindent :: [String] -> [String]+unindent input = map (drop indentation) input+  where+    indentation = minimum $ map (length . takeWhile isSpace) input++sniffAlignment :: [String] -> Maybe Alignment+sniffAlignment input = case nub . catMaybes . map indentation . catMaybes . map splitField $ input of+  [n] -> Just (Alignment n)+  _ -> Nothing+  where++    indentation :: (String, String) -> Maybe Int+    indentation (name, value) = case span isSpace value of+      (_, "") -> Nothing+      (xs, _) -> (Just . succ . length $ name ++ xs)++splitField :: String -> Maybe (String, String)+splitField field = case span isNameChar field of+  (xs, ':':ys) -> Just (xs, ys)+  _ -> Nothing+  where+    isNameChar = (`elem` nameChars)+    nameChars = ['a'..'z'] ++ ['A'..'Z'] ++ "-"++sniffIndentation :: [String] -> Maybe Int+sniffIndentation input = sniffFrom "library" <|> sniffFrom "executable"+  where+    sniffFrom :: String -> Maybe Int+    sniffFrom section = case findSection . removeEmptyLines $ input of+      _ : x : _ -> Just . length $ takeWhile isSpace x+      _ -> Nothing+      where+        findSection = dropWhile (not . isPrefixOf section)++    removeEmptyLines :: [String] -> [String]+    removeEmptyLines = filter $ any (not . isSpace)++sniffCommaStyle :: [String] -> Maybe CommaStyle+sniffCommaStyle input+  | any startsWithComma input = Just LeadingCommas+  | any (startsWithComma . reverse) input = Just TrailingCommas+  | otherwise = Nothing+  where+    startsWithComma = isPrefixOf "," . dropWhile isSpace++sniffRenderSettings :: [String] -> RenderSettings+sniffRenderSettings input = RenderSettings indentation fieldAlignment commaStyle+  where+    indentation = fromMaybe (renderSettingsIndentation defaultRenderSettings) (sniffIndentation input)+    fieldAlignment = renderSettingsFieldAlignment defaultRenderSettings+    commaStyle = fromMaybe (renderSettingsCommaStyle defaultRenderSettings) (sniffCommaStyle input)
src/Hpack/Render.hs view
@@ -1,15 +1,34 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ViewPatterns #-}-module Hpack.Render where+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Hpack.Render (+-- * AST+  Element (..)+, Value (..) +-- * Render+, RenderSettings (..)+, CommaStyle (..)+, defaultRenderSettings+, Alignment (..)+, Nesting+, render++-- * Utils+, sortFieldsBy++#ifdef TEST+, Lines (..)+, renderValue+, addSortKey+#endif+) where+ import           Prelude () import           Prelude.Compat -import           Control.Applicative-import           Data.Char-import           Data.List.Compat-import           Data.Maybe import           Data.String+import           Data.List.Compat  data Value =     Literal String@@ -18,7 +37,7 @@   | WordList [String]   deriving (Eq, Show) -data Element = Stanza String [Element] | Field String Value+data Element = Stanza String [Element] | Group Element Element | Field String Value   deriving (Eq, Show)  data Lines = SingleLine String | MultipleLines [String]@@ -27,24 +46,38 @@ data CommaStyle = LeadingCommas | TrailingCommas   deriving (Eq, Show) +newtype Nesting = Nesting Int+  deriving (Eq, Show, Num, Enum)++newtype Alignment = Alignment Int+  deriving (Eq, Show, Num)+ data RenderSettings = RenderSettings {   renderSettingsIndentation :: Int+, renderSettingsFieldAlignment :: Alignment , renderSettingsCommaStyle :: CommaStyle } deriving (Eq, Show)  defaultRenderSettings :: RenderSettings-defaultRenderSettings = RenderSettings 2 LeadingCommas+defaultRenderSettings = RenderSettings 2 0 LeadingCommas -render :: RenderSettings -> Int -> Element -> [String]-render settings nesting (Stanza name elements) = indent settings nesting name : renderElements elements-  where-    renderElements :: [Element] -> [String]-    renderElements = concatMap (render settings $ succ nesting)-render settings nesting (Field name v) = case renderValue settings v of+render :: RenderSettings -> Nesting -> Element -> [String]+render settings nesting (Stanza name elements) = indent settings nesting name : renderElements settings (succ nesting) elements+render settings nesting (Group a b) = render settings nesting a ++ render settings nesting b+render settings nesting (Field name value) = renderField settings nesting name value++renderElements :: RenderSettings -> Nesting -> [Element] -> [String]+renderElements settings nesting = concatMap (render settings nesting)++renderField :: RenderSettings -> Nesting -> String -> Value -> [String]+renderField settings@RenderSettings{..} nesting name value = case renderValue settings value of   SingleLine "" -> []-  SingleLine x -> [indent settings nesting (name ++ ": " ++ x)]+  SingleLine x -> [indent settings nesting (name ++ ": " ++ padding ++ x)]   MultipleLines [] -> []   MultipleLines xs -> (indent settings nesting name ++ ":") : map (indent settings $ succ nesting) xs+  where+    Alignment fieldAlignment = renderSettingsFieldAlignment+    padding = replicate (fieldAlignment - length name - 2) ' '  renderValue :: RenderSettings -> Value -> Lines renderValue RenderSettings{..} v = case v of@@ -78,32 +111,25 @@ instance IsString Value where   fromString = Literal -indent :: RenderSettings -> Int -> String -> String-indent RenderSettings{..} nesting s = replicate (nesting * renderSettingsIndentation) ' ' ++ s--sniffIndentation :: String -> Maybe Int-sniffIndentation input = sniffFrom "library" <|> sniffFrom "executable"-  where-    sniffFrom :: String -> Maybe Int-    sniffFrom section = case findSection . removeEmptyLines $ lines input of-      _ : x : _ -> Just . length $ takeWhile isSpace x-      _ -> Nothing-      where-        findSection = dropWhile (not . isPrefixOf section)--    removeEmptyLines :: [String] -> [String]-    removeEmptyLines = filter $ any (not . isSpace)+indent :: RenderSettings -> Nesting -> String -> String+indent RenderSettings{..} (Nesting nesting) s = replicate (nesting * renderSettingsIndentation) ' ' ++ s -sniffCommaStyle :: String -> Maybe CommaStyle-sniffCommaStyle (lines -> input)-  | any startsWithComma input = Just LeadingCommas-  | any (startsWithComma . reverse) input = Just TrailingCommas-  | otherwise = Nothing+sortFieldsBy :: [String] -> [Element] -> [Element]+sortFieldsBy existingFieldOrder =+    map snd+  . sortOn fst+  . addSortKey+  . map (\a -> (existingIndex a, a))   where-    startsWithComma = isPrefixOf "," . dropWhile isSpace+    existingIndex :: Element -> Maybe Int+    existingIndex (Field name _) = name `elemIndex` existingFieldOrder+    existingIndex _ = Nothing -sniffRenderSettings :: String -> RenderSettings-sniffRenderSettings input = RenderSettings indentation trailingCommas+addSortKey :: [(Maybe Int, a)] -> [((Int, Int), a)]+addSortKey = go (-1) . zip [0..]   where-    indentation = fromMaybe (renderSettingsIndentation defaultRenderSettings) (sniffIndentation input)-    trailingCommas = fromMaybe (renderSettingsCommaStyle defaultRenderSettings) (sniffCommaStyle input)+    go :: Int -> [(Int, (Maybe Int, a))] -> [((Int, Int), a)]+    go n xs = case xs of+      [] -> []+      (x, (Just y, a)) : ys -> ((y, x), a) : go y ys+      (x, (Nothing, a)) : ys -> ((n, x), a) : go n ys
src/Hpack/Run.hs view
@@ -7,6 +7,7 @@   run , renderPackage , RenderSettings(..)+, Alignment(..) , CommaStyle(..) , defaultRenderSettings #ifdef TEST@@ -30,6 +31,7 @@ import           Hpack.Util import           Hpack.Config import           Hpack.Render+import           Hpack.FormattingHints  run :: FilePath -> IO ([String], FilePath, String) run dir = do@@ -40,19 +42,24 @@        old <- tryReadFile cabalFile -      let alignment = fromMaybe 16 (old >>= sniffAlignment)-          settings = maybe defaultRenderSettings sniffRenderSettings old-          output = renderPackage settings alignment (maybe [] extractFieldOrderHint old) pkg+      let+        FormattingHints{..} = sniffFormattingHints (fromMaybe "" old)+        alignment = fromMaybe 16 formattingHintsAlignment+        settings = formattingHintsRenderSettings++        output = renderPackage settings alignment formattingHintsFieldOrder formattingHintsSectionsFieldOrder pkg+       return (warnings, cabalFile, output)     Left err -> die err -renderPackage :: RenderSettings -> Int -> [String] -> Package -> String-renderPackage settings alignment existingFieldOrder Package{..} = intercalate "\n" (header : chunks)+renderPackage :: RenderSettings -> Alignment -> [String] -> [(String, [String])] -> Package -> String+renderPackage settings alignment existingFieldOrder sectionsFieldOrder Package{..} = intercalate "\n" (unlines header : chunks)   where     chunks :: [String]-    chunks = map unlines . filter (not . null) . map (render settings 0) $ stanzas+    chunks = map unlines . filter (not . null) . map (render settings 0) $ sortSectionFields sectionsFieldOrder stanzas -    header = unlines $ map formatField sortedFields+    header :: [String]+    header = concatMap (render settings {renderSettingsFieldAlignment = alignment} 0) fields      extraSourceFiles :: Element     extraSourceFiles = Field "extra-source-files" (LineSeparatedList packageExtraSourceFiles)@@ -65,41 +72,20 @@     library = maybe [] (return . renderLibrary) packageLibrary      stanzas :: [Element]-    stanzas = extraSourceFiles-            : dataFiles-            : sourceRepository-            ++ map renderFlag packageFlags-            ++ library-            ++ renderExecutables packageExecutables-            ++ renderTests packageTests-            ++ renderBenchmarks packageBenchmarks--    padding name = replicate (alignment - length name - 2) ' '--    formatField :: (String, String) -> String-    formatField (name, value) = name ++ ": " ++ padding name ++ value--    sortedFields :: [(String, String)]-    sortedFields = foldr insertByDefaultFieldOrder (sortBy orderingForExistingFields existing) new-      where-        (existing, new) = partition ((`elem` existingFieldOrder) . fst) fields--        insertByDefaultFieldOrder :: (String, a) -> [(String, a)] -> [(String, a)]-        insertByDefaultFieldOrder x@(key1, _) xs = case xs of-          [] -> [x]-          y@(key2, _) : ys -> if index key1 < index key2 then x : y : ys else y : insertByDefaultFieldOrder x ys-          where-            index :: String -> Maybe Int-            index = (`elemIndex` defaultFieldOrder)--    orderingForExistingFields :: (String, a) -> (String, a) -> Ordering-    orderingForExistingFields (key1, _) (key2, _) = index key1 `compare` index key2-      where-        index :: String -> Maybe Int-        index = (`elemIndex` existingFieldOrder)+    stanzas =+      extraSourceFiles+      : dataFiles+      : sourceRepository+      ++ concat [+        map renderFlag packageFlags+      , library+      , renderExecutables packageExecutables+      , renderTests packageTests+      , renderBenchmarks packageBenchmarks+      ] -    fields :: [(String, String)]-    fields = mapMaybe (\(name, value) -> (,) name <$> value) $ [+    fields :: [Element]+    fields = sortFieldsBy existingFieldOrder . mapMaybe (\(name, value) -> Field name . Literal <$> value) $ [         ("name", Just packageName)       , ("version", Just packageVersion)       , ("synopsis", packageSynopsis)@@ -121,10 +107,7 @@     formatList :: [String] -> Maybe String     formatList xs = guard (not $ null xs) >> (Just $ intercalate separator xs)       where-        separator = ",\n" ++ replicate alignment ' '--    defaultFieldOrder :: [String]-    defaultFieldOrder = map fst fields+        separator = let Alignment n = alignment in ",\n" ++ replicate n ' '      cabalVersion :: Maybe String     cabalVersion = maximum [@@ -138,8 +121,16 @@       hasReexportedModules :: Section Library -> Bool       hasReexportedModules = not . null . libraryReexportedModules . sectionData -formatDescription :: Int -> String -> String-formatDescription alignment description = case map emptyLineToDot $ lines description of+sortSectionFields :: [(String, [String])] -> [Element] -> [Element]+sortSectionFields sectionsFieldOrder = go+  where+    go sections = case sections of+      [] -> []+      Stanza name fields : xs | Just fieldOrder <- lookup name sectionsFieldOrder -> Stanza name (sortFieldsBy fieldOrder fields) : go xs+      x : xs -> x : go xs++formatDescription :: Alignment -> String -> String+formatDescription (Alignment alignment) description = case map emptyLineToDot $ lines description of   x : xs -> intercalate "\n" (x : map (indentation ++) xs)   [] -> ""   where@@ -224,12 +215,14 @@   , renderDependencies sectionDependencies   ]   ++ maybe [] (return . renderBuildable) sectionBuildable-  ++ concatMap renderConditional sectionConditionals+  ++ map renderConditional sectionConditionals -renderConditional :: Conditional -> [Element]-renderConditional (Conditional condition sect mElse) = Stanza ("if " ++ condition) (renderSection sect) : else_+renderConditional :: Conditional -> Element+renderConditional (Conditional condition sect mElse) = case mElse of+  Nothing -> if_+  Just else_ -> Group if_ (Stanza "else" $ renderSection else_)   where-    else_ = maybe [] (return . Stanza "else" . renderSection) mElse+    if_ = Stanza ("if " ++ condition) (renderSection sect)  defaultLanguage :: Element defaultLanguage = Field "default-language" "Haskell2010"
src/Hpack/Util.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE CPP #-} module Hpack.Util (   List(..) , GhcOption@@ -10,25 +9,22 @@ , toModule , getFilesRecursive , tryReadFile-, sniffAlignment-, extractFieldOrderHint , expandGlobs , sort , lexicographically-#ifdef TEST-, splitField-#endif ) where +import           Prelude ()+import           Prelude.Compat+ import           Control.Applicative import           Control.DeepSeq import           Control.Exception-import           Control.Monad+import           Control.Monad.Compat import           Data.Aeson.Types import           Data.Char import           Data.Data-import           Data.List hiding (sort)-import           Data.Maybe+import           Data.List.Compat hiding (sort) import           Data.Ord import           System.Directory import           System.FilePath@@ -99,28 +95,6 @@ tryReadFile file = do   r <- try (readFile file) :: IO (Either IOException String)   return $!! either (const Nothing) Just r--extractFieldOrderHint :: String -> [String]-extractFieldOrderHint = map fst . catMaybes . map splitField . lines--sniffAlignment :: String -> Maybe Int-sniffAlignment input = case nub . catMaybes . map indentation . catMaybes . map splitField $ lines input of-  [n] -> Just n-  _ -> Nothing-  where--    indentation :: (String, String) -> Maybe Int-    indentation (name, value) = case span isSpace value of-      (_, "") -> Nothing-      (xs, _) -> (Just . succ . length $ name ++ xs)--splitField :: String -> Maybe (String, String)-splitField field = case span isNameChar field of-  (xs, ':':ys) -> Just (xs, ys)-  _ -> Nothing-  where-    isNameChar = (`elem` nameChars)-    nameChars = ['a'..'z'] ++ ['A'..'Z'] ++ "-"  toPosixFilePath :: FilePath -> FilePath toPosixFilePath = Posix.joinPath . splitDirectories
test/Hpack/ConfigSpec.hs view
@@ -193,7 +193,7 @@               git: "https://github.com/sol/hpack",               ref: "master"             }|]-            source = GitRef "https://github.com/sol/hpack" "master"+            source = GitRef "https://github.com/sol/hpack" "master" Nothing         parseEither parseJSON value `shouldBe` Right (Dependency "hpack" (Just source))        it "accepts github dependencies" $ do@@ -202,8 +202,18 @@               github: "sol/hpack",               ref: "master"             }|]-            source = GitRef "https://github.com/sol/hpack" "master"+            source = GitRef "https://github.com/sol/hpack" "master" Nothing         parseEither parseJSON value `shouldBe` Right (Dependency "hpack" (Just source))++      it "accepts an optional subdirectory for git dependencies" $ do+        let value = [aesonQQ|{+              name: "warp",+              github: "yesodweb/wai",+              ref: "master",+              subdir: "warp"+            }|]+            source = GitRef "https://github.com/yesodweb/wai" "master" (Just "warp")+        parseEither parseJSON value `shouldBe` Right (Dependency "warp" (Just source))        it "accepts local dependencies" $ do         let value = [aesonQQ|{
+ test/Hpack/FormattingHintsSpec.hs view
@@ -0,0 +1,166 @@+module Hpack.FormattingHintsSpec (spec) where++import           Test.Hspec++import           Hpack.FormattingHints+import           Hpack.Render++spec :: Spec+spec = do+  describe "extractFieldOrder" $ do+    it "extracts field order hints" $ do+      let input = [+              "name:           cabalize"+            , "version:        0.0.0"+            , "license:"+            , "license-file: "+            , "build-type:     Simple"+            , "cabal-version:  >= 1.10"+            ]+      extractFieldOrder input `shouldBe` [+              "name"+            , "version"+            , "license"+            , "license-file"+            , "build-type"+            , "cabal-version"+            ]++  describe "extractSectionsFieldOrder" $ do+    it "splits input into sections" $ do+      let input = [+              "name:           cabalize"+            , "version:        0.0.0"+            , ""+            , "library"+            , "  foo: 23"+            , "  bar: 42"+            , ""+            , "executable foo"+            , "  bar: 23"+            , "  baz: 42"+            ]+      extractSectionsFieldOrder input `shouldBe` [("library", ["foo", "bar"]), ("executable foo", ["bar", "baz"])]++  describe "breakLines" $ do+    it "breaks input into lines" $ do+      let input = unlines [+              "foo"+            , ""+            , "   "+            , "  bar  "+            , "  baz"+            ]+      breakLines input `shouldBe` [+              "foo"+            , "  bar"+            , "  baz"+            ]++  describe "unindent" $ do+    it "unindents" $ do+      let input = [+              "   foo"+            , "  bar"+            , "   baz"+            ]+      unindent input `shouldBe` [+              " foo"+            , "bar"+            , " baz"+            ]++  describe "sniffAlignment" $ do+    it "sniffs field alignment from given cabal file" $ do+      let input = [+              "name:           cabalize"+            , "version:        0.0.0"+            , "license:        MIT"+            , "license-file:   LICENSE"+            , "build-type:     Simple"+            , "cabal-version:  >= 1.10"+            ]+      sniffAlignment input `shouldBe` Just 16++    it "ignores fields without a value on the same line" $ do+      let input = [+              "name:           cabalize"+            , "version:        0.0.0"+            , "description: "+            , "  foo"+            , "  bar"+            ]+      sniffAlignment input `shouldBe` Just 16++  describe "splitField" $ do+    it "splits fields" $ do+      splitField "foo:   bar" `shouldBe` Just ("foo", "   bar")++    it "accepts fields names with dashes" $ do+      splitField "foo-bar: baz" `shouldBe` Just ("foo-bar", " baz")++    it "rejects fields names with spaces" $ do+      splitField "foo bar: baz" `shouldBe` Nothing++    it "rejects invalid fields" $ do+      splitField "foo bar" `shouldBe` Nothing++  describe "sniffIndentation" $ do+    it "sniff alignment from executable section" $ do+      let input = [+              "name: foo"+            , "version: 0.0.0"+            , ""+            , "executable foo"+            , "    build-depends: bar"+            ]+      sniffIndentation input `shouldBe` Just 4++    it "sniff alignment from library section" $ do+      let input = [+              "name: foo"+            , "version: 0.0.0"+            , ""+            , "library"+            , "    build-depends: bar"+            ]+      sniffIndentation input `shouldBe` Just 4++    it "ignores empty lines" $ do+      let input = [+              "executable foo"+            , ""+            , "    build-depends: bar"+            ]+      sniffIndentation input `shouldBe` Just 4++    it "ignores whitespace lines" $ do+      let input = [+              "executable foo"+            , "  "+            , "    build-depends: bar"+            ]+      sniffIndentation input `shouldBe` Just 4++  describe "sniffCommaStyle" $ do+    it "detects leading commas" $ do+      let input = [+              "executable foo"+            , "  build-depends:"+            , "      bar"+            , "    , baz"+            ]+      sniffCommaStyle input `shouldBe` Just LeadingCommas++    it "detects trailing commas" $ do+      let input = [+              "executable foo"+            , "  build-depends:"+            , "    bar,  "+            , "    baz"+            ]+      sniffCommaStyle input `shouldBe` Just TrailingCommas++    context "when detection fails" $ do+      it "returns Nothing" $ do+        sniffCommaStyle [] `shouldBe` Nothing
test/Hpack/RenderSpec.hs view
@@ -1,21 +1,27 @@ {-# LANGUAGE OverloadedStrings #-}- module Hpack.RenderSpec where -import Test.Hspec+import           Prelude ()+import           Prelude.Compat -import Hpack.Render+import           Test.Hspec+import           Test.QuickCheck+import           Data.List.Compat+import           Data.Maybe +import           Hpack.Render+ spec :: Spec spec = do   describe "render" $ do+    let render_ = render defaultRenderSettings 0     context "when rendering a Stanza" $ do       it "renders stanza" $ do         let stanza = Stanza "foo" [                 Field "bar" "23"               , Field "baz" "42"               ]-        render defaultRenderSettings 0 stanza `shouldBe` [+        render_ stanza `shouldBe` [             "foo"           , "  bar: 23"           , "  baz: 42"@@ -26,7 +32,7 @@                 Field "bar" "23"               , Field "baz" (WordList [])               ]-        render defaultRenderSettings 0 stanza `shouldBe` [+        render_ stanza `shouldBe` [             "foo"           , "  bar: 23"           ]@@ -44,7 +50,7 @@        it "renders nested stanzas" $ do         let input = Stanza "foo" [Field "bar" "23", Stanza "baz" [Field "qux" "42"]]-        render defaultRenderSettings 0 input `shouldBe` [+        render_ input `shouldBe` [             "foo"           , "  bar: 23"           , "  baz"@@ -64,21 +70,25 @@         context "when value is empty" $ do           it "returns an empty list" $ do             let field = Field "foo" (CommaSeparatedList [])-            render defaultRenderSettings 0 field `shouldBe` []+            render_ field `shouldBe` []        context "when rendering a SingleLine value" $ do         it "returns a single line" $ do           let field = Field "foo" (Literal "bar")-          render defaultRenderSettings 0 field `shouldBe` ["foo: bar"]+          render_ field `shouldBe` ["foo: bar"]          it "takes nesting into account" $ do           let field = Field "foo" (Literal "bar")           render defaultRenderSettings 2 field `shouldBe` ["    foo: bar"] +        it "takes alignment into account" $ do+          let field = Field "foo" (Literal "bar")+          render defaultRenderSettings {renderSettingsFieldAlignment = 10} 0 field `shouldBe` ["foo:      bar"]+         context "when value is empty" $ do           it "returns an empty list" $ do             let field = Field "foo" (Literal "")-            render defaultRenderSettings 0 field `shouldBe` []+            render_ field `shouldBe` []    describe "renderValue" $ do     it "renders WordList" $ do@@ -115,62 +125,34 @@           , "baz"           ] -  describe "sniffIndentation" $ do-    it "sniff alignment from executable section" $ do-      let input = unlines [-              "name: foo"-            , "version: 0.0.0"-            , ""-            , "executable foo"-            , "    build-depends: bar"-            ]-      sniffIndentation input `shouldBe` Just 4+  describe "sortFieldsBy" $ do+    let+      field name = Field name (Literal $ name ++ " value")+      arbitraryFieldNames = sublistOf ["foo", "bar", "baz", "qux", "foobar", "foobaz"] >>= shuffle -    it "sniff alignment from library section" $ do-      let input = unlines [-              "name: foo"-            , "version: 0.0.0"-            , ""-            , "library"-            , "    build-depends: bar"-            ]-      sniffIndentation input `shouldBe` Just 4+    it "sorts fields" $ do+      let fields = map field ["baz", "bar", "foo"]+      sortFieldsBy ["foo", "bar", "baz"] fields `shouldBe` map field ["foo", "bar", "baz"] -    it "ignores empty lines" $ do-      let input = unlines [-              "executable foo"-            , ""-            , "    build-depends: bar"-            ]-      sniffIndentation input `shouldBe` Just 4+    it "keeps existing field order" $ do+      forAll (map field <$> arbitraryFieldNames) $ \fields -> do+        forAll arbitraryFieldNames $ \existingFieldOrder -> do+          let+            existingIndex :: Element -> Maybe Int+            existingIndex (Field name _) = name `elemIndex` existingFieldOrder+            existingIndex _ = Nothing -    it "ignores whitespace lines" $ do-      let input = unlines [-              "executable foo"-            , "  "-            , "    build-depends: bar"-            ]-      sniffIndentation input `shouldBe` Just 4+            indexes :: [Int]+            indexes = mapMaybe existingIndex (sortFieldsBy existingFieldOrder fields) -  describe "sniffCommaStyle" $ do-    it "detects leading commas" $ do-      let input = unlines [-              "executable foo"-            , "  build-depends:"-            , "      bar"-            , "    , baz"-            ]-      sniffCommaStyle input `shouldBe` Just LeadingCommas+          sort indexes `shouldBe` indexes -    it "detects trailing commas" $ do-      let input = unlines [-              "executable foo"-            , "  build-depends:"-            , "    bar,  "-            , "    baz"-            ]-      sniffCommaStyle input `shouldBe` Just TrailingCommas+    it "is stable" $ do+      forAll arbitraryFieldNames $ \fieldNames -> do+        forAll (elements $ subsequences fieldNames) $ \existingFieldOrder -> do+          let fields = map field fieldNames+          sortFieldsBy existingFieldOrder fields `shouldBe` fields -    context "when detection fails" $ do-      it "returns Nothing" $ do-        sniffCommaStyle "" `shouldBe` Nothing+  describe "addSortKey" $ do+    it "adds sort key"  $ do+      addSortKey [(Nothing, "foo"), (Just 3, "bar"), (Nothing, "baz")] `shouldBe` [((-1, 0), "foo"), ((3, 1), "bar"), ((3, 2), "baz" :: String)]
test/Hpack/RunSpec.hs view
@@ -2,7 +2,7 @@ module Hpack.RunSpec (spec) where  import           Test.Hspec-import           Data.List+import           Data.List.Compat  import           Hpack.ConfigSpec hiding (spec) import           Hpack.Config hiding (package)@@ -12,9 +12,9 @@ spec :: Spec spec = do   describe "renderPackage" $ do-    let renderPackage_ = renderPackage defaultRenderSettings+    let renderPackage_ = renderPackage defaultRenderSettings 0 [] []     it "renders a package" $ do-      renderPackage_ 0 [] package `shouldBe` unlines [+      renderPackage_ package `shouldBe` unlines [           "name: foo"         , "version: 0.0.0"         , "build-type: Simple"@@ -22,7 +22,7 @@         ]      it "aligns fields" $ do-      renderPackage_ 16 [] package `shouldBe` unlines [+      renderPackage defaultRenderSettings 16 [] [] package `shouldBe` unlines [           "name:           foo"         , "version:        0.0.0"         , "build-type:     Simple"@@ -30,7 +30,7 @@         ]      it "includes description" $ do-      renderPackage_ 0 [] package {packageDescription = Just "foo\n\nbar\n"} `shouldBe` unlines [+      renderPackage_ package {packageDescription = Just "foo\n\nbar\n"} `shouldBe` unlines [           "name: foo"         , "version: 0.0.0"         , "description: foo"@@ -41,7 +41,7 @@         ]      it "aligns description" $ do-      renderPackage_ 16 [] package {packageDescription = Just "foo\n\nbar\n"} `shouldBe` unlines [+      renderPackage defaultRenderSettings 16 [] [] package {packageDescription = Just "foo\n\nbar\n"} `shouldBe` unlines [           "name:           foo"         , "version:        0.0.0"         , "description:    foo"@@ -52,7 +52,7 @@         ]      it "includes stability" $ do-      renderPackage_ 0 [] package {packageStability = Just "experimental"} `shouldBe` unlines [+      renderPackage_ package {packageStability = Just "experimental"} `shouldBe` unlines [           "name: foo"         , "version: 0.0.0"         , "stability: experimental"@@ -61,7 +61,7 @@         ]      it "includes copyright holder" $ do-      renderPackage_ 0 [] package {packageCopyright = ["(c) 2015 Simon Hengel"]} `shouldBe` unlines [+      renderPackage_ package {packageCopyright = ["(c) 2015 Simon Hengel"]} `shouldBe` unlines [           "name: foo"         , "version: 0.0.0"         , "copyright: (c) 2015 Simon Hengel"@@ -70,7 +70,7 @@         ]      it "aligns copyright holders" $ do-      renderPackage_ 16 [] package {packageCopyright = ["(c) 2015 Foo", "(c) 2015 Bar"]} `shouldBe` unlines [+      renderPackage defaultRenderSettings 16 [] [] package {packageCopyright = ["(c) 2015 Foo", "(c) 2015 Bar"]} `shouldBe` unlines [           "name:           foo"         , "version:        0.0.0"         , "copyright:      (c) 2015 Foo,"@@ -80,7 +80,7 @@         ]      it "includes extra-source-files" $ do-      renderPackage_ 0 [] package {packageExtraSourceFiles = ["foo", "bar"]} `shouldBe` unlines [+      renderPackage_ package {packageExtraSourceFiles = ["foo", "bar"]} `shouldBe` unlines [           "name: foo"         , "version: 0.0.0"         , "build-type: Simple"@@ -92,7 +92,7 @@         ]      it "includes buildable" $ do-      renderPackage_ 0 [] package {packageLibrary = Just (section library){sectionBuildable = Just False}} `shouldBe` unlines [+      renderPackage_ package {packageLibrary = Just (section library){sectionBuildable = Just False}} `shouldBe` unlines [           "name: foo"         , "version: 0.0.0"         , "build-type: Simple"@@ -105,7 +105,7 @@      context "when rendering library section" $ do       it "renders library section" $ do-        renderPackage_ 0 [] package {packageLibrary = Just $ section library} `shouldBe` unlines [+        renderPackage_ package {packageLibrary = Just $ section library} `shouldBe` unlines [             "name: foo"           , "version: 0.0.0"           , "build-type: Simple"@@ -116,7 +116,7 @@           ]        it "includes exposed-modules" $ do-        renderPackage_ 0 [] package {packageLibrary = Just (section library{libraryExposedModules = ["Foo"]})} `shouldBe` unlines [+        renderPackage_ package {packageLibrary = Just (section library{libraryExposedModules = ["Foo"]})} `shouldBe` unlines [             "name: foo"           , "version: 0.0.0"           , "build-type: Simple"@@ -129,7 +129,7 @@           ]        it "includes other-modules" $ do-        renderPackage_ 0 [] package {packageLibrary = Just (section library{libraryOtherModules = ["Bar"]})} `shouldBe` unlines [+        renderPackage_ package {packageLibrary = Just (section library{libraryOtherModules = ["Bar"]})} `shouldBe` unlines [             "name: foo"           , "version: 0.0.0"           , "build-type: Simple"@@ -142,7 +142,7 @@           ]        it "includes reexported-modules and bumps cabal version" $ do-        renderPackage_ 0 [] package {packageLibrary = Just (section library{libraryReexportedModules = ["Baz"]})} `shouldBe` unlines [+        renderPackage_ package {packageLibrary = Just (section library{libraryReexportedModules = ["Baz"]})} `shouldBe` unlines [             "name: foo"           , "version: 0.0.0"           , "build-type: Simple"@@ -156,7 +156,7 @@      context "when given list of existing fields" $ do       it "retains field order" $ do-        renderPackage_ 16 ["cabal-version", "version", "name", "build-type"] package `shouldBe` unlines [+        renderPackage defaultRenderSettings 16 ["cabal-version", "version", "name", "build-type"] [] package `shouldBe` unlines [             "cabal-version:  >= 1.10"           , "version:        0.0.0"           , "name:           foo"@@ -164,16 +164,30 @@           ]        it "uses default field order for new fields" $ do-        renderPackage_ 16 ["name", "version", "cabal-version"] package `shouldBe` unlines [+        renderPackage defaultRenderSettings 16 ["name", "version", "cabal-version"] [] package `shouldBe` unlines [             "name:           foo"           , "version:        0.0.0"           , "build-type:     Simple"           , "cabal-version:  >= 1.10"           ] +      it "retains section field order" $ do+        renderPackage defaultRenderSettings 0 [] [("executable foo", ["default-language", "main-is", "ghc-options"])] package {packageExecutables = [(section $ executable "foo" "Main.hs") {sectionGhcOptions = ["-Wall", "-Werror"]}]} `shouldBe` unlines [+            "name: foo"+          , "version: 0.0.0"+          , "build-type: Simple"+          , "cabal-version: >= 1.10"+          , ""+          , "executable foo"+          , "  default-language: Haskell2010"+          , "  main-is: Main.hs"+          , "  ghc-options: -Wall -Werror"+          ]++     context "when rendering executable section" $ do       it "includes dependencies" $ do-        renderPackage_ 0 [] package {packageExecutables = [(section $ executable "foo" "Main.hs") {sectionDependencies = ["foo", "bar", "foo", "baz"]}]} `shouldBe` unlines [+        renderPackage_ package {packageExecutables = [(section $ executable "foo" "Main.hs") {sectionDependencies = ["foo", "bar", "foo", "baz"]}]} `shouldBe` unlines [             "name: foo"           , "version: 0.0.0"           , "build-type: Simple"@@ -190,7 +204,7 @@           ]        it "includes GHC options" $ do-        renderPackage_ 0 [] package {packageExecutables = [(section $ executable "foo" "Main.hs") {sectionGhcOptions = ["-Wall", "-Werror"]}]} `shouldBe` unlines [+        renderPackage_ package {packageExecutables = [(section $ executable "foo" "Main.hs") {sectionGhcOptions = ["-Wall", "-Werror"]}]} `shouldBe` unlines [             "name: foo"           , "version: 0.0.0"           , "build-type: Simple"@@ -203,7 +217,7 @@           ]        it "includes GHC profiling options" $ do-        renderPackage_ 0 [] package {packageExecutables = [(section $ executable "foo" "Main.hs") {sectionGhcProfOptions = ["-fprof-auto", "-rtsopts"]}]} `shouldBe` unlines [+        renderPackage_ package {packageExecutables = [(section $ executable "foo" "Main.hs") {sectionGhcProfOptions = ["-fprof-auto", "-rtsopts"]}]} `shouldBe` unlines [             "name: foo"           , "version: 0.0.0"           , "build-type: Simple"@@ -217,7 +231,7 @@   describe "renderConditional" $ do     it "renders conditionals" $ do       let conditional = Conditional "os(windows)" (section ()) {sectionDependencies = ["Win32"]} Nothing-      concatMap (render defaultRenderSettings 0) (renderConditional conditional) `shouldBe` [+      render defaultRenderSettings 0 (renderConditional conditional) `shouldBe` [           "if os(windows)"         , "  build-depends:"         , "      Win32"@@ -225,7 +239,7 @@      it "renders conditionals with else-branch" $ do       let conditional = Conditional "os(windows)" (section ()) {sectionDependencies = ["Win32"]} (Just $ (section ()) {sectionDependencies = ["unix"]})-      concatMap (render defaultRenderSettings 0) (renderConditional conditional) `shouldBe` [+      render defaultRenderSettings 0 (renderConditional conditional) `shouldBe` [           "if os(windows)"         , "  build-depends:"         , "      Win32"@@ -237,7 +251,7 @@     it "renders nested conditionals" $ do       let conditional = Conditional "arch(i386)" (section ()) {sectionGhcOptions = ["-threaded"], sectionConditionals = [innerConditional]} Nothing           innerConditional = Conditional "os(windows)" (section ()) {sectionDependencies = ["Win32"]} Nothing-      concatMap (render defaultRenderSettings 0) (renderConditional conditional) `shouldBe` [+      render defaultRenderSettings 0 (renderConditional conditional) `shouldBe` [           "if arch(i386)"         , "  ghc-options: -threaded"         , "  if os(windows)"
test/Hpack/UtilSpec.hs view
@@ -88,60 +88,6 @@       inTempDirectory $ do         tryReadFile "foo" `shouldReturn` Nothing -  describe "extractFieldOrderHint" $ do-    it "extracts field order hints" $ do-      let input = unlines [-              "name:           cabalize"-            , "version:        0.0.0"-            , "license:"-            , "license-file: "-            , "build-type:     Simple"-            , "cabal-version:  >= 1.10"-            ]-      extractFieldOrderHint input `shouldBe` [-              "name"-            , "version"-            , "license"-            , "license-file"-            , "build-type"-            , "cabal-version"-            ]--  describe "sniffAlignment" $ do-    it "sniffs field alignment from given cabal file" $ do-      let input = unlines [-              "name:           cabalize"-            , "version:        0.0.0"-            , "license:        MIT"-            , "license-file:   LICENSE"-            , "build-type:     Simple"-            , "cabal-version:  >= 1.10"-            ]-      sniffAlignment input `shouldBe` Just 16--    it "ignores fields without a value on the same line" $ do-      let input = unlines [-              "name:           cabalize"-            , "version:        0.0.0"-            , "description: "-            , "  foo"-            , "  bar"-            ]-      sniffAlignment input `shouldBe` Just 16--  describe "splitField" $ do-    it "splits fields" $ do-      splitField "foo:   bar" `shouldBe` Just ("foo", "   bar")--    it "accepts fields names with dashes" $ do-      splitField "foo-bar: baz" `shouldBe` Just ("foo-bar", " baz")--    it "rejects fields names with spaces" $ do-      splitField "foo bar: baz" `shouldBe` Nothing--    it "rejects invalid fields" $ do-      splitField "foo bar" `shouldBe` Nothing-   describe "expandGlobs" $ around withTempDirectory $ do     it "accepts simple files" $ \dir -> do         touch (dir </> "foo.js")
test/HpackSpec.hs view
@@ -1,9 +1,21 @@ module HpackSpec (spec) where +import           Prelude ()+import           Prelude.Compat++import           Control.Monad.Compat+import           Control.DeepSeq+import           Data.Version (Version(..), showVersion)+ import           Test.Hspec+import           Test.Mockery.Directory+import           Test.QuickCheck  import           Hpack +makeVersion :: [Int] -> Version+makeVersion v = Version v []+ spec :: Spec spec = do   describe "parseVerbosity" $ do@@ -13,3 +25,47 @@     context "with --silent" $ do       it "returns False" $ do         parseVerbosity ["--silent"] `shouldBe` (False, [])++  describe "extractVersion" $ do+    it "extracts Hpack version from a cabal file" $ do+      let cabalFile = ["-- This file has been generated from package.yaml by hpack version 0.10.0."]+      extractVersion cabalFile `shouldBe` Just (Version [0, 10, 0] [])++    it "is total" $ do+      let cabalFile = ["-- This file has been generated from package.yaml by hpack version "]+      extractVersion cabalFile `shouldBe` Nothing++  describe "parseVersion" $ do+    it "is inverse to showVersion" $ do+      let positive = getPositive <$> arbitrary+      forAll (replicateM 3 positive) $ \xs -> do+        let v = Version xs []+        parseVersion (showVersion v) `shouldBe` Just v++  describe "hpackWithVersion" $ do+    context "when only the hpack version in the cabal file header changed" $ do+      it "does not write a new cabal file" $ do+        inTempDirectory $ do+          writeFile "package.yaml" "name: foo"+          hpackWithVersion (makeVersion [0,8,0]) "." False+          old <- readFile "foo.cabal" >>= (return $!!)+          hpackWithVersion (makeVersion [0,10,0]) "." False+          readFile "foo.cabal" `shouldReturn` old++    context "when exsting cabal file was generated with a newer version of hpack" $ do+      it "does not re-generate" $ do+        inTempDirectory $ do+          writeFile "package.yaml" $ unlines [+              "name: foo"+            , "version: 0.1.0"+            ]+          hpackWithVersion (makeVersion [0,10,0]) "." False+          old <- readFile "foo.cabal" >>= (return $!!)++          writeFile "package.yaml" $ unlines [+              "name: foo"+            , "version: 0.2.0"+            ]++          hpackWithVersion (makeVersion [0,8,0]) "." False+          readFile "foo.cabal" `shouldReturn` old