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

module BrickMain where

import           GHCup
import           GHCup.Download
import           GHCup.Errors
import           GHCup.Types
import           GHCup.Utils
import           GHCup.Utils.File
import           GHCup.Utils.Logger

import           Brick
import           Brick.Widgets.Border
import           Brick.Widgets.Border.Style
import           Brick.Widgets.Center
import           Brick.Widgets.List
import           Codec.Archive
import           Control.Exception.Safe
import           Control.Monad.Logger
import           Control.Monad.Reader
import           Control.Monad.Trans.Resource
import           Data.Bool
import           Data.Functor
import           Data.List
import           Data.Maybe
import           Data.Char
import           Data.IORef
import           Data.String.Interpolate
import           Data.Vector                    ( Vector )
import           Data.Versions           hiding ( str )
import           Haskus.Utils.Variant.Excepts
import           Prelude                 hiding ( appendFile )
import           System.Exit
import           System.IO.Unsafe
import           URI.ByteString

import qualified Data.Text                     as T
import qualified Graphics.Vty                  as Vty
import qualified Data.Vector                   as V


data AppState = AppState {
    lr :: LR
  , dls :: GHCupDownloads
}

type LR = GenericList String Vector ListResult


keyHandlers :: [(Char, String, AppState -> EventM n (Next AppState))]
keyHandlers =
  [ ('q', "Quit"     , halt)
  , ('i', "Install"  , withIOAction install')
  , ('u', "Uninstall", withIOAction del')
  , ('s', "Set"      , withIOAction set')
  , ('c', "ChangeLog", withIOAction changelog')
  ]


ui :: AppState -> Widget String
ui AppState {..} =
  ( padBottom Max
    $ ( withBorderStyle unicode
      $ borderWithLabel (str "GHCup")
      $ (center $ renderList renderItem True lr)
      )
    )
    <=> ( withAttr "help"
        . txtWrap
        . T.pack
        . foldr1 (\x y -> x <> "  " <> y)
        . (++ ["↑↓:Navigation"])
        $ (fmap (\(c, s, _) -> (c : ':' : s)) keyHandlers)
        )

 where
  renderItem b ListResult {..} =
    let marks = if
          | lSet       -> (withAttr "set" $ str "✔✔")
          | lInstalled -> (withAttr "installed" $ str "✓ ")
          | otherwise  -> (withAttr "not-installed" $ str "✗ ")
        ver = case lCross of
          Nothing -> T.unpack . prettyVer $ lVer
          Just c  -> T.unpack (c <> "-" <> prettyVer lVer)
    in  (   marks
        <+> ( padLeft (Pad 2)
            $ minHSize 20
            $ (withAttr
                (bool "inactive" "active" b)
                (str $ (fmap toLower . show $ lTool) <> " " <> ver)
              )
            )
        <+> (padLeft (Pad 1) $ if null lTag
              then emptyWidget
              else
                foldr1 (\x y -> x <+> str "," <+> y)
                  $ (fmap printTag $ sort lTag)
            )
        )

  printTag Recommended        = withAttr "recommended" $ str "recommended"
  printTag Latest             = withAttr "latest" $ str "latest"
  printTag (Base       pvp'') = str ("base-" ++ T.unpack (prettyPVP pvp''))
  printTag (UnknownTag t    ) = str t


minHSize :: Int -> Widget n -> Widget n
minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ')


app :: App AppState e String
app = App { appDraw         = \st -> [ui st]
          , appHandleEvent  = eventHandler
          , appStartEvent   = return
          , appAttrMap      = const theMap
          , appChooseCursor = neverShowCursor
          }
 where
  theMap = attrMap
    Vty.defAttr
    [ ("active"       , bg Vty.blue)
    , ("not-installed", fg Vty.red)
    , ("set"          , fg Vty.green)
    , ("installed"    , fg Vty.green)
    , ("recommended"  , fg Vty.green)
    , ("latest"       , fg Vty.yellow)
    , ("help"         , Vty.defAttr `Vty.withStyle` Vty.italic)
    ]


eventHandler :: AppState -> BrickEvent n e -> EventM n (Next AppState)
eventHandler st (VtyEvent (Vty.EvResize _               _)) = continue st
eventHandler st (VtyEvent (Vty.EvKey    (Vty.KChar 'q') _)) = halt st
eventHandler st (VtyEvent (Vty.EvKey    Vty.KEsc        _)) = halt st
eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KUp) _)) =
  continue (AppState (listMoveUp lr) dls)
eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KDown) _)) =
  continue (AppState (listMoveDown lr) dls)
