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

@@ -48,6 +48,7 @@ library:
     - extra
     - http-conduit
     - optparse-applicative
+    - restylers
     - yaml
 
 executables:

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

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

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
+      }