mirror of
https://github.com/input-output-hk/foliage.git
synced 2024-11-22 11:12:50 +03:00
Lint -> Format, add in-place option
This commit is contained in:
parent
360ad41bb7
commit
03ddd279a8
88
app/Foliage/CmdFormat.hs
Normal file
88
app/Foliage/CmdFormat.hs
Normal 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
|
||||
]
|
@ -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
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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,
|
||||
|
Loading…
Reference in New Issue
Block a user