diff --git a/app/Foliage/CmdFormat.hs b/app/Foliage/CmdFormat.hs new file mode 100644 index 0000000..be6163c --- /dev/null +++ b/app/Foliage/CmdFormat.hs @@ -0,0 +1,88 @@ +module Foliage.CmdFormat (cmdFormat, formatOptionsParser, FormatOptions) where + +import Control.Monad (unless, void, when) +import Data.Algorithm.Diff qualified as Diff +import Data.Algorithm.DiffOutput qualified as Diff +import Data.Text qualified as T +import Data.Text.IO qualified as T +import Development.Shake +import Foliage.Meta (UTCTime, parsePackageVersionSpec, prettyPackageVersionSpec) +import Options.Applicative +import System.FilePath (()) + +data FormatOptions = FormatOptions + { formatOptsInputDir :: FilePath, + formatOptsInPlace :: Bool + } + +formatOptionsParser :: Parser FormatOptions +formatOptionsParser = + FormatOptions + <$> strOption + ( long "input-directory" + <> metavar "INPUT" + <> help "Repository input directory" + <> showDefault + <> value "_sources" + ) + <*> switch + ( long "in-place" + <> help "Whether to re-write files in-place" + <> showDefault + ) + +cmdFormat :: FormatOptions -> IO () +cmdFormat formatOptions = do + shake opts $ + do + phony "formatAction" (formatAction formatOptions) + want ["formatAction"] + where + cacheDir = "_cache" + opts = shakeOptions {shakeFiles = cacheDir, shakeVerbosity = Verbose} + +data IndexEvent + = PublicationEvent {timestamp :: UTCTime, meta :: FilePath} + | MetadataRevisionEvent {timestamp :: UTCTime, meta :: FilePath, revNum :: Int} + deriving (Eq, Show) + +formatAction :: FormatOptions -> Action () +formatAction + FormatOptions + { formatOptsInputDir = inputDir, + formatOptsInPlace = inplace + } = do + metaFiles <- getDirectoryFiles inputDir ["*/*/meta.toml"] + + when (null metaFiles) $ do + error $ + unlines + [ "We could not find any package metadata file (i.e. _sources///meta.toml)", + "Make sure you are passing the right input directory. The default input directory is _sources" + ] + + void $ forP metaFiles $ \metaFile -> do + let fp = inputDir metaFile + orig <- liftIO $ T.readFile fp + case parsePackageVersionSpec orig of + Left err -> + putError $ + unlines + [ "Error parsing " <> fp, + T.unpack err + ] + Right parsed -> do + let reformatted = prettyPackageVersionSpec parsed + diff = Diff.getGroupedDiff (lines $ T.unpack orig) (lines $ T.unpack reformatted) + + unless (null diff) $ + if inplace + then do + putWarn $ "Rewriting " <> fp + liftIO $ T.writeFile fp reformatted + else + putWarn $ + unlines + [ "I would rewrite " <> fp <> " as follows. Pass --in-place to do this automatically.", + Diff.ppDiff diff + ] diff --git a/app/Foliage/CmdLint.hs b/app/Foliage/CmdLint.hs deleted file mode 100644 index 5e68a9b..0000000 --- a/app/Foliage/CmdLint.hs +++ /dev/null @@ -1,46 +0,0 @@ -module Foliage.CmdLint (cmdLint, lintOptionsParser, LintOptions) where - -import Control.Monad (void, when) -import Development.Shake -import Foliage.Meta (readPackageVersionSpec, writePackageVersionSpec) -import Options.Applicative -import System.FilePath (()) - -newtype LintOptions = LintOptions {lintOptsInputDir :: FilePath} - -lintOptionsParser :: Parser LintOptions -lintOptionsParser = - LintOptions - <$> strOption - ( long "input-directory" - <> metavar "INPUT" - <> help "Repository input directory" - <> showDefault - <> value "_sources" - ) - -cmdLint :: LintOptions -> IO () -cmdLint buildOptions = do - shake opts $ - do - phony "lintAction" (lintAction buildOptions) - want ["lintAction"] - where - cacheDir = "_cache" - opts = shakeOptions {shakeFiles = cacheDir, shakeVerbosity = Verbose} - -lintAction :: LintOptions -> Action () -lintAction LintOptions {lintOptsInputDir = inputDir} = do - metaFiles <- getDirectoryFiles inputDir ["*/*/meta.toml"] - - when (null metaFiles) $ do - error $ - unlines - [ "We could not find any package metadata file (i.e. _sources///meta.toml)", - "Make sure you are passing the right input directory. The default input directory is _sources" - ] - - void $ forP metaFiles $ \metaFile -> - traced ("rewriting " <> metaFile) $ - let fp = inputDir metaFile - in readPackageVersionSpec fp >>= writePackageVersionSpec fp diff --git a/app/Foliage/Meta.hs b/app/Foliage/Meta.hs index 7130367..160e0a8 100644 --- a/app/Foliage/Meta.hs +++ b/app/Foliage/Meta.hs @@ -31,11 +31,14 @@ module Foliage.Meta UTCTime, latestRevisionNumber, consolidateRanges, + prettyPackageVersionSpec, + parsePackageVersionSpec, ) where import Control.Applicative ((<|>)) import Control.Monad (void) +import Data.Bifunctor (first) import Data.List (sortOn) import Data.Maybe (fromMaybe) import Data.Ord (Down (Down)) @@ -198,6 +201,12 @@ readPackageVersionSpec = Toml.decodeFile sourceMetaCodec writePackageVersionSpec :: FilePath -> PackageVersionSpec -> IO () writePackageVersionSpec fp a = void $ Toml.encodeToFile sourceMetaCodec fp a +parsePackageVersionSpec :: Text -> Either Text PackageVersionSpec +parsePackageVersionSpec = first Toml.prettyTomlDecodeErrors . Toml.decode sourceMetaCodec + +prettyPackageVersionSpec :: PackageVersionSpec -> Text +prettyPackageVersionSpec = Toml.encode sourceMetaCodec + data RevisionSpec = RevisionSpec { revisionTimestamp :: UTCTime, revisionNumber :: Int diff --git a/app/Main.hs b/app/Main.hs index eff4a49..1b2ce17 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -4,8 +4,8 @@ module Main where import Foliage.CmdBuild (BuildOptions, buildOptionsParser, cmdBuild) import Foliage.CmdCreateKeys (CreateKeysOptions, cmdCreateKeys, createKeysOptionsParser) +import Foliage.CmdFormat (FormatOptions, cmdFormat, formatOptionsParser) import Foliage.CmdImportIndex (ImportIndexOptions, cmdImportIndex, importIndexOptionsParser) -import Foliage.CmdLint (LintOptions, cmdLint, lintOptionsParser) import Main.Utf8 (withUtf8) import Options.Applicative @@ -13,7 +13,7 @@ data Command = CreateKeys CreateKeysOptions | Build BuildOptions | ImportIndex ImportIndexOptions - | Lint LintOptions + | Format FormatOptions parseCommand :: IO Command parseCommand = @@ -33,7 +33,7 @@ optionsParser = [ command "create-keys" (info (CreateKeys <$> createKeysOptionsParser) (progDesc "Create TUF keys")), command "build" (info (Build <$> buildOptionsParser) (progDesc "Build repository")), command "import-index" (info (ImportIndex <$> importIndexOptionsParser) (progDesc "Import from Hackage index")), - command "lint" (info (Lint <$> lintOptionsParser) (progDesc "Lint metadata files in-place")) + command "format" (info (Format <$> formatOptionsParser) (progDesc "Format metadata files")) ] main :: IO () @@ -43,4 +43,4 @@ main = withUtf8 $ do CreateKeys path -> cmdCreateKeys path Build buildOpts -> cmdBuild buildOpts ImportIndex importIndexOpts -> cmdImportIndex importIndexOpts - Lint lintOpts -> cmdLint lintOpts + Format formatOpts -> cmdFormat formatOpts diff --git a/foliage.cabal b/foliage.cabal index ddffb05..e0e468b 100644 --- a/foliage.cabal +++ b/foliage.cabal @@ -22,7 +22,7 @@ executable foliage Foliage.CmdBuild Foliage.CmdCreateKeys Foliage.CmdImportIndex - Foliage.CmdLint + Foliage.CmdFormat Foliage.HackageSecurity Foliage.Meta Foliage.Meta.Aeson @@ -53,6 +53,7 @@ executable foliage cabal-install >=3.8 && <3.9, containers >=0.6.5.1 && <0.7, cryptohash-sha256 >=0.11.102.1 && <0.12, + Diff ^>=0.4.1, directory >=1.3.6.0 && <1.4, filepath >=1.4.2.1 && <1.5, hackage-security >=0.6.2.1 && <0.7,