content: module GitBrunch (main) where
  
  import Brick.Main (halt)
  import Brick.Main qualified as M
  import Brick.Themes (themeToAttrMap)
  import Brick.Types
  import Brick.Widgets.Border qualified as B
  import Brick.Widgets.Border.Style qualified as BS
  import Brick.Widgets.Center qualified as C
  import Brick.Widgets.Core
  import Brick.Widgets.Dialog qualified as D
  import Brick.Widgets.Edit qualified as E
  import Brick.Widgets.List qualified as L
  import Control.Exception (SomeException, catch)
  import Control.Monad
  import Control.Monad.Extra (ifM, unlessM)
  import Data.Char
  import Data.List
  import Data.Maybe (fromMaybe, isJust)
  import Data.Text (Text)
  import Data.Text qualified as T
  import Data.Text.IO qualified as T
  import Data.Vector qualified as Vec
  import Graphics.Vty hiding (update)
  import Lens.Micro (Lens', lens, (%~), (&), (.~), (^.), _Just)
  import Lens.Micro.Mtl ((%=), (.=), (?=))
  import System.Exit
  
  import Git (Branch (..))
  import Git qualified
  import Theme
  
  data Name
    = Local
    | Remote
    | Filter
    | DialogConfirm
    | DialogCancel
    deriving (Ord, Eq, Show)
  
  data RemoteName
    = RLocal
    | RRemote
    deriving (Eq)
  
  data GitCommand
    = GitRebase
    | GitMerge
    | GitCheckout
    | GitDeleteBranch
    deriving (Ord, Eq)
  
  data DialogOption
    = Cancel
    | Confirm GitCommand
  
  data State = State
    { _focus :: RemoteName
    , _gitCommand :: GitCommand
    , _branches :: [Branch]
    , _localBranches :: L.List Name Branch
    , _remoteBranches :: L.List Name Branch
    , _dialog :: Maybe (D.Dialog DialogOption Name)
    , _filter :: E.Editor Text Name
    , _isEditingFilter :: Bool
    }
  
  instance Show GitCommand where
    show GitCheckout = "checkout"
    show GitRebase = "rebase"
    show GitMerge = "merge"
    show GitDeleteBranch = "delete"
  
  main :: IO ()
  main = do
    branches <- Git.listBranches `catch` gitFailed
    state <- M.defaultMain app $ syncBranchLists emptyState{_branches = branches}
    let execGit = gitFunction (_gitCommand state)
    exitCode <- maybe noBranchErr execGit (selectedBranch state)
    when (exitCode /= ExitSuccess)
      $ die ("Failed to " ++ show (_gitCommand state) ++ ".")
   where
    gitFailed :: SomeException -> IO a
    gitFailed _ = exitFailure
    noBranchErr = die "No branch selected."
    gitFunction = \case
      GitCheckout -> Git.checkout
      GitRebase -> Git.rebaseInteractive
      GitMerge -> Git.merge
      GitDeleteBranch -> Git.deleteBranch
  
  emptyState :: State
  emptyState =
    State
      { _focus = RLocal
      , _gitCommand = GitCheckout
      , _branches = []
      , _localBranches = mkList Local
      , _remoteBranches = mkList Remote
      , _dialog = Nothing
      , _filter = emptyFilter
      , _isEditingFilter = False
      }
   where
    mkList focus = L.list focus Vec.empty rowHeight
  
  emptyFilter :: E.Editor Text Name
  emptyFilter = E.editor Filter Nothing ""
  
  app :: M.App State e Name
  app =
    M.App
      { M.appDraw = drawApp
      , M.appChooseCursor = M.showFirstCursor
      , M.appHandleEvent = appHandleEvent
      , M.appStartEvent = pure ()
      , M.appAttrMap = const $ themeToAttrMap theme
      }
  
  drawApp :: State -> [Widget Name]
  drawApp state =
    drawDialog state : [C.vCenter $ padAll 1 $ maxWidth 200 $ vBox content]
   where
    content = [branchLists, filterEdit, padding, instructions]
    padding = str " "
    maxWidth w = C.hCenter . hLimit w
    toBranchList r lens' =
      let isActive = state ^. focusL == r && not (_isEditingFilter state)
       in state ^. lens' & drawBranchList isActive
    filterEdit = if _isEditingFilter state then drawFilter state else emptyWidget
    branchLists =
      hBox
        [ C.hCenter $ toBranchList RLocal localBranchesL
        , str " "
        , C.hCenter $ toBranchList RRemote remoteBranchesL
        ]
    instructions =
      maxWidth 100
        $ hBox
          [ drawInstruction "Enter" "checkout"
          , drawInstruction "/" "filter"
          , drawInstruction "F" "fetch"
          , drawInstruction "R" "rebase"
          , drawInstruction "M" "merge"
          , drawInstruction "D" "delete"
          ]
  
  drawFilter :: State -> Widget Name
  drawFilter state =
    withBorderStyle BS.unicodeBold $ B.border $ vLimit 1 $ label <+> editor
   where
    editor = E.renderEditor (txt . T.unlines) True (state ^. filterL)
    label = str " Filter: "
  
  drawDialog :: State -> Widget Name
  drawDialog state = case _dialog state of
    Nothing -> emptyWidget
    Just dialog -> D.renderDialog dialog $ C.hCenter $ padAll 1 content
     where
      branch = maybe "" show $ selectedBranch state
      action = show (_gitCommand state)
      content =
        str "Really "
          <+> withAttr attrUnder (str action)
          <+> str " branch "
          <+> withAttr attrBold (str branch)
          <+> str "?"
  
  drawBranchList :: Bool -> L.List Name Branch -> Widget Name
  drawBranchList hasFocus list =
    withBorderStyle BS.unicodeBold
      $ B.borderWithLabel (drawTitle list)
      $ L.renderList drawListElement hasFocus list
   where
    attr = withAttr $ if hasFocus then attrTitleFocus else attrTitle
    drawTitle = attr . str . map toUpper . show . L.listName
  
  drawListElement :: Bool -> Branch -> Widget Name
  drawListElement isListFocussed branch =
    maxPadding $ highlight branch $ str $ " " <> show branch
   where
    maxPadding = if isListFocussed then padRight Max else id
    highlight (BranchCurrent _) = withAttr attrBranchCurrent
    highlight b | Git.isCommonBranch b = withAttr attrBranchCommon
    highlight _ = id
  
  drawInstruction :: Text -> Text -> Widget n
  drawInstruction keys action =
    withAttr attrKey (txt keys)
      <+> txt " to "
      <+> withAttr attrBold (txt action)
      & C.hCenter
  
  appHandleEvent :: BrickEvent Name e -> EventM Name State ()
  appHandleEvent (VtyEvent e)
    | isQuitEvent e = quit
    | otherwise = do
        dialog <- gets _dialog
        if isJust dialog
          then appHandleEventDialog e
          else appHandleEventMain e
   where
    isQuitEvent (EvKey (KChar 'c') [MCtrl]) = True
    isQuitEvent (EvKey (KChar 'd') [MCtrl]) = True
    isQuitEvent _ = False
  appHandleEvent _ = pure ()
  
  appHandleEventMain :: Event -> EventM Name State ()
  appHandleEventMain e =
    let
      event = lowerKey e
      endWithCheckout = gitCommandL .= GitCheckout >> halt
      endWithRebase = gitCommandL .= GitRebase >> halt
      endWithMerge = gitCommandL .= GitMerge >> halt
      resetFilter = filterL .~ emptyFilter
      showFilter = isEditingFilterL .~ True
      hideFilter = isEditingFilterL .~ False
      startEditingFilter = modify (showFilter . resetFilter)
      cancelEditingFilter = modify (hideFilter . resetFilter)
      stopEditingFilter = modify hideFilter
  
      confirmDelete :: Maybe Branch -> EventM Name State ()
      confirmDelete (Just (BranchCurrent _)) = pure ()
      confirmDelete (Just _) = dialogL ?= createDialog GitDeleteBranch
      confirmDelete Nothing = pure ()
  
      fetch = do
        state <- get
        M.suspendAndResume $ do
          branches <- fetchBranches
          pure $ updateBranches branches state
  
      handleDefault :: EventM Name State ()
      handleDefault = case event of
        EvKey KEsc [] -> quit
        EvKey (KChar 'q') [] -> quit
        EvKey (KChar '/') [] -> startEditingFilter
        EvKey (KChar 'f') [MCtrl] -> startEditingFilter
        EvKey (KChar 'd') [] -> confirmDelete =<< gets selectedBranch
        EvKey KEnter [] -> endWithCheckout
        EvKey (KChar 'c') [] -> endWithCheckout
        EvKey (KChar 'r') [] -> endWithRebase
        EvKey (KChar 'm') [] -> endWithMerge
        EvKey KLeft [] -> focusBranches RLocal
        EvKey (KChar 'h') [] -> focusBranches RLocal
        EvKey KRight [] -> focusBranches RRemote
        EvKey (KChar 'l') [] -> focusBranches RRemote
        EvKey (KChar 'f') [] -> fetch
        _ -> zoom focussedBranchesL $ L.handleListEventVi L.handleListEvent e
  
      handleEditingFilter :: EventM Name State ()
      handleEditingFilter = do
        case event of
          EvKey KEsc [] -> cancelEditingFilter
          EvKey KEnter [] -> stopEditingFilter
          EvKey KUp [] -> stopEditingFilter
          EvKey KDown [] -> stopEditingFilter
          _ -> zoom filterL $ E.handleEditorEvent (VtyEvent e)
        modify syncBranchLists
     in
      ifM
        (gets _isEditingFilter)
        handleEditingFilter
        handleDefault
  
  appHandleEventDialog :: Event -> EventM Name State ()
  appHandleEventDialog e =
    let
      cancelDialog = do
        dialogL .= Nothing
        gitCommandL .= GitCheckout
  
      confirmDialog cmd = do
        dialogL .= Nothing
        gitCommandL .= cmd
        halt
     in
      case vimifiedKey e of
        EvKey KEnter [] -> do
          dialog <- gets _dialog
          case D.dialogSelection =<< dialog of
            Just (DialogConfirm, Confirm cmd) -> confirmDialog cmd
            Just (DialogCancel, Cancel) -> cancelDialog
            _ -> pure ()
        EvKey KEsc [] -> cancelDialog
        EvKey (KChar 'q') [] -> cancelDialog
        ev -> zoom (dialogL . _Just) $ D.handleDialogEvent ev
  
  quit :: EventM n State ()
  quit = focussedBranchesL %= L.listClear >> halt
  
  focusBranches :: RemoteName -> EventM Name State ()
  focusBranches target = do
    let isAlreadyFocussed = (target ==) <$> gets _focus
    unlessM isAlreadyFocussed $ do
      offsetDiff <- listOffsetDiff target
      modify (changeList . syncPosition offsetDiff)
   where
    changeList = focusL .~ target
    listIndex state = fromMaybe 0 $ state ^. currentListL . L.listSelectedL
    syncPosition diff state = (targetListL %~ L.listMoveTo (listIndex state - diff)) state
    (currentListL, targetListL) = case target of
      RLocal -> (remoteBranchesL, localBranchesL)
      RRemote -> (localBranchesL, remoteBranchesL)
  
  listOffsetDiff :: RemoteName -> EventM Name State Int
  listOffsetDiff target = do
    offLocal <- getOffset Local
    offRemote <- getOffset Remote
    pure
      $ if target == RLocal
        then offRemote - offLocal
        else offLocal - offRemote
   where
    getOffset name = maybe 0 (^. vpTop) <$> M.lookupViewport name
  
  fetchBranches :: IO [Branch]
  fetchBranches = do
    T.putStrLn "Fetching branches"
    output <- Git.fetch
    T.putStr output
    Git.listBranches
  
  updateBranches :: [Branch] -> State -> State
  updateBranches branches =
    syncBranchLists
      . (branchesL .~ branches)
      . (filterL .~ emptyFilter)
  
  syncBranchLists :: State -> State
  syncBranchLists state =
    state
      & localBranchesL
      .~ mkList Local local
      & remoteBranchesL
      .~ mkList Remote remote
      & focusL
      %~ toggleFocus (local, remote)
   where
    mkList name xs = L.list name (Vec.fromList xs) rowHeight
    filterText = T.toLower $ T.unwords $ E.getEditContents $ _filter state
    isBranchInFilter = T.isInfixOf filterText . Git.fullBranchName
    filteredBranches = filter isBranchInFilter (_branches state)
    (remote, local) = partition Git.isRemoteBranch filteredBranches
  
  toggleFocus :: ([Branch], [Branch]) -> RemoteName -> RemoteName
  toggleFocus ([], _ : _) RLocal = RRemote
  toggleFocus (_ : _, []) RRemote = RLocal
  toggleFocus _ x = x
  
  selectedBranch :: State -> Maybe Branch
  selectedBranch state =
    snd <$> L.listSelectedElement (state ^. focussedBranchesL)
  
  createDialog :: GitCommand -> D.Dialog DialogOption Name
  createDialog cmd = D.dialog (Just $ str title) (Just (DialogConfirm, choices)) 80
   where
    title = map toUpper $ show cmd
    btnText (x : xs) = toUpper x : xs
    btnText x = x
    choices =
      [ (btnText $ show cmd, DialogConfirm, Confirm cmd)
      , ("Cancel", DialogCancel, Cancel)
      ]
  
  mapKey :: (Char -> Key) -> Event -> Event
  mapKey f (EvKey (KChar k) []) = EvKey (f k) []
  mapKey _ e = e
  
  lowerKey :: Event -> Event
  lowerKey = mapKey (KChar . toLower)
  
  vimifiedKey :: Event -> Event
  vimifiedKey = mapKey vimify . lowerKey
   where
    vimify 'h' = KLeft
    vimify 'j' = KRight
    vimify 'k' = KLeft
    vimify 'l' = KRight
    vimify k = KChar k
  
  rowHeight :: Int
  rowHeight = 1
  
  -- Lens
  
  focussedBranchesL :: Lens' State (L.List Name Branch)
  focussedBranchesL =
    lens (\s -> s ^. branchLens s) (\s bs -> (branchLens s .~ bs) s)
   where
    branchLens s = case s ^. focusL of
      RLocal -> localBranchesL
      RRemote -> remoteBranchesL
  
  localBranchesL :: Lens' State (L.List Name Branch)
  localBranchesL = lens _localBranches (\s bs -> s{_localBranches = bs})
  
  remoteBranchesL :: Lens' State (L.List Name Branch)
  remoteBranchesL = lens _remoteBranches (\s bs -> s{_remoteBranches = bs})
  
  focusL :: Lens' State RemoteName
  focusL = lens _focus (\s f -> s{_focus = f})
  
  filterL :: Lens' State (E.Editor Text Name)
  filterL = lens _filter (\s f -> s{_filter = f})
  
  branchesL :: Lens' State [Branch]
  branchesL = lens _branches (\s f -> s{_branches = f})
  
  isEditingFilterL :: Lens' State Bool
  isEditingFilterL = lens _isEditingFilter (\s f -> s{_isEditingFilter = f})
  
  dialogL :: Lens' State (Maybe (D.Dialog DialogOption Name))
  dialogL = lens _dialog (\s v -> s{_dialog = v})
  
  gitCommandL :: Lens' State GitCommand
  gitCommandL = lens _gitCommand (\s v -> s{_gitCommand = v})
  