Lint -> Format, add in-place option

This commit is contained in:
Andrea Bedini 2023-04-27 12:54:29 +08:00
parent 360ad41bb7
commit 03ddd279a8
No known key found for this signature in database
GPG Key ID: F1CC67F04AAA7FD0
5 changed files with 103 additions and 51 deletions

88
app/Foliage/CmdFormat.hs Normal file
View File

@ -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/<name>/<version>/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
]

View File

@ -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/<name>/<version>/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

View File

@ -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

View File

@ -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

View File

@ -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,