cabal-fmt 0.1.2 → 0.1.3

raw patch · 18 files changed

+265/−148 lines, 18 filesdep ~Cabaldep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: Cabal, base

API changes (from Hackage documentation)

Files

• Changelog.md +5/−0
• cabal-fmt.cabal +7/−4
• cli/Main.hs +45/−15
• src/CabalFmt.hs +4/−7
• src/CabalFmt/Comments.hs +2/−3
• src/CabalFmt/Error.hs +7/−6
• src/CabalFmt/Fields.hs +12/−8
• src/CabalFmt/Fields/BuildDepends.hs +1/−5
• src/CabalFmt/Fields/Extensions.hs +1/−3
• src/CabalFmt/Fields/Modules.hs +1/−5
• src/CabalFmt/Fields/TestedWith.hs +1/−3
• src/CabalFmt/Options.hs +9/−0
• src/CabalFmt/Parser.hs +1/−2
• src/CabalFmt/Pragma.hs +1/−5
• src/CabalFmt/Prelude.hs +69/−0
• src/CabalFmt/Refactoring.hs +3/−82
• src/CabalFmt/Refactoring/ExpandExposedModules.hs +49/−0
• src/CabalFmt/Refactoring/Type.hs +47/−0

@@ -1,3 +1,8 @@+# 0.1.3++- GHC-8.10 support. Require Cabal-3.2+- Add `--check` operation mode+ # 0.1.2  - Don't change current working directories. Don't expand if used on stdin.

