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

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
#if !defined(TAR)
import           Codec.Archive
#endif
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
import qualified Brick.Widgets.List            as L


data AppData = AppData {
    lr :: LR
  , dls :: GHCupDownloads
  , pfreq :: PlatformRequest
} deriving Show

data AppSettings = AppSettings {
    showAll :: Bool
} deriving Show

data AppState = AppState {
    appData :: AppData
  , appSettings :: AppSettings
} deriving Show

type LR = GenericList String Vector ListResult


keyHandlers :: [ ( Char
                 , AppSettings -> String
                 , AppState -> EventM n (Next AppState)
                 )
               ]
keyHandlers =
  [ ('q', const "Quit"     , halt)
  , ('i', const "Install"  , withIOAction install')
  , ('u', const "Uninstall", withIOAction del')
  , ('s', const "Set"      , withIOAction set')
  , ('c', const "ChangeLog", withIOAction changelog')
  , ( 'a'
    , (\AppSettings {..} ->
        if showAll then "Hide old versions" else "Show all versions"
      )
    , (\AppState {..} ->
        let newAppSettings =
                appSettings { showAll = not . showAll $ appSettings }
        in  continue (AppState appData newAppSettings)
      )
    )
  ]


ui :: AppState -> Widget String
ui AppState { appData = AppData {..}, appSettings = as@(AppSettings {..}) } =
  ( padBottom Max
    $ ( withBorderStyle unicode
      $ borderWithLabel (str "GHCup")
      $ ( center
        $ (header <=> hBorder <=> renderList
            renderItem
            True
            (L.listReverse lr)
          )
        )
      )
    )
    <=> footer

 where
  footer =
    withAttr "help"
      . txtWrap
      . T.pack
      . foldr1 (\x y -> x <> "  " <> y)
      . (++ ["↑↓:Navigation"])
      $ (fmap (\(c, s, _) -> (c : ':' : s as)) keyHandlers)
  header =
    (minHSize 2 $ emptyWidget)
      <+> (padLeft (Pad 2) $ minHSize 6 $ str "Tool")
      <+> (minHSize 15 $ str "Version")
      <+> (padLeft (Pad 1) $ minHSize 25 $ str "Tags")
      <+> (padLeft (Pad 5) $ str "Notes")
  renderItem b listResult@(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)
        dim = if lNoBindist
          then updateAttrMap (const dimAttributes) . withAttr "no-bindist"
          else id
        active = if b then withAttr "active" else id
    in  dim
          (   marks
          <+> (( padLeft (Pad 2)
               $ active
               $ minHSize 6
               $ (str (fmap toLower . show $ lTool))
               )
              )
          <+> (minHSize 15 $ active $ (str ver))
          <+> (let l = catMaybes . fmap printTag $ sort lTag
               in padLeft (Pad 1) $ minHSize 25 $
                  if null l
                  then emptyWidget
                  else foldr1 (\x y -> x <+> str "," <+> y) l
              )
          <+> ( padLeft (Pad 5)
              $ let notes = printNotes listResult
                in  if null notes
                      then emptyWidget
                      else foldr1 (\x y -> x <+> str "," <+> y) $ notes
              )
          )

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

  printNotes ListResult {..} =
    (if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty
      )
      ++ (if fromSrc then [withAttr "compiled" $ str "compiled"] else mempty)
      ++ (if lStray then [withAttr "stray" $ str "stray"] else mempty)



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 defaultAttributes
          , appChooseCursor = neverShowCursor
          }

defaultAttributes :: AttrMap
defaultAttributes = attrMap
  Vty.defAttr
  [ ("active"       , Vty.defAttr `Vty.withBackColor` Vty.blue)
  , ("not-installed", Vty.defAttr `Vty.withForeColor` Vty.red)
  , ("set"          , Vty.defAttr `Vty.withForeColor` Vty.green)
  , ("installed"    , Vty.defAttr `Vty.withForeColor` Vty.green)
  , ("recommended"  , Vty.defAttr `Vty.withForeColor` Vty.green)
  , ("hls-powered"  , Vty.defAttr `Vty.withForeColor` Vty.green)
  , ("latest"       , Vty.defAttr `Vty.withForeColor` Vty.yellow)
  , ("prerelease"   , Vty.defAttr `Vty.withForeColor` Vty.red)
  , ("compiled"     , Vty.defAttr `Vty.withForeColor` Vty.blue)
  , ("stray"        , Vty.defAttr `Vty.withForeColor` Vty.blue)
  , ("help"         , Vty.defAttr `Vty.withStyle` Vty.italic)
  ]


dimAttributes :: AttrMap
dimAttributes = attrMap
  (Vty.defAttr `Vty.withStyle` Vty.dim)
  [ ("active"    , Vty.defAttr `Vty.withBackColor` Vty.blue)
  , ("no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
  ]



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 { appData = AppData {..}, ..} (VtyEvent (Vty.EvKey (Vty.KUp) _))
  = continue (AppState (AppData (listMoveUp lr) dls pfreq) appSettings)
eventHandler AppState { appData = AppData {..}, ..} (VtyEvent (Vty.EvKey (Vty.KDown) _))
  = continue (AppState (AppData (listMoveDown lr) dls pfreq) appSettings)
eventHandler as@(AppState appD appS) (VtyEvent (Vty.EvKey (Vty.KChar c) _)) =
  case find (\(c', _, _) -> c' == c) keyHandlers of
    Nothing              -> continue as
    Just ('a', _, handler) ->
      if (not $ showAll appS) -- it's not swapped to `showAll` yet, but it will in the handler
      then do
        newAppData <- liftIO $ replaceLR (\_ -> True) appD
        handler (AppState (selectLatest newAppData) appS)
      else do -- hide old versions
        newAppData <- liftIO $ replaceLR (filterVisible (not $ showAll appS)) appD
        handler (AppState (selectLatest newAppData) appS)
    Just (_, _, handler) -> handler as
eventHandler st _ = continue st


replaceLR :: (ListResult -> Bool) -> AppData -> IO AppData
replaceLR filterF (AppData {..}) = do
  settings <- liftIO $ readIORef settings'
  l        <- liftIO $ readIORef logger'
  let runLogger = myLoggerT l
  lV <- runLogger
    . flip runReaderT settings
    . fmap (V.fromList . filter filterF)
    . listVersions dls Nothing Nothing
    $ pfreq
  pure $ AppData { lr = L.listReplace lV Nothing $ lr, .. }


filterVisible :: Bool -> ListResult -> Bool
filterVisible showAll e
  | lInstalled e = True
  | showAll      = True
  | otherwise    = not (elem Old (lTag e))


-- | 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 . appData $ as) of
  Nothing      -> continue as
  Just (ix, e) -> suspendAndResume $ do
    action as (ix, e) >>= \case
      Left  err -> putStrLn $ ("Error: " <> err)
      Right _   -> putStrLn "Success"
    apps <-
      (fmap . fmap)
          (\AppData {..} -> AppState
            { appData     = AppData { lr = listMoveTo ix lr, .. }
            , appSettings = (appSettings as)
            }
          )
        $ getAppData Nothing (pfreq . appData $ as)
    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 { appData = AppData {..}} (_, ListResult {..}) = do
  settings <- readIORef settings'
  l        <- readIORef logger'
  let runLogger = myLoggerT l

  let
    run =
      runLogger
        . flip runReaderT settings
        . runResourceT
        . runE
          @'[AlreadyInstalled
            , UnknownArchive
#if !defined(TAR)
            , ArchiveResult
#endif
            , FileDoesNotExistError
            , CopyError
            , NoDownload
            , NotInstalled
            , BuildFailed
            , TagNotFound
            , DigestError
            , DownloadFailed
            , NoUpdate
            , TarDirDoesNotExist
            ]

  (run $ do
      case lTool of
        GHC   -> liftE $ installGHCBin dls lVer pfreq
        Cabal -> liftE $ installCabalBin dls lVer pfreq
        GHCup -> liftE $ upgradeGHCup dls Nothing False pfreq $> ()
        HLS   -> liftE $ installHLSBin dls lVer pfreq $> ()
    )
    >>= \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 $> ()
        HLS   -> liftE $ setHLS 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 $> ()
        HLS   -> liftE $ rmHLSVer lVer $> ()
        GHCup -> pure ()
    )
    >>= \case
          VRight _ -> pure $ Right ()
          VLeft  e -> pure $ Left [i|#{e}|]


changelog' :: AppState -> (Int, ListResult) -> IO (Either String ())
changelog' AppState { appData = AppData {..}} (_, 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
      let cmd = case _rPlatform pfreq of
                  Darwin  -> "open"
                  Linux _ -> "xdg-open"
                  FreeBSD -> "xdg-open"
      exec cmd True [serializeURIRef' uri] Nothing Nothing >>= \case
        Right _ -> pure $ Right ()
        Left  e -> pure $ Left [i|#{e}|]


uri' :: IORef (Maybe URI)
{-# NOINLINE uri' #-}
uri' = unsafePerformIO (newIORef Nothing)


settings' :: IORef Settings
{-# NOINLINE settings' #-}
settings' = unsafePerformIO $ do
  dirs <- getDirs
  newIORef Settings { cache      = True
                     , noVerify   = False
                     , keepDirs   = Never
                     , downloader = Curl
                     , verbose    = False
                     , ..
                     }


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


brickMain :: Settings -> Maybe URI -> LoggerConfig -> GHCupDownloads -> PlatformRequest -> IO ()
brickMain s muri l av pfreq' = do
  writeIORef uri'      muri
  writeIORef settings' s
  -- logger interpreter
  writeIORef logger'   l
  let runLogger = myLoggerT l

  eAppData <- getAppData (Just av) pfreq'
  case eAppData of
    Right ad -> defaultMain app (AppState (selectLatest ad) defaultAppSettings) $> ()
    Left  e  -> do
      runLogger ($(logError) [i|Error building app state: #{show e}|])
      exitWith $ ExitFailure 2


selectLatest :: AppData -> AppData
selectLatest (AppData {..}) =
  (\ix -> AppData { lr = listMoveTo ix lr, .. } )
    . fromJust
    . V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag)
    $ (listElements lr)


defaultAppSettings :: AppSettings
defaultAppSettings = AppSettings {
    showAll = False
  }


getDownloads' :: IO (Either String GHCupDownloads)
getDownloads' = do
  muri     <- readIORef uri'
  settings <- readIORef settings'
  l        <- readIORef logger'
  let runLogger = myLoggerT l

  r <-
    runLogger
    . flip runReaderT settings
    . runE
      @'[JSONError, DownloadFailed, FileDoesNotExistError]
    $ fmap _ghcupDownloads $ liftE $ getDownloadsF (maybe GHCupURL OwnSource muri)

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


getAppData :: Maybe GHCupDownloads -> PlatformRequest -> IO (Either String AppData)
getAppData mg pfreq' = do
  settings <- readIORef settings'
  l        <- readIORef logger'
  let runLogger = myLoggerT l

  r <- maybe getDownloads' (pure . Right) mg

  runLogger
    . flip runReaderT settings
    $ do
      case r of
        Right dls -> do
          lV <- listVersions dls Nothing Nothing pfreq'
          pure $ Right $ (AppData (list "Tool versions"
                (V.fromList . filter (filterVisible (showAll defaultAppSettings)) $ lV) 1) dls pfreq')
        Left  e -> pure $ Left [i|#{e}|]