From 989b18c1a21620dbcd4369628b0036a3c9b16c6b Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Tue, 1 Aug 2023 10:07:49 -0400 Subject: [PATCH] Re-use restylers manifest logic in promote This prevents bugs, such as when restylers require careful test-case extension handling. Without this, we found refmt's tests didn't work under the `.example` extensions used by promote, for example. --- promote/package.yaml | 1 + promote/promote.cabal | 3 +- .../src/Restyled/Promote/IntegrationTest.hs | 10 +- .../Restyled/Promote/IntegrationTest/Setup.hs | 132 ++++-------------- 4 files changed, 41 insertions(+), 105 deletions(-) diff --git a/promote/package.yaml b/promote/package.yaml index c11a0be..2cd498f 100644 --- a/promote/package.yaml +++ b/promote/package.yaml @@ -48,6 +48,7 @@ library: - extra - http-conduit - optparse-applicative + - restylers - yaml executables: diff --git a/promote/promote.cabal b/promote/promote.cabal index b58bccb..c01b33d 100644 --- a/promote/promote.cabal +++ b/promote/promote.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: b6b9ef5315e3920871a400d60154fc8833b08cb33bd59ed41104757784d547e5 +-- hash: eefcf35860c9b803cdf7e42d2e22c0f9f580efa0cb7b456e7a9a66b18602d596 name: promote version: 0.0.0.0 @@ -55,6 +55,7 @@ library , extra , http-conduit , optparse-applicative + , restylers , rio , yaml default-language: Haskell2010 diff --git a/promote/src/Restyled/Promote/IntegrationTest.hs b/promote/src/Restyled/Promote/IntegrationTest.hs index 983b67a..544e626 100644 --- a/promote/src/Restyled/Promote/IntegrationTest.hs +++ b/promote/src/Restyled/Promote/IntegrationTest.hs @@ -83,13 +83,19 @@ runIntegrationTest channel IntegrationTestOptions {..} = do setupManifestTestFiles channel manifest - void - $ andM + result <- + andM [ git "add" ["."] , git "commit" ["-m", "Update test case files"] , True <$ git_ "push" [] ] + if result + then do + logInfo "Test case files updated, delaying to see pushed updates" + threadDelay $ 3 * 1000000 + else logWarn "Test case files not updated" + proc "docker" ( concat diff --git a/promote/src/Restyled/Promote/IntegrationTest/Setup.hs b/promote/src/Restyled/Promote/IntegrationTest/Setup.hs index e70c941..3474623 100644 --- a/promote/src/Restyled/Promote/IntegrationTest/Setup.hs +++ b/promote/src/Restyled/Promote/IntegrationTest/Setup.hs @@ -9,68 +9,12 @@ import RIO import Data.Aeson import qualified Data.Yaml as Yaml -import RIO.Directory (createDirectoryIfMissing) -import RIO.FilePath (takeDirectory, (<.>), ()) -import RIO.List (headMaybe) -import qualified RIO.Map as Map -import RIO.Text (unpack) import qualified RIO.Text as T import Restyled.Promote.Channel - -data Restyler = Restyler - { name :: Text - , include :: [Text] - , metadata :: Maybe Metadata - } - deriving stock (Generic) - deriving anyclass (FromJSON) - -newtype Metadata = Metadata - { tests :: Maybe [TestCase] - } - deriving stock (Generic) - deriving anyclass (FromJSON) - -data TestCase = TestCase - { support :: Maybe SupportFile - , extension :: Maybe Text - , contents :: Text - } - deriving stock (Generic) - deriving anyclass (FromJSON) - -testCaseFiles - :: Text - -- ^ Restyler name - -> Maybe Text - -- ^ Inferred extension - -> Int - -- ^ Index - -> TestCase - -> [(FilePath, Text)] -testCaseFiles name inferredExtension n TestCase {support, extension, contents} - | "\r\n" `T.isInfixOf` contents = - [] - | otherwise = - maybeToList (supportFile <$> support) - <> [ - ( unpack name baseName - , contents - ) - ] - where - baseName = "test-file-" <> show @Int n <.> unpack finalExtension - finalExtension = fromMaybe "example" $ extension <|> inferredExtension - -data SupportFile = SupportFile - { path :: FilePath - , contents :: Text - } - deriving stock (Generic) - deriving anyclass (FromJSON) - -supportFile :: SupportFile -> (FilePath, Text) -supportFile SupportFile {path, contents} = (path, contents) +import Restylers.Info.Metadata +import Restylers.Info.Test +import Restylers.Manifest +import Restylers.Name data Restylers = Restylers { restylers_version :: Text @@ -89,55 +33,39 @@ data ConfigRestyler = ConfigRestyler toConfigRestyler :: Restyler -> ConfigRestyler toConfigRestyler Restyler {name} = - ConfigRestyler {name, enabled = True, include = name <> "/**/*"} + -- include matches writeTestFiles: ./{name}-test-{n}.{extension} + ConfigRestyler + { name = unRestylerName name + , enabled = True + , include = unRestylerName name <> "-test-*" + } setupManifestTestFiles :: (MonadIO m, MonadReader env m, HasLogFunc env) => Channel -> FilePath -> m () -setupManifestTestFiles channel = - writeFiles . toFiles channel <=< Yaml.decodeFileThrow +setupManifestTestFiles channel path = do + restylers <- Yaml.decodeFileThrow path + createRestylersYaml channel restylers -toFiles :: Channel -> [Restyler] -> Map FilePath Text -toFiles channel restylers = - Map.fromList - $ (".restyled.yaml", restylersYaml) - : concatMap toTestFiles restylers - where - restylersYaml = - decodeUtf8With lenientDecode - $ Yaml.encode - $ Restylers - { restylers_version = channelName channel - , restylers = map toConfigRestyler restylers - } + for_ restylers $ \Restyler {name, include, metadata = Metadata {tests}} -> + for_ (zip [0 ..] tests) $ \(n, test) -> + -- Skip whitespace test that can't be committed + unless ("\r\n" `T.isInfixOf` contents test) $ do + writeTestFiles n name include test -toTestFiles :: Restyler -> [(FilePath, Text)] -toTestFiles Restyler {name, include, metadata} = fromMaybe [] $ do - Metadata {tests} <- metadata - - let mExtension = - headMaybe - . filter ("." `T.isInfixOf`) - . filter (not . ("!" `T.isPrefixOf`)) - $ include - - concat . zipWith (testCaseFiles name mExtension) [0 ..] <$> tests - -writeFiles +createRestylersYaml :: (MonadIO m, MonadReader env m, HasLogFunc env) - => Map FilePath Text + => Channel + -> [Restyler] -> m () -writeFiles files = do - -- directories <- - -- filterM doesDirectoryExist - -- $ filter (/= ".") - -- $ map takeDirectory - -- $ Map.keys files - -- traverse_ removeDirectoryRecursive directories - - for_ (Map.toList files) $ \(path, contents) -> do - logInfo $ "CREATE " <> fromString path - createDirectoryIfMissing True $ takeDirectory path - writeFileUtf8 path contents +createRestylersYaml channel restylers = do + logInfo "CREATE .restyled.yaml" + writeFileUtf8 ".restyled.yaml" + $ decodeUtf8With lenientDecode + $ Yaml.encode + $ Restylers + { restylers_version = channelName channel + , restylers = map toConfigRestyler restylers + }