@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               cabal-fmt-version:            0.1.2+version:            0.1.3 synopsis:           Format .cabal files category:           Development description:@@ -12,7 +12,7 @@ license-file:       LICENSE author:             Oleg Grenrus <oleg.grenrus@iki.fi> maintainer:         Oleg Grenrus <oleg.grenrus@iki.fi>-tested-with:        GHC ==8.4.4 || ==8.6.5 || ==8.8.1+tested-with:        GHC ==8.4.4 || ==8.6.5 || ==8.8.3 || ==8.10.1 extra-source-files:   Changelog.md   fixtures/*.cabal@@ -28,9 +28,9 @@    -- GHC boot libraries   build-depends:-    , base        ^>=4.11.1.0 || ^>=4.12.0.0 || ^>=4.13.0.0+    , base        ^>=4.11.1.0 || ^>=4.12.0.0 || ^>=4.13.0.0 || ^>=4.14.0.0     , bytestring  ^>=0.10.8.2-    , Cabal       ^>=3.0.0.0+    , Cabal       ^>=3.2.0.0     , containers  ^>=0.5.11.0 || ^>=0.6.0.1     , directory   ^>=1.3.1.5     , filepath    ^>=1.4.2@@ -52,7 +52,10 @@     CabalFmt.Options     CabalFmt.Parser     CabalFmt.Pragma+    CabalFmt.Prelude     CabalFmt.Refactoring+    CabalFmt.Refactoring.ExpandExposedModules+    CabalFmt.Refactoring.Type    other-extensions:     DeriveFunctor

@@ -4,11 +4,13 @@ module Main (main) where  import Control.Applicative (many, (<**>))+import Control.Monad       (unless, when) import Data.Foldable       (asum, for_)-import Data.Maybe          (fromMaybe)+import Data.Traversable    (for) import Data.Version        (showVersion) import System.Exit         (exitFailure) import System.FilePath     (takeDirectory)+import System.IO           (hPutStrLn, stderr)  import qualified Data.ByteString     as BS import qualified Options.Applicative as O@@ -17,19 +19,26 @@ import CabalFmt.Error   (renderError) import CabalFmt.Monad   (runCabalFmtIO) import CabalFmt.Options+import CabalFmt.Prelude  import Paths_cabal_fmt (version)  main :: IO () main = do-    (inplace, opts', filepaths) <- O.execParser optsP'+    (opts', filepaths) <- O.execParser optsP'     let opts = runOptionsMorphism opts' defaultOptions -    case filepaths of-        []    -> BS.getContents >>= main' False opts Nothing-        (_:_) -> for_ filepaths $ \filepath -> do+    notFormatted <- catMaybes <$> case filepaths of+        []    -> fmap pure $ BS.getContents >>= main' opts Nothing+        (_:_) -> for filepaths $ \filepath -> do             contents <- BS.readFile filepath-            main' inplace opts (Just filepath) contents+            main' opts (Just filepath) contents++    when ((optMode opts == ModeCheck) && not (null notFormatted)) $ do+        for_ notFormatted $ \filepath ->+            hPutStrLn stderr $ "error: Input " <> filepath <> " is not formatted."+        exitFailure+   where     optsP' = O.info (optsP <**> O.helper <**> versionP) $ mconcat         [ O.fullDesc@@ -40,8 +49,8 @@     versionP = O.infoOption (showVersion version)         $ O.long "version" <> O.help "Show version" -main' :: Bool -> Options -> Maybe FilePath -> BS.ByteString -> IO ()-main' inplace opts mfilepath input = do+main' :: Options -> Maybe FilePath -> BS.ByteString -> IO (Maybe FilePath)+main' opts mfilepath input = do     -- name of the input     let filepath = fromMaybe "<stdin>" mfilepath @@ -49,9 +58,19 @@     res <- runCabalFmtIO (takeDirectory <$> mfilepath) opts (cabalFmt filepath input)      case res of-        Right output-            | inplace   -> writeFile filepath output-            | otherwise -> putStr output+        Right output -> do+            let outputBS = toUTF8BS output+                formatted = outputBS == input++            case optMode opts of+                ModeStdout -> BS.putStr outputBS+                ModeInplace -> case mfilepath of+                    Nothing -> BS.putStr outputBS+                    Just _  -> unless formatted $ BS.writeFile filepath outputBS+                _ -> return ()++            return $ if formatted then Nothing else Just filepath+         Left err     -> do             renderError err             exitFailure@@ -60,10 +79,9 @@ -- Options parser ------------------------------------------------------------------------------- -optsP :: O.Parser (Bool, OptionsMorphism, [FilePath])-optsP = (,,)-    <$> O.flag False True (O.short 'i' <> O.long "inplace" <> O.help "process files in-place")-    <*> optsP'+optsP :: O.Parser (OptionsMorphism, [FilePath])+optsP = (,)+    <$> optsP'     <*> many (O.strArgument (O.metavar "FILE..." <> O.help "input files"))   where     optsP' = fmap mconcat $ many $ asum@@ -72,6 +90,9 @@         , indentP         , tabularP         , noTabularP+        , stdoutP+        , inplaceP+        , checkP         ]      werrorP = O.flag' (mkOptionsMorphism $ \opts -> opts { optError = True })@@ -88,4 +109,13 @@      noTabularP = O.flag' (mkOptionsMorphism $ \opts -> opts { optTabular = False })         $ O.long "no-tabular"++    stdoutP = O.flag' (mkOptionsMorphism $ \opts -> opts { optMode = ModeStdout })+        $ O.long "stdout" <> O.help "Write output to stdout (default)"++    inplaceP = O.flag' (mkOptionsMorphism $ \opts -> opts { optMode = ModeInplace })+        $ O.short 'i' <> O.long "inplace" <> O.help "Process files in-place"++    checkP = O.flag' (mkOptionsMorphism $ \opts -> opts { optMode = ModeCheck })+        $ O.short 'c' <> O.long "check" <> O.help "Fail with non-zero exit code if input is not formatted" 

@@ -9,13 +9,8 @@ -- module CabalFmt (cabalFmt) where -import Control.Monad            (foldM, join)-import Control.Monad.Except     (catchError)-import Control.Monad.Reader     (asks, local)-import Data.Foldable            (traverse_)-import Data.Function            ((&))-import Data.Maybe               (fromMaybe)-import Distribution.Compat.Lens (over, view)+import Control.Monad        (foldM, join)+import Control.Monad.Reader (asks, local)  import qualified Data.ByteString                              as BS import qualified Distribution.CabalSpecVersion                as C@@ -28,6 +23,7 @@ import qualified Distribution.Pretty                          as C import qualified Distribution.Simple.Utils                    as C import qualified Distribution.Types.Condition                 as C+import qualified Distribution.Types.ConfVar                   as C import qualified Distribution.Types.GenericPackageDescription as C import qualified Distribution.Types.PackageDescription        as C import qualified Distribution.Types.Version                   as C@@ -43,6 +39,7 @@ import CabalFmt.Options import CabalFmt.Parser import CabalFmt.Pragma+import CabalFmt.Prelude import CabalFmt.Refactoring  -------------------------------------------------------------------------------

@@ -8,15 +8,14 @@ {-# LANGUAGE ScopedTypeVariables        #-} module CabalFmt.Comments where -import Data.Foldable (toList)-import Data.Maybe    (fromMaybe, isNothing)- import qualified Data.ByteString           as BS import qualified Data.ByteString.Char8     as BS8 import qualified Data.Map.Strict           as Map import qualified Distribution.Fields       as C import qualified Distribution.Fields.Field as C import qualified Distribution.Parsec       as C++import CabalFmt.Prelude  ------------------------------------------------------------------------------- -- Comments wrapper

@@ -3,10 +3,11 @@ -- Copyright: Oleg Grenrus module CabalFmt.Error (Error (..), renderError) where -import Control.Exception (Exception)-import System.FilePath   (normalise)-import System.IO         (hPutStr, hPutStrLn, stderr)-import Text.Parsec.Error (ParseError)+import Control.Exception  (Exception)+import Data.List.NonEmpty (NonEmpty)+import System.FilePath    (normalise)+import System.IO          (hPutStr, hPutStrLn, stderr)+import Text.Parsec.Error  (ParseError)  import qualified Data.ByteString            as BS import qualified Data.ByteString.Char8      as BS8@@ -16,7 +17,7 @@  data Error     = SomeError String-    | CabalParseError FilePath BS.ByteString [C.PError] (Maybe C.Version) [C.PWarning]+    | CabalParseError FilePath BS.ByteString (NonEmpty C.PError) (Maybe C.Version) [C.PWarning]     | PanicCannotParseInput  ParseError     | WarningError String   deriving (Show)@@ -38,7 +39,7 @@ renderParseError     :: FilePath     -> BS.ByteString-    -> [C.PError]+    -> NonEmpty C.PError     -> [C.PWarning]     -> String renderParseError filepath contents errors warnings = unlines $

@@ -11,16 +11,16 @@     singletonF,     ) where -import Distribution.Compat.Newtype--import qualified Data.Map.Strict           as Map-import qualified Distribution.FieldGrammar as C-import qualified Distribution.Fields.Field as C-import qualified Distribution.Parsec       as C-import qualified Distribution.Pretty       as C+import qualified Data.Map.Strict                 as Map import qualified Distribution.Compat.CharParsing as C-import qualified Text.PrettyPrint          as PP+import qualified Distribution.FieldGrammar       as C+import qualified Distribution.Fields.Field       as C+import qualified Distribution.Parsec             as C+import qualified Distribution.Pretty             as C+import qualified Text.PrettyPrint                as PP +import CabalFmt.Prelude+ ------------------------------------------------------------------------------- -- FieldDescr variant -------------------------------------------------------------------------------@@ -92,6 +92,10 @@         (C.munch $ const True)      freeTextFieldDef fn _ = singletonF fn+        PP.text+        (C.munch $ const True)++    freeTextFieldDefST fn _ = singletonF fn         PP.text         (C.munch $ const True) 

@@ -7,11 +7,6 @@     setupDependsF,     ) where -import Control.Arrow               ((&&&))-import Data.Char                   (toLower)-import Data.List                   (sortOn)-import Distribution.Compat.Newtype- import qualified Distribution.CabalSpecVersion      as C import qualified Distribution.Parsec                as C import qualified Distribution.Parsec.Newtypes       as C@@ -24,6 +19,7 @@ import qualified Distribution.Types.VersionRange    as C import qualified Text.PrettyPrint                   as PP +import CabalFmt.Prelude import CabalFmt.Fields import CabalFmt.Options 

@@ -7,15 +7,13 @@     defaultExtensionsF,     ) where -import Data.List                   (sortOn)-import Distribution.Compat.Newtype- import qualified Distribution.Parsec          as C import qualified Distribution.Parsec.Newtypes as C import qualified Distribution.Pretty          as C import qualified Language.Haskell.Extension   as C import qualified Text.PrettyPrint             as PP +import CabalFmt.Prelude import CabalFmt.Fields  otherExtensionsF :: FieldDescrs () ()

@@ -7,17 +7,13 @@     exposedModulesF,     ) where -import Data.Char                   (toLower)-import Data.Function               (on)-import Data.List                   (nub, sortBy)-import Distribution.Compat.Newtype- import qualified Distribution.ModuleName      as C import qualified Distribution.Parsec          as C import qualified Distribution.Parsec.Newtypes as C import qualified Distribution.Pretty          as C import qualified Text.PrettyPrint             as PP +import CabalFmt.Prelude import CabalFmt.Fields  exposedModulesF :: FieldDescrs () ()

@@ -7,9 +7,6 @@     testedWithF,     ) where -import Data.Set                    (Set)-import Distribution.Compat.Newtype- import qualified Data.Map.Strict               as Map import qualified Data.Set                      as Set import qualified Distribution.CabalSpecVersion as C@@ -20,6 +17,7 @@ import qualified Distribution.Version          as C import qualified Text.PrettyPrint              as PP +import CabalFmt.Prelude import CabalFmt.Fields import CabalFmt.Options 

@@ -2,6 +2,7 @@ -- License: GPL-3.0-or-later -- Copyright: Oleg Grenrus module CabalFmt.Options (+    Mode (..),     Options (..),     defaultOptions,     OptionsMorphism, mkOptionsMorphism, runOptionsMorphism,@@ -12,11 +13,18 @@  import qualified Distribution.CabalSpecVersion       as C +data Mode+    = ModeStdout+    | ModeInplace+    | ModeCheck+  deriving (Eq, Show)+ data Options = Options     { optError       :: !Bool     , optIndent      :: !Int     , optTabular     :: !Bool     , optSpecVersion :: !C.CabalSpecVersion+    , optMode        :: !Mode     }   deriving Show @@ -26,6 +34,7 @@     , optIndent      = 2     , optTabular     = True     , optSpecVersion = C.cabalSpecLatest+    , optMode        = ModeStdout     }  newtype OptionsMorphism = OM (Options -> Options)

@@ -3,8 +3,6 @@ -- Copyright: Oleg Grenrus module CabalFmt.Parser where -import Control.Monad.Except (throwError)- import qualified Data.ByteString                              as BS import qualified Distribution.Fields                          as C import qualified Distribution.PackageDescription.Parsec       as C@@ -13,6 +11,7 @@  import CabalFmt.Error import CabalFmt.Monad+import CabalFmt.Prelude  runParseResult :: MonadCabalFmt r m => FilePath -> BS.ByteString -> C.ParseResult a -> m a runParseResult filepath contents pr = case result of

@@ -1,17 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} module CabalFmt.Pragma where -import Data.Bifunctor  (bimap)-import Data.ByteString (ByteString)-import Data.Either     (partitionEithers)-import Data.Maybe      (catMaybes)- import qualified Data.ByteString                     as BS import qualified Distribution.Compat.CharParsing     as C import qualified Distribution.ModuleName             as C import qualified Distribution.Parsec                 as C import qualified Distribution.Parsec.FieldLineStream as C +import CabalFmt.Prelude import CabalFmt.Comments  data Pragma

@@ -0,0 +1,69 @@+-- |+-- License: GPL-3.0-or-later+-- Copyright: Oleg Grenrus+--+-- Fat-prelude.+module CabalFmt.Prelude (+    -- * Control.Arrow+    (&&&),+    -- * Data.Bifunctor+    bimap,+    -- * Data.Char+    toLower,+    -- * Data.Either+    partitionEithers,+    -- * Data.Foldable+    toList, traverse_,+    -- * Data.Function+    on, (&),+    -- * Data.List+    intercalate, sortOn, sortBy, nub,+    -- * Data.Maybe+    catMaybes,+    fromMaybe,+    isJust,+    isNothing,+    -- * Packages+    -- ** bytestring+    ByteString,+    -- ** Cabal+    C.fromUTF8BS, C.toUTF8BS,+    pack', unpack',+    -- ** containers+    Set,+    -- ** directory+    dropExtension, splitDirectories,+    -- ** exceptions+    catchError, throwError,+    -- * Extras+    -- ** Lens+    traverseOf,+    over, view,+    _1,+    ) where++import Control.Arrow               ((&&&))+import Control.Monad.Except        (catchError, throwError)+import Data.Bifunctor              (bimap)+import Data.ByteString             (ByteString)+import Data.Char                   (toLower)+import Data.Either                 (partitionEithers)+import Data.Foldable               (toList, traverse_)+import Data.Function               (on, (&))+import Data.List                   (intercalate, nub, sortBy, sortOn)+import Data.Maybe                  (catMaybes, fromMaybe, isJust, isNothing)+import Data.Set                    (Set)+import Distribution.Compat.Lens    (over, view)+import Distribution.Compat.Newtype (pack', unpack')+import System.FilePath             (dropExtension, splitDirectories)++import qualified Distribution.Simple.Utils as C++traverseOf+    :: Applicative f+    => ((a -> f b) -> s ->  f t)+    -> (a -> f b) -> s ->  f t+traverseOf = id++_1 :: Functor f => (a -> f b) -> (a, c) -> f (b, c)+_1 f (a, c) = (\b -> (b, c)) <$> f a

@@ -1,88 +1,9 @@ -- | -- License: GPL-3.0-or-later -- Copyright: Oleg Grenrus-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes        #-} module CabalFmt.Refactoring (-    Refactoring,-    Refactoring',-    refactoringExpandExposedModules,+    module X,     ) where -import Data.List       (intercalate)-import Data.Maybe      (catMaybes)-import System.FilePath (dropExtension, splitDirectories)--import qualified Distribution.Fields       as C-import qualified Distribution.ModuleName   as C-import qualified Distribution.Simple.Utils as C--import CabalFmt.Comments-import CabalFmt.Monad-import CabalFmt.Pragma------------------------------------------------------------------------------------ Refactoring type----------------------------------------------------------------------------------type C = (Comments, [Pragma])-type Refactoring             = forall r m. MonadCabalFmt r m => Refactoring' r m-type Refactoring' r m        = [C.Field C] -> m [C.Field C]-type RefactoringOfField      = forall r m. MonadCabalFmt r m => RefactoringOfField' r m-type RefactoringOfField' r m = C.Name C -> [C.FieldLine C] -> m (C.Name C, [C.FieldLine C])------------------------------------------------------------------------------------ Expand exposed-modules----------------------------------------------------------------------------------refactoringExpandExposedModules :: Refactoring-refactoringExpandExposedModules = traverseFields refact where-    refact :: RefactoringOfField-    refact name@(C.Name (_, pragmas) n) fls-        | n == "exposed-modules" || n == "other-modules" = do-            dirs <- parse pragmas-            files <- traverseOf (traverse . _1) getFiles dirs--            let newModules :: [C.FieldLine C]-                newModules = catMaybes-                    [ return $ C.FieldLine mempty $ C.toUTF8BS $ intercalate "." parts-                    | (files', mns) <- files-                    , file <- files'-                    , let parts = splitDirectories $ dropExtension file-                    , all C.validModuleComponent parts-                    , let mn = C.fromComponents parts-                    , mn `notElem` mns-                    ]--            pure (name, newModules ++ fls)-        | otherwise = pure (name, fls)--    parse :: MonadCabalFmt r m => [Pragma] -> m [(FilePath, [C.ModuleName])]-    parse = fmap mconcat . traverse go where-        go (PragmaExpandModules fp mns) = return [ (fp, mns) ]-        go p = do-            displayWarning $ "Skipped pragma " ++ show p-            return []------------------------------------------------------------------------------------ Tools----------------------------------------------------------------------------------traverseOf-    :: Applicative f-    => ((a -> f b) -> s ->  f t)-    -> (a -> f b) -> s ->  f t-traverseOf = id--_1 :: Functor f => (a -> f b) -> (a, c) -> f (b, c)-_1 f (a, c) = (\b -> (b, c)) <$> f a--traverseFields-    :: Applicative f-    => RefactoringOfField' r f-    -> [C.Field C] -> f [C.Field C]-traverseFields f = goMany where-    goMany = traverse go--    go (C.Field name fls)       = uncurry C.Field <$> f name fls-    go (C.Section name args fs) = C.Section name args <$> goMany fs+import CabalFmt.Refactoring.ExpandExposedModules as X+import CabalFmt.Refactoring.Type                 as X

@@ -0,0 +1,49 @@+-- |+-- License: GPL-3.0-or-later+-- Copyright: Oleg Grenrus+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes        #-}+module CabalFmt.Refactoring.ExpandExposedModules (+    Refactoring,+    Refactoring',+    refactoringExpandExposedModules,+    ) where++import qualified Distribution.Fields     as C+import qualified Distribution.ModuleName as C++import CabalFmt.Prelude+import CabalFmt.Monad+import CabalFmt.Pragma+import CabalFmt.Refactoring.Type++refactoringExpandExposedModules :: Refactoring+refactoringExpandExposedModules = traverseFields refact where+    refact :: RefactoringOfField+    refact name@(C.Name (_, pragmas) n) fls+        | n == "exposed-modules" || n == "other-modules" = do+            dirs <- parse pragmas+            files <- traverseOf (traverse . _1) getFiles dirs++            let newModules :: [C.FieldLine CommentsPragmas]+                newModules = catMaybes+                    [ return $ C.FieldLine mempty $ toUTF8BS $ intercalate "." parts+                    | (files', mns) <- files+                    , file <- files'+                    , let parts = splitDirectories $ dropExtension file+                    , all C.validModuleComponent parts+                    , let mn = C.fromComponents parts+                    , mn `notElem` mns+                    ]++            pure (name, newModules ++ fls)+        | otherwise = pure (name, fls)++    parse :: MonadCabalFmt r m => [Pragma] -> m [(FilePath, [C.ModuleName])]+    parse = fmap mconcat . traverse go where+        go (PragmaExpandModules fp mns) = return [ (fp, mns) ]+        go p = do+            displayWarning $ "Skipped pragma " ++ show p+            return []++

@@ -0,0 +1,47 @@+-- |+-- License: GPL-3.0-or-later+-- Copyright: Oleg Grenrus+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes        #-}+module CabalFmt.Refactoring.Type (+    Refactoring,+    Refactoring',+    RefactoringOfField,+    RefactoringOfField',+    CommentsPragmas,+    traverseFields+    ) where++import qualified Distribution.Fields       as C++import CabalFmt.Comments+import CabalFmt.Monad+import CabalFmt.Pragma++-------------------------------------------------------------------------------+-- Refactoring type+-------------------------------------------------------------------------------++type CommentsPragmas = (Comments, [Pragma])+type Refactoring             = forall r m. MonadCabalFmt r m => Refactoring' r m+type Refactoring' r m        = [C.Field CommentsPragmas] -> m [C.Field CommentsPragmas]+type RefactoringOfField      = forall r m. MonadCabalFmt r m => RefactoringOfField' r m+type RefactoringOfField' r m = C.Name CommentsPragmas -> [C.FieldLine CommentsPragmas] -> m (C.Name CommentsPragmas, [C.FieldLine CommentsPragmas])++-------------------------------------------------------------------------------+-- Traversing refactoring+-------------------------------------------------------------------------------++-- | Allows modification of single field +--+-- E.g. sorting extensions *could* be done as refactoring,+-- though it's currently implemented in special pretty-printer.+traverseFields+    :: Applicative f+    => RefactoringOfField' r f+    -> [C.Field CommentsPragmas] -> f [C.Field CommentsPragmas]+traverseFields f = goMany where+    goMany = traverse go++    go (C.Field name fls)       = uncurry C.Field <$> f name fls+    go (C.Section name args fs) = C.Section name args <$> goMany fs