cabal-fmt 0.1.1 → 0.1.2

raw patch · 10 files changed

+94/−66 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Changelog.md +5/−0
• cabal-fmt.cabal +1/−1
• cli/Main.hs +4/−14
• fixtures/Cabal.format +12/−12
• src/CabalFmt.hs +16/−15
• src/CabalFmt/Fields/Modules.hs +8/−1
• src/CabalFmt/Monad.hs +31/−14
• src/CabalFmt/Options.hs +8/−0
• src/CabalFmt/Parser.hs +3/−3
• src/CabalFmt/Refactoring.hs +6/−6

@@ -1,3 +1,8 @@+# 0.1.2++- Don't change current working directories. Don't expand if used on stdin.+- Sort module names case-insensitively+ # 0.1.1  - Change metavar of file arguments to be `FILE...`,

@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               cabal-fmt-version:            0.1.1+version:            0.1.2 synopsis:           Format .cabal files category:           Development description:

@@ -5,13 +5,13 @@  import Control.Applicative (many, (<**>)) import Data.Foldable       (asum, for_)+import Data.Maybe          (fromMaybe) import Data.Version        (showVersion) import System.Exit         (exitFailure) import System.FilePath     (takeDirectory)  import qualified Data.ByteString     as BS import qualified Options.Applicative as O-import qualified System.Directory    as D  import CabalFmt         (cabalFmt) import CabalFmt.Error   (renderError)@@ -42,21 +42,11 @@  main' :: Bool -> Options -> Maybe FilePath -> BS.ByteString -> IO () main' inplace opts mfilepath input = do-    cwd <- D.getCurrentDirectory--    -- change to the directory where 'filepath' is.-    -- so expanding works-    filepath <- case mfilepath of-        Nothing       -> return "<stdin>"-        Just filepath -> do-            D.setCurrentDirectory (takeDirectory filepath)-            return filepath+    -- name of the input+    let filepath = fromMaybe "<stdin>" mfilepath      -- process-    res <- runCabalFmtIO opts (cabalFmt filepath input)--    -- change the cwd back-    D.setCurrentDirectory cwd+    res <- runCabalFmtIO (takeDirectory <$> mfilepath) opts (cabalFmt filepath input)      case res of         Right output

@@ -265,8 +265,8 @@     Distribution.CabalSpecVersion     Distribution.Compat.Binary     Distribution.Compat.CreatePipe-    Distribution.Compat.DList     Distribution.Compat.Directory+    Distribution.Compat.DList     Distribution.Compat.Environment     Distribution.Compat.Exception     Distribution.Compat.Graph@@ -289,13 +289,6 @@     Distribution.PackageDescription.Utils     Distribution.Pretty     Distribution.ReadE-    Distribution.SPDX-    Distribution.SPDX.License-    Distribution.SPDX.LicenseExceptionId-    Distribution.SPDX.LicenseExpression-    Distribution.SPDX.LicenseId-    Distribution.SPDX.LicenseListVersion-    Distribution.SPDX.LicenseReference     Distribution.Simple     Distribution.Simple.Bench     Distribution.Simple.Build@@ -347,6 +340,13 @@     Distribution.Simple.UHC     Distribution.Simple.UserHooks     Distribution.Simple.Utils+    Distribution.SPDX+    Distribution.SPDX.License+    Distribution.SPDX.LicenseExceptionId+    Distribution.SPDX.LicenseExpression+    Distribution.SPDX.LicenseId+    Distribution.SPDX.LicenseListVersion+    Distribution.SPDX.LicenseReference     Distribution.System     Distribution.TestSuite     Distribution.Text@@ -364,13 +364,13 @@     Distribution.Types.ComponentLocalBuildInfo     Distribution.Types.ComponentName     Distribution.Types.ComponentRequestedSpec-    Distribution.Types.CondTree     Distribution.Types.Condition+    Distribution.Types.CondTree     Distribution.Types.Dependency     Distribution.Types.DependencyMap-    Distribution.Types.ExeDependency     Distribution.Types.Executable     Distribution.Types.ExecutableScope+    Distribution.Types.ExeDependency     Distribution.Types.ExposedModule     Distribution.Types.ForeignLib     Distribution.Types.ForeignLibOption@@ -442,8 +442,8 @@     Distribution.Fields.Field     Distribution.Fields.Lexer     Distribution.Fields.LexerMonad-    Distribution.Fields.ParseResult     Distribution.Fields.Parser+    Distribution.Fields.ParseResult     Distribution.Fields.Pretty     Distribution.PackageDescription.FieldGrammar     Distribution.PackageDescription.Parsec@@ -540,10 +540,10 @@     UnitTests.Distribution.Compat.CreatePipe     UnitTests.Distribution.Compat.Graph     UnitTests.Distribution.Compat.Time-    UnitTests.Distribution.SPDX     UnitTests.Distribution.Simple.Glob     UnitTests.Distribution.Simple.Program.Internal     UnitTests.Distribution.Simple.Utils+    UnitTests.Distribution.SPDX     UnitTests.Distribution.System     UnitTests.Distribution.Types.GenericPackageDescription     UnitTests.Distribution.Utils.Generic

