{-# LANGUAGE TemplateHaskell #-}

-- | The Downgrade Command Parser
module Hasura.Server.Init.Arg.Command.Downgrade
  ( downgradeCommandParser,
  )
where

--------------------------------------------------------------------------------

import Data.FileEmbed qualified as Embed
import Data.String qualified as String
import Hasura.Prelude
import Hasura.Server.Init.Config qualified as Config
import Language.Haskell.TH.Syntax qualified as TH
import Options.Applicative qualified as Opt

--------------------------------------------------------------------------------

-- | This implements the mapping between application versions
-- and catalog schema versions.
downgradeShortcuts :: [(String, String)]
downgradeShortcuts :: [(String, String)]
downgradeShortcuts =
  $( do
       let s = $(Embed.makeRelativeToProject "src-rsr/catalog_versions.txt" >>= Embed.embedStringFile)

           parseVersions = map (parseVersion . words) . lines

           parseVersion [tag, version] = (tag, version)
           parseVersion other = error ("unrecognized tag/catalog mapping " ++ show other)
       TH.lift (parseVersions s)
   )

--------------------------------------------------------------------------------

downgradeCommandParser :: Opt.Parser Config.DowngradeOptions
downgradeCommandParser :: Parser DowngradeOptions
downgradeCommandParser =
  Text -> Bool -> DowngradeOptions
Config.DowngradeOptions
    (Text -> Bool -> DowngradeOptions)
-> Parser Text -> Parser (Bool -> DowngradeOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser Text] -> Parser Text
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      ( Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
          ( String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"to-catalog-version"
              Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"<VERSION>"
              Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The target catalog schema version (e.g. 31)"
          )
          Parser Text -> [Parser Text] -> [Parser Text]
forall a. a -> [a] -> [a]
: ((String, String) -> Parser Text)
-> [(String, String)] -> [Parser Text]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> Parser Text)
-> (String, String) -> Parser Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> Parser Text
forall {a}. IsString a => String -> String -> Parser a
shortcut) [(String, String)]
downgradeShortcuts
      )
    Parser (Bool -> DowngradeOptions)
-> Parser Bool -> Parser DowngradeOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
Opt.switch
      ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"dryRun"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Don't run any migrations, just print out the SQL."
      )
  where
    shortcut :: String -> String -> Parser a
shortcut String
v String
catalogVersion =
      a -> Mod FlagFields a -> Parser a
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag'
        (String -> a
forall a. IsString a => String -> a
String.fromString String
catalogVersion)
        ( String -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (String
"to-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
v)
            Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields a
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String
"Downgrade to graphql-engine version " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
v String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" (equivalent to --to-catalog-version " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
catalogVersion String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")")
        )