{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE DuplicateRecordFields #-}


module Main where

import           Control.Monad.Logger
import           Control.Monad.Reader
import           Data.Bifunctor
import qualified Data.ByteString.UTF8          as UTF8
import           Data.Char
import           Data.List                      ( intercalate )
import           Data.Semigroup                 ( (<>) )
import           Data.String.QQ
import qualified Data.Text                     as T
import           Data.Versions
import           GHCup
import           GHCup.Logger
import           GHCup.File
import           GHCup.Prelude
import           GHCup.Types
import           Haskus.Utils.Variant.Excepts
import           Options.Applicative     hiding ( style )
import           System.Console.Pretty
import           System.Exit
import           URI.ByteString
import           Text.Layout.Table
import           Data.String.Interpolate





data Options = Options
  { optVerbose   :: Bool
  , optCache     :: Bool
  , optUrlSource :: Maybe URI
  , optCommand   :: Command
  }

data Command
  = InstallGHC InstallGHCOptions
  | InstallCabal InstallCabalOptions
  | SetGHC SetGHCOptions
  | List ListOptions
  | Rm RmOptions
  | DInfo

data ToolVersion = ToolVersion Version
                 | ToolTag Tag


data InstallGHCOptions = InstallGHCOptions
  { ghcVer :: Maybe ToolVersion
  }

data InstallCabalOptions = InstallCabalOptions
  { cabalVer :: Maybe ToolVersion
  }

data SetGHCOptions = SetGHCOptions
  { ghcVer :: Maybe ToolVersion
  }

data ListOptions = ListOptions
  { lTool     :: Maybe Tool
  , lCriteria :: Maybe ListCriteria
  }

data RmOptions = RmOptions
  { ghcVer :: Version
  }


opts :: Parser Options
opts =
  Options
    <$> switch
          (short 'v' <> long "verbose" <> help
            "Whether to enable verbosity (default: False)"
          )
    <*> switch
          (short 'c' <> long "cache" <> help
            "Whether to cache downloads (default: False)"
          )
    <*> (optional
          (option
            (eitherReader parseUri)
            (short 's' <> long "url-source" <> metavar "URL" <> help
              "Alternative ghcup download info url (default: internal)"
            )
          )
        )
    <*> com
 where
  parseUri s' =
    bimap show id $ parseURI strictURIParserOptions (UTF8.fromString s')

com :: Parser Command
com = subparser
  (  command
      "install-ghc"
      (   InstallGHC
      <$> (info (installGHCOpts <**> helper)
                (progDesc "Install a GHC version")
          )
      )
  <> command
       "install-cabal"
       (   InstallCabal
       <$> (info (installCabalOpts <**> helper)
                 (progDesc "Install a cabal-install version")
           )
       )
  <> command
       "set-ghc"
       (   SetGHC
       <$> (info (setGHCOpts <**> helper)
                 (progDesc "Set the currently active GHC version")
           )
       )
  <> command
       "list"
       (   List
       <$> (info (listOpts <**> helper)
                 (progDesc "Show available GHCs and other tools")
           )
       )
  <> command
       "rm"
       (   Rm
       <$> (info (rmOpts <**> helper)
                 (progDesc "Remove a GHC version installed by ghcup")
           )
       )
  <> command
       "debug-info"
       ((\_ -> DInfo) <$> (info (helper) (progDesc "Show debug info")))
  )

installGHCOpts :: Parser InstallGHCOptions
installGHCOpts = InstallGHCOptions <$> optional toolVersionParser


installCabalOpts :: Parser InstallCabalOptions
installCabalOpts = InstallCabalOptions <$> optional toolVersionParser

setGHCOpts :: Parser SetGHCOptions
setGHCOpts = SetGHCOptions <$> optional toolVersionParser

listOpts :: Parser ListOptions
listOpts =
  ListOptions
    <$> optional
          (option
            (eitherReader toolParser)
            (short 't' <> long "tool" <> metavar "<ghc|cabal>" <> help
              "Tool to list versions for. Default is all"
            )
          )
    <*> (optional
          (option
            (eitherReader criteriaParser)
            (  short 'c'
            <> long "show-criteria"
            <> metavar "<installed|set>"
            <> help "Show only installed or set tool versions"
            )
          )
        )

rmOpts :: Parser RmOptions
rmOpts =
  RmOptions
    <$> (option
          (eitherReader
            (bimap (const "Not a valid version") id . version . T.pack)
          )
          (short 'v' <> long "version" <> metavar "VERSION" <> help
            "The GHC version to remove"
          )
        )



versionParser :: Parser Version
versionParser = option
  (eitherReader (bimap (const "Not a valid version") id . version . T.pack))
  (short 'v' <> long "version" <> metavar "VERSION")


toolVersionParser :: Parser ToolVersion
toolVersionParser = verP <|> toolP
 where
  verP = ToolVersion <$> versionParser
  toolP =
    ToolTag
      <$> (option
            (eitherReader
              (\s' -> case fmap toLower s' of
                "recommended" -> Right Recommended
                "latest"      -> Right Latest
                other         -> Left ([i|Unknown tag #{other}|])
              )
            )
            (short 't' <> long "tag" <> metavar "TAG")
          )


toolParser :: String -> Either String Tool
toolParser s' | t == T.pack "ghc"   = Right GHC
              | t == T.pack "cabal" = Right Cabal
              | otherwise           = Left ("Unknown tool: " <> s')
  where t = T.toLower (T.pack s')


criteriaParser :: String -> Either String ListCriteria
criteriaParser s' | t == T.pack "installed" = Right ListInstalled
                  | t == T.pack "set"       = Right ListSet
                  | otherwise               = Left ("Unknown criteria: " <> s')
  where t = T.toLower (T.pack s')


toSettings :: Options -> Settings
toSettings Options {..} =
  let cache     = optCache
      urlSource = maybe GHCupURL OwnSource optUrlSource
  in  Settings { .. }


-- TODO: something better than Show instance for errors

main :: IO ()
main = do
  -- logger interpreter
  let runLogger = myLoggerTStderr

  customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
    >>= \opt@Options {..} -> do
          let settings = toSettings opt
          -- wrapper to run effects with settings
          let runInstTool =
                runLogger
                  . flip runReaderT settings
                  . runE
                    @'[ AlreadyInstalled
                      , ArchiveError
                      , DistroNotFound
                      , FileDoesNotExistError
                      , FileError
                      , JSONError
                      , NoCompatibleArch
                      , NoDownload
                      , NotInstalled
                      , PlatformResultError
                      , ProcessError
                      , TagNotFound
                      , URLException
                      ]

          let runSetGHC =
                runLogger
                  . flip runReaderT settings
                  . runE
                    @'[ FileDoesNotExistError
                      , NotInstalled
                      , TagNotFound
                      , URLException
                      , JSONError
                      , TagNotFound
                      ]

          let runListGHC =
                runLogger
                  . flip runReaderT settings
                  . runE @'[FileDoesNotExistError , URLException , JSONError]

          let runRmGHC =
                runLogger . flip runReaderT settings . runE @'[NotInstalled]

          let runDebugInfo =
                runLogger
                  . flip runReaderT settings
                  . runE
                    @'[PlatformResultError , NoCompatibleArch , DistroNotFound]

          case optCommand of
            InstallGHC (InstallGHCOptions {..}) ->
              void
                $   (runInstTool $ do
                      av <- liftE getDownloads
                      v  <- liftE $ fromVersion av ghcVer GHC
                      liftE $ installTool (ToolRequest GHC v) Nothing
                    )
                >>= \case
                      VRight _ -> runLogger
                        $ $(logInfo) ([s|GHC installation successful|])
                      VLeft (V (AlreadyInstalled treq)) ->
                        runLogger $ $(logWarn)
                          (T.pack (show treq) <> [s| already installed|])
                      VLeft e ->
                        runLogger ($(logError) [i|#{e}|]) >> exitFailure
            InstallCabal (InstallCabalOptions {..}) ->
              void
                $   (runInstTool $ do
                      av <- liftE getDownloads
                      v  <- liftE $ fromVersion av cabalVer Cabal
                      liftE $ installTool (ToolRequest Cabal v) Nothing
                    )
                >>= \case
                      VRight _ -> runLogger
                        $ $(logInfo) ([s|Cabal installation successful|])
                      VLeft (V (AlreadyInstalled treq)) ->
                        runLogger $ $(logWarn)
                          (T.pack (show treq) <> [s| already installed|])
                      VLeft e ->
                        runLogger ($(logError) [i|#{e}|]) >> exitFailure

            SetGHC (SetGHCOptions {..}) ->
              void
                $   (runSetGHC $ do
                      av <- liftE getDownloads
                      v  <- liftE $ fromVersion av ghcVer GHC
                      liftE $ setGHC v SetGHCOnly
                    )
                >>= \case
                      VRight _ ->
                        runLogger $ $(logInfo) ([s|GHC successfully set|])
                      VLeft e ->
                        runLogger ($(logError) [i|#{e}|]) >> exitFailure

            List (ListOptions {..}) ->
              void
                $   (runListGHC $ do
                      liftE $ listVersions lTool lCriteria
                    )
                >>= \case
                      VRight r -> liftIO $ printListResult r
                      VLeft e ->
                        runLogger ($(logError) [i|#{e}|]) >> exitFailure

            Rm (RmOptions {..}) ->
              void
                $   (runRmGHC $ do
                      liftE $ rmGHCVer ghcVer
                    )
                >>= \case
                      VRight _ -> pure ()
                      VLeft e ->
                        runLogger ($(logError) [i|#{e}|]) >> exitFailure

            DInfo -> do
              void
                $   (runDebugInfo $ do
                      liftE $ getDebugInfo
                    )
                >>= \case
                      VRight dinfo -> putStrLn $ show dinfo
                      VLeft e ->
                        runLogger ($(logError) [i|#{e}|]) >> exitFailure
  pure ()


fromVersion :: Monad m
            => AvailableDownloads
            -> Maybe ToolVersion
            -> Tool
            -> Excepts '[TagNotFound] m Version
fromVersion av Nothing tool =
  getRecommended av tool ?? TagNotFound Recommended tool
fromVersion _ (Just (ToolVersion v)) _ = pure v
fromVersion av (Just (ToolTag Latest)) tool =
  getLatest av tool ?? TagNotFound Latest tool
fromVersion av (Just (ToolTag Recommended)) tool =
  getRecommended av tool ?? TagNotFound Recommended tool


printListResult :: [ListResult] -> IO ()
printListResult lr = do
  let
    formatted =
      gridString
          [ column expand left def def
          , column expand left def def
          , column expand left def def
          , column expand left def def
          ]
        $ fmap
            (\ListResult {..} ->
              [ if
                | lSet       -> (color Green "✔✔")
                | lInstalled -> (color Green "✓")
                | otherwise  -> (color Red "✗")
              , fmap toLower . show $ lTool
              , T.unpack . prettyVer $ lVer
              , intercalate "," $ ((fmap . fmap) toLower . fmap show $ lTag)
              ]
            )
            lr
  putStrLn $ formatted