@@ -9,12 +9,13 @@ -- module CabalFmt (cabalFmt) where -import Control.Monad        (foldM, join)-import Control.Monad.Except (catchError)-import Control.Monad.Reader (ask, asks, local)-import Data.Foldable        (traverse_)-import Data.Function        ((&))-import Data.Maybe           (fromMaybe)+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 qualified Data.ByteString                              as BS import qualified Distribution.CabalSpecVersion                as C@@ -48,7 +49,7 @@ -- Main ------------------------------------------------------------------------------- -cabalFmt :: MonadCabalFmt m => FilePath -> BS.ByteString -> m String+cabalFmt :: MonadCabalFmt r m => FilePath -> BS.ByteString -> m String cabalFmt filepath contents = do     gpd          <- parseGpd filepath contents     inputFields' <- parseFields contents@@ -73,8 +74,8 @@           $ C.specVersion           $ C.packageDescription gpd -    local (\o -> runOptionsMorphism optsEndo $ o { optSpecVersion = v }) $ do-        indentWith <- asks optIndent+    local (over options $ \o -> runOptionsMorphism optsEndo $ o { optSpecVersion = v }) $ do+        indentWith <- asks (optIndent . view options)         let inputFields = fmap (fmap fst) inputFieldsR          outputPrettyFields <- C.genericFromParsecFields@@ -93,7 +94,7 @@ -- Refactorings ------------------------------------------------------------------------------- -refactorings :: MonadCabalFmt m => [Refactoring' m]+refactorings :: MonadCabalFmt r m => [Refactoring' r m] refactorings =     [ refactoringExpandExposedModules     ]@@ -102,13 +103,13 @@ -- Field prettyfying ------------------------------------------------------------------------------- -prettyFieldLines :: MonadCabalFmt m => C.FieldName -> [C.FieldLine ann] -> m PP.Doc+prettyFieldLines :: MonadCabalFmt r m => C.FieldName -> [C.FieldLine ann] -> m PP.Doc prettyFieldLines fn fls =     fromMaybe (C.prettyFieldLines fn fls) <$> knownField fn fls -knownField :: MonadCabalFmt m => C.FieldName -> [C.FieldLine ann] -> m (Maybe PP.Doc)+knownField :: MonadCabalFmt r m => C.FieldName -> [C.FieldLine ann] -> m (Maybe PP.Doc) knownField fn fls = do-    opts <- ask+    opts <- asks (view options)     let v = optSpecVersion opts     return $ join $ fieldDescrLookup (fieldDescrs opts) fn $ \p pp ->         case C.runParsecParser' v p "<input>" (C.fieldLinesToStream fls) of@@ -131,12 +132,12 @@ -- Sections ------------------------------------------------------------------------------- -prettySectionArgs :: MonadCabalFmt m => C.FieldName -> [C.SectionArg ann] -> m [PP.Doc]+prettySectionArgs :: MonadCabalFmt r m => C.FieldName -> [C.SectionArg ann] -> m [PP.Doc] prettySectionArgs x args =     prettySectionArgs' x args `catchError` \_ ->         return (C.prettySectionArgs x args) -prettySectionArgs' :: MonadCabalFmt m => a -> [C.SectionArg ann] -> m [PP.Doc]+prettySectionArgs' :: MonadCabalFmt r m => a -> [C.SectionArg ann] -> m [PP.Doc] prettySectionArgs' _ args = do     c <- runParseResult "<args>" "" $ C.parseConditionConfVar (map (C.zeroPos <$) args)     return [ppCondition c]

@@ -7,6 +7,7 @@     exposedModulesF,     ) where +import Data.Char                   (toLower) import Data.Function               (on) import Data.List                   (nub, sortBy) import Distribution.Compat.Newtype@@ -29,13 +30,19 @@ parse = unpack' (C.alaList' C.VCat C.MQuoted) <$> C.parsec  pretty :: [C.ModuleName] -> PP.Doc-pretty = PP.vcat . map C.pretty . nub . sortBy (cmp `on` C.prettyShow)+pretty+    = PP.vcat . map C.pretty+    . nub+    . sortBy (cmp `on` map strToLower . C.components)   where     cmp a b = case dropCommonPrefix a b of         ([], [])  -> EQ         ([], _:_) -> LT         (_:_, []) -> GT         (a', b')  -> compare a' b'++strToLower :: String -> String+strToLower = map toLower  dropCommonPrefix :: Eq a => [a] -> [a] -> ([a], [a]) dropCommonPrefix [] [] = ([], [])

