bunyan/src/Bunyan/App.hs

{-# LANGUAGE OverloadedStrings #-}

module Bunyan.App (runApp) where

import qualified Brick
import qualified Data.Map as M
import           Data.Monoid ((<>))
import qualified Data.Sequence as S
import qualified Data.Text as T
import qualified Graphics.Vty as Vty
import qualified Graphics.Vty.Input.Events as Vty

import qualified Bunyan.Log as Log


data Modal
  = AddSectionModal ()
  | ConfirmQuitModal
  deriving (Eq, Show)

data Annot
  = Annot T.Text Log.Entry
  | Skip Log.Entry
  deriving (Eq, Show)

data State = State
  { stateSections :: M.Map T.Text (S.Seq (S.Seq T.Text))
  , stateCommits  :: S.Seq Log.Entry
  , stateFinished :: S.Seq Annot
  , stateKeys     :: M.Map Char T.Text
  , stateModal    :: Maybe Modal
  , stateStatus   :: T.Text
  } deriving (Eq, Show)


defaultSections :: [(Char, T.Text)]
defaultSections =
  [ ('f', "New features")
  , ('b', "Bug fixes")
  , ('p', "Package changes")
  , ('d', "Documentation changes")
  , ('i', "Performance improvements")
  ]

newState :: S.Seq Log.Entry -> State
newState commits = State
  { stateSections = M.fromList
    [ (name, mempty) | (_, name) <- defaultSections ]
  , stateKeys = M.fromList defaultSections
  , stateCommits = commits
  , stateFinished = S.empty
  , stateModal = Nothing
  , stateStatus = ""
  }



runApp :: S.Seq Log.Entry -> IO (M.Map T.Text (S.Seq (S.Seq T.Text)))
runApp entries = do
  let state = newState entries
      vty = Vty.mkVty Vty.defaultConfig
  final <- Brick.customMain vty Nothing app state
  return (stateSections final)


app :: Brick.App State () ()
app = Brick.App
  { Brick.appDraw         = draw
  , Brick.appChooseCursor = Brick.showFirstCursor
  , Brick.appHandleEvent  = event
  , Brick.appStartEvent   = return
  , Brick.appAttrMap      = \ _ -> Brick.forceAttrMap mempty
  }


draw :: State -> [Brick.Widget ()]
draw st
  | Just ConfirmQuitModal <- stateModal st =
      [ Brick.txt "Are you sure you want to quit? (y/n)" ]
  | otherwise =
      [ Brick.vBox
        [ Brick.str (show (stateModal st))
        , Brick.txt (stateStatus st)
        ]
      ]


type EventHandler =
  State -> Vty.Key -> [Vty.Modifier] -> Brick.EventM () (Brick.Next State)

event :: State -> Brick.BrickEvent () () -> Brick.EventM () (Brick.Next State)
event st (Brick.VtyEvent (Vty.EvKey key mod)) =
  case stateModal st of
    Nothing -> mainEvent st key mod
    Just ConfirmQuitModal -> confirmQuitEvent st key mod
    Just (AddSectionModal ()) -> addSectionEvent st key mod
event st _ = Brick.continue st


mainEvent :: EventHandler
mainEvent st (Vty.KChar ' ') [] = do
  let car S.:< cdr = S.viewl (stateCommits st)
  Brick.continue st
    { stateFinished = Skip car S.<| stateFinished st
    , stateCommits = cdr
    , stateStatus = "skipped"
    }

mainEvent st (Vty.KChar 'q') [] =
  Brick.continue st { stateModal = Just ConfirmQuitModal }

mainEvent st (Vty.KChar 'a') [] =
  Brick.continue st { stateModal = Just (AddSectionModal ()) }

mainEvent st (Vty.KChar c) []
  | Just annot <- M.lookup c (stateKeys st) = do
      let car S.:< cdr = S.viewl (stateCommits st)
      Brick.continue st
        { stateFinished = Annot annot car S.<| stateFinished st
        , stateCommits  = cdr
        , stateSections =
          M.adjust ((Log.logMessage car) S.<|) annot (stateSections st)
        , stateStatus =
          "Added " <> Log.logCommit car <> " to section " <> annot
        }
  | otherwise =
    Brick.continue st { stateStatus = "Unknown keybindings: " <> T.pack (show c) }

mainEvent st _ _ = Brick.continue st


confirmQuitEvent :: EventHandler
confirmQuitEvent st (Vty.KChar 'y') _ = Brick.halt st
confirmQuitEvent st _ _  = Brick.continue st { stateModal = Nothing }


addSectionEvent :: EventHandler
addSectionEvent st _ _ = Brick.continue st { stateModal = Nothing }