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


module Main where

import           Control.Monad.Logger
import           Control.Monad.Reader
import           Control.Monad.IO.Class
import           Data.Bifunctor
import           Data.ByteString                ( ByteString )
import qualified Data.ByteString.UTF8          as UTF8
import           Data.Char
import           Data.Functor                   ( (<&>) )
import           Data.List                      ( intercalate )
import qualified Data.Map                      as M
import           Data.Maybe
import           Data.Semigroup                 ( (<>) )
import           Data.String.QQ
import           Data.Text                      ( Text )
import qualified Data.Text                     as T
import qualified Data.Text.Encoding            as E
import           Data.Traversable
import           Data.Versions
import           GHCup
import           GHCup.Logger
import           GHCup.File
import           GHCup.Prelude
import           GHCup.Types
import           Haskus.Utils.Variant.Excepts
import           HPath
import           Options.Applicative     hiding ( style )
import           System.Console.Pretty
import           System.Exit
import           URI.ByteString
import           Text.Layout.Table





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

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

data InstallGHCOptions = InstallGHCOptions
  { ghcVer :: Maybe Version
  }

data InstallCabalOptions = InstallCabalOptions
  { cabalVer :: Maybe Version
  }

data SetGHCOptions = SetGHCOptions
  { ghcVer :: Maybe Version
  }

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")
           )
       )
  )

installGHCOpts :: Parser InstallGHCOptions
installGHCOpts = InstallGHCOptions <$> optional
  (option
    (eitherReader
      (\s -> bimap (const "Not a valid version") id . version . T.pack $ s)
    )
    (short 'v' <> long "version" <> metavar "VERSION" <> help
      "The GHC version to install"
    )
  )


installCabalOpts :: Parser InstallCabalOptions
installCabalOpts = InstallCabalOptions <$> optional
  (option
    (eitherReader
      (\s -> bimap (const "Not a valid version") id . version . T.pack $ s)
    )
    (short 'v' <> long "version" <> metavar "VERSION" <> help
      "The Cabal version to install"
    )
  )

setGHCOpts :: Parser SetGHCOptions
setGHCOpts = SetGHCOptions <$> optional
  (option
    (eitherReader
      (\s -> bimap (const "Not a valid version") id . version . T.pack $ s)
    )
    (short 'v' <> long "version" <> metavar "VERSION" <> help
      "The GHC version to set (default: recommended)"
    )
  )

listOpts :: Parser ListOptions
listOpts =
  ListOptions
    <$> optional
          (option
            (eitherReader toolParser)
            (short 't' <> long "tool" <> metavar "<ghc|cabal>" <> help
              "Tool to list versions for. Default is ghc only."
            )
          )
    <*> (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
      (\s -> bimap (const "Not a valid version") id . version . T.pack $ s)
    )
    (short 'v' <> long "version" <> metavar "VERSION" <> help
      "The GHC version to remove"
    )
  )



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
                    @'[ FileError
                      , ArchiveError
                      , ProcessError
                      , URLException
                      , PlatformResultError
                      , NoDownload
                      , NoCompatibleArch
                      , DistroNotFound
                      , TagNotFound
                      , AlreadyInstalled
                      , NotInstalled
                      , JSONError
                      ]

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

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

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

          case optCommand of
            InstallGHC (InstallGHCOptions {..}) ->
              void
                $   (runInstTool $ do
                      av <- liftE getDownloads
                      v <- maybe
                        (  getRecommended av GHC
                        ?? TagNotFound Recommended GHC
                        )
                        pure
                        ghcVer
                      av <- liftE getDownloads
                      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 -> die (color Red $ show e)
            InstallCabal (InstallCabalOptions {..}) ->
              void
                $   (runInstTool $ do
                      av <- liftE getDownloads
                      v <- maybe
                        (  getRecommended av Cabal
                        ?? TagNotFound Recommended Cabal
                        )
                        pure
                        cabalVer
                      av <- liftE getDownloads
                      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 -> die (color Red $ show e)

            SetGHC (SetGHCOptions {..}) ->
              void
                $   (runSetGHC $ do
                      av <- liftE getDownloads
                      v <- maybe
                        (  getRecommended av GHC
                        ?? TagNotFound Recommended GHC
                        )
                        pure
                        ghcVer
                      liftE $ setGHC v SetGHCOnly
                    )
                >>= \case
                      VRight _ ->
                        runLogger $ $(logInfo) ([s|GHC successfully set|])
                      VLeft e -> die (color Red $ show e)

            List (ListOptions {..}) ->
              void
                $   (runListGHC $ do
                      liftE $ listVersions lTool lCriteria
                    )
                >>= \case
                      VRight r -> liftIO $ printListResult r
                      VLeft  e -> die (color Red $ show e)

            Rm (RmOptions {..}) ->
              void
                $   (runRmGHC $ do
                      liftE $ rmGHCVer ghcVer
                    )
                >>= \case
                      VRight _ -> pure ()
                      VLeft  e -> die (color Red $ show e)

  pure ()


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