eventHandler as (VtyEvent (Vty.EvKey (Vty.KChar c) _)) =
  case find (\(c', _, _) -> c' == c) keyHandlers of
    Nothing              -> continue as
    Just (_, _, handler) -> handler as
eventHandler st _ = continue st


-- | Suspend the current UI and run an IO action in terminal. If the
-- IO action returns a Left value, then it's thrown as userError.
withIOAction :: (AppState -> (Int, ListResult) -> IO (Either String a))
             -> AppState
             -> EventM n (Next AppState)
withIOAction action as = case listSelectedElement (lr as) of
  Nothing      -> continue as
  Just (ix, e) -> suspendAndResume $ do
    r <- action as (ix, e)
    case r of
      Left  err -> throwIO $ userError err
      Right _   -> do
        apps <- (fmap . fmap)
          (\AppState {..} -> AppState { lr = listMoveTo ix lr, .. })
          getAppState
        case apps of
          Right nas -> do
            putStrLn "Press enter to continue"
            _ <- getLine
            pure nas
          Left err -> throwIO $ userError err


install' :: AppState -> (Int, ListResult) -> IO (Either String ())
install' AppState {..} (_, ListResult {..}) = do
  settings <- readIORef settings'
  l        <- readIORef logger'
  let runLogger = myLoggerT l

  let
    run =
      runLogger
        . flip runReaderT settings
        . runResourceT
        . runE
          @'[AlreadyInstalled, UnknownArchive, ArchiveResult, DistroNotFound, FileDoesNotExistError, CopyError, NoCompatibleArch, NoDownload, NotInstalled, NoCompatiblePlatform, BuildFailed, TagNotFound, DigestError, DownloadFailed, NoUpdate]

  (run $ do
      case lTool of
        GHC   -> liftE $ installGHCBin dls lVer Nothing
        Cabal -> liftE $ installCabalBin dls lVer Nothing
        GHCup -> liftE $ upgradeGHCup dls Nothing False $> ()
    )
    >>= \case
          VRight _                          -> pure $ Right ()
          VLeft  (V (AlreadyInstalled _ _)) -> pure $ Right ()
          VLeft (V (BuildFailed _ e)) ->
            pure $ Left [i|Build failed with #{e}|]
          VLeft (V NoDownload) ->
            pure $ Left [i|No available version for #{prettyVer lVer}|]
          VLeft (V NoUpdate) -> pure $ Right ()
          VLeft e -> pure $ Left [i|#{e}
Also check the logs in ~/.ghcup/logs|]


set' :: AppState -> (Int, ListResult) -> IO (Either String ())
set' _ (_, ListResult {..}) = do
  settings <- readIORef settings'
  l        <- readIORef logger'
  let runLogger = myLoggerT l

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

  (run $ do
      case lTool of
        GHC   -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly $> ()
        Cabal -> liftE $ setCabal lVer $> ()
        GHCup -> pure ()
    )
    >>= \case
          VRight _ -> pure $ Right ()
          VLeft  e -> pure $ Left [i|#{e}|]


del' :: AppState -> (Int, ListResult) -> IO (Either String ())
del' _ (_, ListResult {..}) = do
  settings <- readIORef settings'
  l        <- readIORef logger'
  let runLogger = myLoggerT l

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

  (run $ do
      case lTool of
        GHC   -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> ()
        Cabal -> liftE $ rmCabalVer lVer $> ()
        GHCup -> pure ()
    )
    >>= \case
          VRight _ -> pure $ Right ()
          VLeft  e -> pure $ Left [i|#{e}|]


changelog' :: AppState -> (Int, ListResult) -> IO (Either String ())
changelog' AppState {..} (_, ListResult {..}) = do
  case getChangeLog dls lTool (Left lVer) of
    Nothing -> pure $ Left
      [i|Could not find ChangeLog for #{lTool}, version #{prettyVer lVer}|]
    Just uri -> do
      exec "xdg-open" True [serializeURIRef' uri] Nothing Nothing >>= \case
        Right _ -> pure $ Right ()
        Left  e -> pure $ Left [i|#{e}|]


settings' :: IORef Settings
{-# NOINLINE settings' #-}
settings' = unsafePerformIO
  (newIORef Settings { cache      = True
                     , noVerify   = False
                     , keepDirs   = Never
                     , downloader = Curl
                     }
  )


logger' :: IORef LoggerConfig
{-# NOINLINE logger' #-}
logger' = unsafePerformIO
  (newIORef $ LoggerConfig { lcPrintDebug = False
                           , colorOutter  = \_ -> pure ()
                           , rawOutter    = \_ -> pure ()
                           }
  )


brickMain :: Settings -> LoggerConfig -> IO ()
brickMain s l = do
  writeIORef settings' s
  -- logger interpreter
  writeIORef logger'   l
  let runLogger = myLoggerT l

  eApps <- getAppState
  case eApps of
    Right as -> defaultMain app (selectLatest as) $> ()
    Left  e  -> do
      runLogger ($(logError) [i|Error building app state: #{show e}|])
      exitWith $ ExitFailure 2
 where
  selectLatest :: AppState -> AppState
  selectLatest AppState {..} =
    (\ix -> AppState { lr = listMoveTo ix lr, .. })
      . fromJust
      . V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag)
      $ (listElements lr)


getAppState :: IO (Either String AppState)
getAppState = do
  settings <- readIORef settings'
  l        <- readIORef logger'
  let runLogger = myLoggerT l

  r <-
    runLogger
    . flip runReaderT settings
    . runE
      @'[JSONError, DownloadFailed, FileDoesNotExistError, NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
    $ do
        (GHCupInfo _ dls) <- liftE $ getDownloadsF GHCupURL

        lV                <- liftE $ listVersions dls Nothing Nothing
        pure $ (AppState (list "Tool versions" (V.fromList lV) 1) dls)

  case r of
    VRight a -> pure $ Right a
    VLeft  e -> pure $ Left [i|#{e}|]