@@ -4,7 +4,7 @@ {-# LANGUAGE DerivingStrategies         #-} {-# LANGUAGE FlexibleContexts           #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE FunctionalDependencies     #-} {-# LANGUAGE ScopedTypeVariables        #-} module CabalFmt.Monad (     -- * Monad class@@ -42,7 +42,7 @@ -- * errors of 'Error' -- * can list directories ---class (MonadReader Options m, MonadError Error m) => MonadCabalFmt m where+class (HasOptions r, MonadReader r m, MonadError Error m) => MonadCabalFmt r m | m -> r where     listDirectory      :: FilePath -> m [FilePath]     doesDirectoryExist :: FilePath -> m Bool     displayWarning     :: String -> m ()@@ -56,9 +56,9 @@ -- 'listDirectory' always return empty list. -- newtype CabalFmt a = CabalFmt { unCabalFmt :: ReaderT Options (Either Error) a }-  deriving newtype (Functor, Applicative, Monad, MonadReader Options, MonadError Error)+  deriving newtype (Functor, Applicative, Monad, MonadError Error, MonadReader Options) -instance MonadCabalFmt CabalFmt where+instance MonadCabalFmt Options CabalFmt where     listDirectory _      = return []     doesDirectoryExist _ = return False     displayWarning w     = do@@ -72,9 +72,18 @@ -- IO ------------------------------------------------------------------------------- -newtype CabalFmtIO a = CabalFmtIO { unCabalFmtIO :: ReaderT Options IO a }-  deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader Options)+-- | Options with root for directory traversals+data Options' = Options'+    { optRootDir :: Maybe FilePath+    , optOpt     :: Options+    } +instance HasOptions Options' where+    options f (Options' mfp o) = Options' mfp <$> f o++newtype CabalFmtIO a = CabalFmtIO { unCabalFmtIO :: ReaderT Options' IO a }+  deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader Options')+ instance MonadError Error CabalFmtIO where     throwError = liftIO . throwIO     catchError m h = CabalFmtIO $ ReaderT $ \r ->@@ -82,23 +91,31 @@       where         unCabalFmtIO' r m' = runReaderT (unCabalFmtIO m') r -instance MonadCabalFmt CabalFmtIO where-    listDirectory      = liftIO . D.listDirectory-    doesDirectoryExist = liftIO . D.doesDirectoryExist+instance MonadCabalFmt Options' CabalFmtIO where+    listDirectory p = do+        rd <- asks optRootDir+        case rd of+            Nothing -> return []+            Just d  -> liftIO (D.listDirectory (d </> p))+    doesDirectoryExist p = do+        rd <- asks optRootDir+        case rd of+            Nothing -> return False+            Just d  -> liftIO (D.doesDirectoryExist (d </> p))     displayWarning w   = do-        werror <- asks optError+        werror <- asks (optError . optOpt)         liftIO $ do             hPutStrLn stderr $ (if werror then "ERROR: " else "WARNING: ") ++ w             when werror exitFailure -runCabalFmtIO :: Options -> CabalFmtIO a -> IO (Either Error a)-runCabalFmtIO opts m = try $ runReaderT (unCabalFmtIO m) opts+runCabalFmtIO :: Maybe FilePath -> Options -> CabalFmtIO a -> IO (Either Error a)+runCabalFmtIO mfp opts m = try $ runReaderT (unCabalFmtIO m) (Options' mfp opts)  ------------------------------------------------------------------------------- -- Files ------------------------------------------------------------------------------- -getFiles :: MonadCabalFmt m => FilePath -> m [FilePath]+getFiles :: MonadCabalFmt r m => FilePath -> m [FilePath] getFiles = getDirectoryContentsRecursive' check where     check "dist-newstyle" = False     check ('.' : _)       = False@@ -112,7 +129,7 @@ -- -- /Note:/ From @Cabal@'s "Distribution.Simple.Utils" getDirectoryContentsRecursive'-    :: forall m. MonadCabalFmt m+    :: forall m r. MonadCabalFmt r m     => (FilePath -> Bool) -- ^ Check, whether to recurse     -> FilePath           -- ^ top dir     -> m [FilePath]

@@ -5,8 +5,11 @@     Options (..),     defaultOptions,     OptionsMorphism, mkOptionsMorphism, runOptionsMorphism,+    HasOptions(..),     ) where +import Distribution.Compat.Lens (LensLike')+ import qualified Distribution.CabalSpecVersion       as C  data Options = Options@@ -40,3 +43,8 @@     mempty  = OM id     mappend = (<>) +class HasOptions e where+    options :: Functor f => LensLike' f e Options++instance HasOptions Options where+    options = id

@@ -14,17 +14,17 @@ import CabalFmt.Error import CabalFmt.Monad -runParseResult :: MonadCabalFmt m => FilePath -> BS.ByteString -> C.ParseResult a -> m a+runParseResult :: MonadCabalFmt r m => FilePath -> BS.ByteString -> C.ParseResult a -> m a runParseResult filepath contents pr = case result of     Right gpd -> return gpd     Left (mspecVersion, errors) -> throwError $ CabalParseError filepath contents errors mspecVersion warnings   where     (warnings, result) = C.runParseResult pr -parseGpd :: MonadCabalFmt m => FilePath -> BS.ByteString -> m C.GenericPackageDescription+parseGpd :: MonadCabalFmt r m => FilePath -> BS.ByteString -> m C.GenericPackageDescription parseGpd filepath contents = runParseResult filepath contents $ C.parseGenericPackageDescription contents -parseFields :: MonadCabalFmt m => BS.ByteString -> m [C.Field C.Position]+parseFields :: MonadCabalFmt r m => BS.ByteString -> m [C.Field C.Position] parseFields contents = case C.readFields contents of     Left err -> throwError $ PanicCannotParseInput err     Right x  -> return x

@@ -26,10 +26,10 @@ -------------------------------------------------------------------------------  type C = (Comments, [Pragma])-type Refactoring           = forall m. MonadCabalFmt m => Refactoring' m-type Refactoring' m        = [C.Field C] -> m [C.Field C]-type RefactoringOfField    = forall m. MonadCabalFmt m => RefactoringOfField' m-type RefactoringOfField' m = C.Name C -> [C.FieldLine C] -> m (C.Name C, [C.FieldLine C])+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@@ -57,7 +57,7 @@             pure (name, newModules ++ fls)         | otherwise = pure (name, fls) -    parse :: MonadCabalFmt m => [Pragma] -> m [(FilePath, [C.ModuleName])]+    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@@ -79,7 +79,7 @@  traverseFields     :: Applicative f-    => RefactoringOfField' f+    => RefactoringOfField' r f     -> [C.Field C] -> f [C.Field C] traverseFields f = goMany where     goMany = traverse go