{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
module Database.Migrate.Main (defaultMain, defaultMain') where

import qualified Paths_database_migrate as Program (version)

import Control.Monad
import Control.Monad.Trans.Either
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Writer
import Control.Monad.Trans.Maybe

import qualified Data.Text as T
import Data.Maybe
import Data.Version (showVersion)

import Database.Migrate.Data
import Database.Migrate.Kernel
import Database.Migrate.Loader
import Database.Migrate.PostgreSQL

import qualified Database.PostgreSQL.Simple as PG

import System.Console.CmdArgs.Explicit
import System.Directory
import System.FilePath
import System.Exit
import System.Environment (getArgs)
import System.IO

ignore :: Arg Arguments
ignore = flagArg (\_ a -> Right a) ""

e :: String
e = ""

usage = [
    "usage: db migrate [-v|--verbose] [-d|--dry-run]"
  , "       db up [-v|--verbose] [-d|--dry-run]"
  , "       db down [-v|--verbose] [-d|--dry-run]"
  , "       db apply [-v|--verbose] [-d|--dry-run]"
  , "       db -h|--help"
  , "       db -V|--version"
  ]


globalflags :: [Flag Arguments]
globalflags = [
    flagNone [ "h", "help" ]     (\a -> a { adbmode = HelpMode })    e
  , flagNone [ "V", "version" ]  (\a -> a { adbmode = VersionMode }) e
  ]

connectflags :: [Flag Arguments]
connectflags = [
    flagNone [ "v", "verbose" ]    (\a -> a { averbose = True }) e
  , flagNone [ "d", "dry-run" ]    (\a -> a { adry = True }) e
  ]

versionflag = (flagArg (\v a -> Right $ a { aversion = Just v }) "VERSION")

cmdmodes :: String -> Arguments -> Mode Arguments
cmdmodes cmd initial =
  modes cmd initial "" [
      mode "migrate" (initial { adbmode = MigrateMode }) "" ignore connectflags
    , mode "up" (initial { adbmode = UpMode }) "" versionflag connectflags
    , mode "down" (initial { adbmode = DownMode }) "" versionflag connectflags
    , mode "apply" (initial { adbmode = ApplyMode }) "" versionflag connectflags
    , mode "help" (initial { adbmode = HelpMode }) "" ignore []
    , mode "version" (initial { adbmode = VersionMode }) "" ignore []
    ]

data DbMode =
    HelpMode
  | VersionMode
  | MigrateMode
  | UpMode
  | DownMode
  | ApplyMode
  deriving (Eq, Show)

data Arguments = Arguments {
    adbmode :: DbMode
  , adry :: Bool
  , averbose :: Bool
  , ascripts :: String
  , aversion :: Maybe String
  } deriving (Eq, Show)

defaultArguments cwd = Arguments {
    adbmode = HelpMode
  , adry = False
  , averbose = False
  , ascripts = cwd </> "migrations"
  , aversion = Nothing
  }

defaultMain :: Migrations -> MigrateDatabase IO c -> IO c -> IO ()
defaultMain migrationstore db connector = getArgs >>= defaultMain' migrationstore db connector

defaultMain' :: Migrations -> MigrateDatabase IO c -> IO c -> [String] -> IO ()
defaultMain' migrationstore db connector args =
  getCurrentDirectory >>= \cwd ->
    case process ((cmdmodes "migrate" (defaultArguments cwd)) {modeGroupFlags = toGroup $ globalflags} ) args of
      Left x ->  hPutStrLn stderr x >> exitFailure
      Right x -> run migrationstore db connector x

run :: Migrations -> MigrateDatabase IO c -> IO c -> Arguments -> IO ()
run migrationstore db' connector args =
  let db = if adry args then dryrun db' else db'
  in case adbmode args of
    HelpMode -> mapM_ putStrLn usage
    VersionMode -> putStrLn $ "migrate " ++ showVersion Program.version
    MigrateMode -> connector  >>= \c -> (executeMigrate migrationstore c $ migrate db) >>= print
    UpMode -> connector >>= \c -> (executeMigrate migrationstore c $ upmode db) >>= print
    DownMode -> connector >>= \c -> (executeMigrate migrationstore c $ downmode db) >>= print
    ApplyMode -> connector >>= \c -> (executeMigrate migrationstore c $ applymode db) >>= print

bomb failwith =
  putStrLn failwith >> exitFailure

upmode :: MigrateDatabase m c -> Migrate c m ()
upmode = undefined

downmode :: MigrateDatabase m c -> Migrate c m ()
downmode = undefined

applymode :: MigrateDatabase m c -> Migrate c m ()
applymode = undefined