{-# LANGUAGE Rank2Types   #-}
{-# LANGUAGE ViewPatterns #-}

{- |
Module                  : Summoner.Tui
Copyright               : (c) 2018-2026 Kowainik
SPDX-License-Identifier : MPL-2.0
Maintainer              : Kowainik <xrom.xkov@gmail.com>
Stability               : Stable
Portability             : Portable

TUI for the Summoner tool. See demo in the README.md file.
-}

module Summoner.Tui
       ( summonTui
       ) where

import Brick (App (..), AttrMap, BrickEvent (..), Widget, attrMap, attrName, customMain, halt,
              simpleApp, str, txt, vBox, withAttr, (<+>))
import Brick.Focus (focusRingCursor)
import Brick.Forms (allFieldsValid, focusedFormInputAttr, formFocus, formState, handleFormEvent,
                    invalidFormInputAttr, renderForm)
import Brick.Main (ViewportScroll, neverShowCursor, vScrollBy, viewportScroll)
import Brick.Types (EventM, ViewportType (Vertical))
import Brick.Util (fg)
import Brick.Widgets.Border (borderAttr)
import Brick.Widgets.Center (center)
import Brick.Widgets.Core (emptyWidget, fill, hLimit, hLimitPercent, padTopBottom, strWrap, txtWrap,
                           vLimit, viewport)
import Brick.Widgets.Edit (editAttr, editFocusedAttr)
import Brick.Widgets.List (listSelectedAttr, listSelectedFocusedAttr)
import Colourista (errorMessage, infoMessage)
import Lens.Micro ((.~), (^.))
import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory, listDirectory)

import Summoner.CLI (Command (..), NewOpts (..), ShowOpts (..), getCustomLicenseText,
                     getFinalConfig, runConfig, runScript, summon)
import Summoner.Config (ConfigP (cFiles))
import Summoner.Decision (Decision (..))
import Summoner.Default (defaultConfigFile)
import Summoner.GhcVer (ghcTable)
import Summoner.License (License (..), LicenseName, parseLicenseName, showLicenseWithDesc)
import Summoner.Mode (isNonInteractive)
import Summoner.Project (generateProjectNonInteractive, initializeProject)
import Summoner.Source (fetchSources)
import Summoner.Tui.Field (disabledAttr)
import Summoner.Tui.Form (KitForm, SummonForm (..), getCurrentFocus, isActive, mkForm, recreateForm)
import Summoner.Tui.Kit
import Summoner.Tui.Validation (ctrlD, formErrorMessages, handleAutofill, projectDescNewLine,
                                summonFormValidation)
import Summoner.Tui.Widget (borderLabel, listInBorder)

import qualified Brick (on)
import qualified Graphics.Vty as V
import qualified Graphics.Vty.Config as VConfig
import qualified Graphics.Vty.CrossPlatform as VC
import qualified Paths_summoner_tui as Meta (version)


-- | Main function that parses @CLI@ arguments and runs @summoner@ in TUI mode.
summonTui :: IO ()
summonTui = summon Meta.version runTuiCommand

-- | Run TUI specific to each command.
runTuiCommand :: Command -> IO ()
runTuiCommand = \case
    New opts      -> summonTuiNew opts
    ShowInfo opts -> summonTuiShow opts
    Script opts   -> runScript opts  -- TODO: implement TUI for script command
    Config opts   -> runConfig opts

----------------------------------------------------------------------------
-- New command
----------------------------------------------------------------------------

{- | TUI for creating new project. Contains interactive elements like text input
fields or checkboxes to configure settings for new project.
-}
summonTuiNew :: NewOpts -> IO ()
summonTuiNew newOpts@NewOpts{..} = do
    -- configure initial state for TUI application
    finalConfig <- getFinalConfig newOpts
    when (isNonInteractive newOptsInteractivity) $ do
        generateProjectNonInteractive
            newOptsConnectMode
            newOptsProjectName
            finalConfig
        () <$ exitSuccess
    files <- fetchSources newOptsConnectMode (cFiles finalConfig)
    configFilePath <- findConfigFile
    let initialKit = configToSummonKit
            newOptsProjectName
            newOptsConnectMode
            configFilePath
            files
            finalConfig

    -- run TUI app
    skForm <- runTuiNew initialKit

    -- perform actions depending on the final state
    let kit = formState skForm
    if allFieldsValid skForm && (kit ^. shouldSummon == Yes)
    then finalSettings kit >>= initializeProject
    else errorMessage "Aborting summoner"
  where
    findConfigFile :: IO (Maybe FilePath)
    findConfigFile = if newOptsIgnoreFile
        then pure Nothing
        else case newOptsConfigFile of
            Nothing  -> defaultConfigFile >>= \file ->
                ifM (doesFileExist file) (pure $ Just file) (pure Nothing)
            justFile -> pure justFile

-- | Check content of current directory and create form after forming 'SummonKit'.
runTuiNew :: SummonKit -> IO (KitForm e)
runTuiNew kit = do
    filesAndDirs <- listDirectory =<< getCurrentDirectory
    dirs <- filterM doesDirectoryExist filesAndDirs
    runApp (appNew dirs) (summonFormValidation dirs $ mkForm kit)

-- | Represents @new@ command app behaviour.
appNew :: [FilePath] -> App (KitForm e) e SummonForm
appNew dirs = App
    { appDraw = drawNew dirs
    , appHandleEvent = \ev -> do
        s <- get
        if formState s ^. shouldSummon == Idk
        then case ev of
            VtyEvent (V.EvKey V.KEnter []) -> put (changeShouldSummon Yes s) >> halt
            VtyEvent (V.EvKey V.KEsc [])   -> withForm ev (changeShouldSummon Nop)
            _otherKey                      -> pass
        else case ev of
            VtyEvent V.EvResize {} -> pass
            VtyEvent (V.EvKey V.KEnter [V.MMeta]) ->
                withForm ev (validateForm . projectDescNewLine)
            VtyEvent (V.EvKey V.KEnter []) ->
                if allFieldsValid s
                then withForm ev (changeShouldSummon Idk)
                else pass
            VtyEvent (V.EvKey V.KEsc []) -> halt
            VtyEvent (V.EvKey (V.KChar 'd') [V.MCtrl]) ->
                withForm ev (validateForm . ctrlD)

            -- Handle active/inactive checkboxes
            VtyEvent (V.EvKey (V.KChar ' ') []) -> case getCurrentFocus s of
                Nothing    -> withFormDef ev
                Just field -> handleCheckboxActivation ev field

            -- Run handler for autofill actions
            VtyEvent (V.EvKey key [])
                | keyTriggersAutofill key
                -> withForm ev (validateForm . handleAutofill)

            MouseDown n _ _ _ -> handleCheckboxActivation ev n

            -- Handle skip of deactivated checkboxes
            VtyEvent (V.EvKey (V.KChar '\t') []) -> loopWhileInactive ev
            VtyEvent (V.EvKey V.KBackTab     []) -> loopWhileInactive ev

            -- Default action
            _otherEvent -> withFormDef ev

    , appChooseCursor = focusRingCursor formFocus
    , appStartEvent = pass
    , appAttrMap = const theMap
    }
  where
    withForm ev f = handleFormEvent ev >> modify f
    withFormDef ev = withForm ev validateForm

    changeShouldSummon :: Decision -> KitForm e -> KitForm e
    changeShouldSummon newShould f = mkForm $ formState f & shouldSummon .~ newShould

    validateForm :: KitForm e -> KitForm e
    validateForm = summonFormValidation dirs

    mkNewForm :: KitForm e -> KitForm e
    mkNewForm = recreateForm validateForm

    -- Activate/Deactivate checkboxes depending on current field change
    handleCheckboxActivation
        :: BrickEvent SummonForm e
        -> SummonForm
        -> EventM SummonForm (KitForm e) ()
    handleCheckboxActivation ev = \case
        CabalField     -> withForm ev mkNewForm
        StackField     -> withForm ev mkNewForm
        GitHubEnable   -> withForm ev mkNewForm
        GitHubDisable  -> withForm ev mkNewForm
        GitHubNoUpload -> withForm ev mkNewForm
        _nonCheckBox   -> withFormDef ev

    -- Handles form event until current element is active
    loopWhileInactive
        :: BrickEvent SummonForm e
        -> EventM SummonForm (KitForm e) ()
    loopWhileInactive ev = do
        handleFormEvent ev
        newForm <- get
        case getCurrentFocus newForm of
            Nothing -> pass
            Just field -> if not $ isActive (formState newForm) field
                then loopWhileInactive ev
                else pass

    -- Autofill is only triggered on characters and backspace keys.
    keyTriggersAutofill :: V.Key -> Bool
    keyTriggersAutofill (V.KChar _) = True
    keyTriggersAutofill V.KBS       = True
    keyTriggersAutofill _otherKey   = False

-- | Draws the form for @new@ command.
drawNew :: [FilePath] -> KitForm e -> [Widget SummonForm]
drawNew dirs kitForm = case kit ^. shouldSummon of
    Idk -> [confirmDialog]
    Yes -> [formWidget]
    Nop -> [formWidget]
  where
    kit :: SummonKit
    kit = formState kitForm

    confirmDialog :: Widget SummonForm
    confirmDialog = center $ hLimit 55 $ borderLabel "Confirm" $ padTopBottom 2 $ vBox
        [ str "• Enter – Press Enter to create the project"
        , str "• Esc   – Or Esc to go back to settings"
        ]

    formWidget :: Widget SummonForm
    formWidget = vBox
        [ form   <+> tree
        , status <+> help
        ]

    form :: Widget SummonForm
    form = borderLabel "Summon new project" (renderForm kitForm)

    tree :: Widget SummonForm
    tree = hLimitPercent 25 $ vLimit 22 $ borderLabel "Project Structure" $ vBox
        [ withAttr (attrName "tree") $ txt $ renderWidgetTree kit
        -- to fill all the space that widget should take.
        , fill ' '
        ]

    status :: Widget SummonForm
    status = hLimitPercent 45 $
        borderLabel "Status" $ vBox
            [ informationBlock
            , validationBlock
            , configBlock
            , fill ' '
            ]
      where
        informationBlock :: Widget SummonForm
        informationBlock = case getCurrentFocus kitForm of
            Just UserOwner   -> infoTxt "GitHub username"
            Just ProjectCat  -> infoTxt "Comma-separated categories as used at Hackage"
            Just Ghcs        -> infoTxt "Space separated GHC versions"
            _noInfoAvailable -> emptyWidget

        infoTxt :: Text -> Widget SummonForm
        infoTxt = withAttr (attrName "blue-fg") . txtWrap . (<>) " ⓘ  "

        validationBlock :: Widget SummonForm
        validationBlock = vBox $ case formErrorMessages dirs kitForm of
            []     -> [withAttr (attrName "green-fg") $ str " ✔  Project configuration is valid"]
            fields -> map (\msg -> withAttr (attrName "red-fg") $ strWrap $ " ☓  " ++ msg) fields

        configBlock :: Widget SummonForm
        configBlock = case kit ^. configFile of
            Nothing   -> emptyWidget
            Just file -> infoTxt $ toText file <> " file is used"

    help, helpBody :: Widget SummonForm
    help     = borderLabel "Help" (helpBody <+> fill ' ')
    helpBody = vBox
        [ str "• Enter     : create the project"
        , str "• Esc       : quit"
        , str "• Ctrl+d    : remove input of the text field"
        , str "• Arrows    : up/down arrows to choose license"
        , str "• Alt+Enter : switch to new line"
        ]

----------------------------------------------------------------------------
-- Show command
----------------------------------------------------------------------------

-- | Simply shows info about GHC versions or licenses in TUI.
summonTuiShow :: ShowOpts -> IO ()
summonTuiShow = \case
    GhcList                 -> runTuiShowGhcVersions
    LicenseList Nothing     -> runTuiShowAllLicenses
    LicenseList (Just name) -> runTuiShowLicense name

runTuiShowGhcVersions :: IO ()
runTuiShowGhcVersions = runSimpleApp drawGhcVersions
  where
    drawGhcVersions :: Widget ()
    drawGhcVersions = listInBorder "Supported GHC versions" 60 0 ghcTable

runTuiShowAllLicenses :: IO ()
runTuiShowAllLicenses = runSimpleApp drawLicenseNames
  where
    drawLicenseNames :: Widget ()
    drawLicenseNames = listInBorder "Supported licenses" 70 4 (map showLicenseWithDesc universe)

runTuiShowLicense :: String -> IO ()
runTuiShowLicense (toText -> name) = case parseLicenseName name of
    Nothing -> do
        errorMessage $ "Error parsing license name: " <> name
        infoMessage "Use 'summon show license' command to see the list of all available licenses"
    Just licenseName -> do
        lc <- getCustomLicenseText licenseName
        runApp (licenseApp licenseName lc) ()
  where
    licenseApp :: LicenseName -> License -> App () e ()
    licenseApp licenseName lc = App
        { appDraw         = drawScrollableLicense licenseName lc
        , appStartEvent   = pass
        , appAttrMap      = const theMap
        , appChooseCursor = neverShowCursor
        , appHandleEvent  = \case
            VtyEvent (V.EvKey V.KDown []) -> vScrollBy licenseScroll   1  >> pass
            VtyEvent (V.EvKey V.KUp [])   -> vScrollBy licenseScroll (-1) >> pass
            VtyEvent (V.EvKey V.KEsc [])  -> halt
            _otherEvent                   -> pass
        }

    licenseScroll :: ViewportScroll ()
    licenseScroll = viewportScroll ()

    drawScrollableLicense :: LicenseName -> License -> () -> [Widget ()]
    drawScrollableLicense licenseName (License lc) = const [ui]
      where
        ui :: Widget ()
        ui = center
            $ hLimit 80
            $ borderLabel ("License: " ++ show licenseName)
            $ viewport () Vertical
            $ vBox
            $ map (\t -> if t == "" then txt "\n" else txtWrap t)
            $ lines lc

----------------------------------------------------------------------------
-- Internal
----------------------------------------------------------------------------

-- | Runs brick application with given start state.
runApp :: Ord n => App s e n -> s -> IO s
runApp app s = do
    initialVty <- buildVty
    customMain initialVty buildVty Nothing app s
  where
    buildVty :: IO V.Vty
    buildVty = do
        v <- VC.mkVty VConfig.defaultConfig
        V.setMode (V.outputIface v) V.Mouse True
        pure v

-- | Runs the app without any state.
runSimpleApp :: Ord n => Widget n -> IO ()
runSimpleApp w = runApp (mkSimpleApp w) ()

-- | Creates simple brick app that doesn't have state and just displays given 'Widget'.
mkSimpleApp :: Widget n -> App () e n
mkSimpleApp w = (simpleApp w)
    { appAttrMap = const theMap
    }

-- | Styles, colours that are used across the app.
theMap :: AttrMap
theMap = attrMap V.defAttr
    [ (editAttr,                V.black `Brick.on` V.cyan)
    , (editFocusedAttr,         V.black `Brick.on` V.white)
    , (invalidFormInputAttr,    V.white `Brick.on` V.red)
    , (focusedFormInputAttr,    V.black `Brick.on` V.yellow)
    , (listSelectedAttr,        V.black `Brick.on` V.cyan)
    , (listSelectedFocusedAttr, V.black `Brick.on` V.white)
    , (disabledAttr,            fg V.brightBlack)
    , (attrName "blue-fg",      fg V.blue)
    , (attrName "green-fg",     fg V.green)
    , (attrName "yellow-fg",    fg V.yellow)
    , (attrName "red-fg",       fg V.brightRed)
    , (borderAttr,              fg V.cyan)
    , (attrName "tree",         fg V.cyan)
    ]
