herms-1.8.1.2: src/AddCLI.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RankNTypes #-}
module AddCLI where

import Control.Monad
import Lens.Micro
import Lens.Micro.TH
import qualified Graphics.Vty as V

import qualified Brick.Main as M
import qualified Brick.Types as T
import Brick.Widgets.Core
  ( (<+>)
  , (<=>)
  , hLimit
  , vLimit
  , str
  )
import qualified Brick.Widgets.Center as C
import qualified Brick.Widgets.Edit as E
import qualified Brick.AttrMap as A
import qualified Brick.Focus as F
import Brick.Util (on)

data Name = RecipeName
          | Description
          | ServingSize
          | IngrAmount
          | IngrUnit
          | IngrName
          | IngrAttr
          | Directions
          | Tags
          deriving (Ord, Show, Eq)

data FocusChange = FocusDown
                 | FocusUp
                 | FocusLeft
                 | FocusRight
                 deriving Eq

data St =
    St { _focusRing :: F.FocusRing Name
       , _edit1 :: E.Editor String Name
       , _edit2 :: E.Editor String Name
       , _edit3 :: E.Editor String Name
       , _edit4 :: E.Editor String Name
       , _edit5 :: E.Editor String Name
       , _edit6 :: E.Editor String Name
       , _edit7 :: E.Editor String Name
       , _edit8 :: E.Editor String Name
       , _edit9 :: E.Editor String Name
       }

makeLenses ''St

drawUI :: St -> [T.Widget Name]
drawUI st = [ui]
    where
        e1 = F.withFocusRing (st^.focusRing) (E.renderEditor (str . unlines)) (st^.edit1)
        e2 = F.withFocusRing (st^.focusRing) (E.renderEditor (str . unlines)) (st^.edit2)
        e3 = F.withFocusRing (st^.focusRing) (E.renderEditor (str . unlines)) (st^.edit3)
        e4 = F.withFocusRing (st^.focusRing) (E.renderEditor (str . unlines)) (st^.edit4)
        e5 = F.withFocusRing (st^.focusRing) (E.renderEditor (str . unlines)) (st^.edit5)
        e6 = F.withFocusRing (st^.focusRing) (E.renderEditor (str . unlines)) (st^.edit6)
        e7 = F.withFocusRing (st^.focusRing) (E.renderEditor (str . unlines)) (st^.edit7)
        e8 = F.withFocusRing (st^.focusRing) (E.renderEditor (str . unlines)) (st^.edit8)
        e9 = F.withFocusRing (st^.focusRing) (E.renderEditor (str . unlines)) (st^.edit9)

        ui = C.center $
            str "                                    Herm's - Add a recipe" <=>
            str " " <=>
            (str "          Name: " <+> (hLimit 62 e1)) <=>
            str " " <=>
            (str "   Description: " <+> (hLimit 62 $ vLimit 4 e2)) <=>
            str " " <=>
            (str "  Serving size: " <+> (hLimit 3 e3)) <=>
            str " " <=>
            str "                  qty.   unit               name                attribute" <=>
            (str "  Ingredients: \n(one per line)  " 
              <+> (hLimit 7 $ vLimit 7 e4)
              <+> (hLimit 9 $ vLimit 7 e5)
              <+> (hLimit 28 $ vLimit 7 e6)
              <+> (hLimit 18 $ vLimit 7 e7))
              <=> 
            str " " <=>
            (str "   Directions: \n(one per line)  " <+> (hLimit 62 $ vLimit 8 e8)) <=>
            str " " <=>
            (str "          Tags: " <+> (hLimit 62 $ vLimit 1 e9)) <=>
            str " " <=>
            str "                      Tab / Shift+Tab           - Next / Previous field" <=>
            str "                      Ctrl + <Arrow keys>       - Navigate fields" <=>
            str "                      [Meta or Alt] + <h-j-k-l> - Navigate fields" <=>
            str "                      Esc                       - Save or Cancel"

appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St)
appEvent st (T.VtyEvent ev) =
    case ev of
        V.EvKey V.KEsc [] -> M.halt st
        V.EvKey (V.KChar '\t') [] -> M.continue $ st & focusRing %~ F.focusNext
        V.EvKey V.KBackTab [] -> M.continue $ st & focusRing %~ F.focusPrev
        
        -- Ctrl + <Arrow Keys>
        V.EvKey V.KDown [V.MCtrl] -> 
          M.continue $ st & focusRing %~ (determineNextFocus FocusDown st)
        V.EvKey V.KUp [V.MCtrl] -> 
          M.continue $ st & focusRing %~ (determineNextFocus FocusUp st)
        V.EvKey V.KRight [V.MCtrl] -> 
          M.continue $ st & focusRing %~ (determineNextFocus FocusRight st)
        V.EvKey V.KLeft [V.MCtrl] -> 
          M.continue $ st & focusRing %~ (determineNextFocus FocusLeft st)

        -- Meta + <h-j-k-l>
        V.EvKey (V.KChar 'h') [V.MMeta] -> 
          M.continue $ st & focusRing %~ (determineNextFocus FocusLeft st)
        V.EvKey (V.KChar 'j') [V.MMeta] -> 
          M.continue $ st & focusRing %~ (determineNextFocus FocusDown st)
        V.EvKey (V.KChar 'k') [V.MMeta] -> 
          M.continue $ st & focusRing %~ (determineNextFocus FocusUp st)
        V.EvKey (V.KChar 'l') [V.MMeta] -> 
          M.continue $ st & focusRing %~ (determineNextFocus FocusRight st)
 
        _ -> M.continue =<< case F.focusGetCurrent (st^.focusRing) of
               Just RecipeName -> T.handleEventLensed st edit1 E.handleEditorEvent ev
               Just Description -> T.handleEventLensed st edit2 E.handleEditorEvent ev
               Just ServingSize -> T.handleEventLensed st edit3 E.handleEditorEvent ev
               Just IngrAmount -> T.handleEventLensed st edit4 E.handleEditorEvent ev
               Just IngrUnit -> T.handleEventLensed st edit5 E.handleEditorEvent ev
               Just IngrName -> T.handleEventLensed st edit6 E.handleEditorEvent ev
               Just IngrAttr -> T.handleEventLensed st edit7 E.handleEditorEvent ev
               Just Directions -> T.handleEventLensed st edit8 E.handleEditorEvent ev
               Just Tags -> T.handleEventLensed st edit9 E.handleEditorEvent ev
               Nothing -> return st
appEvent st _ = M.continue st

determineNextFocus :: FocusChange -> St -> F.FocusRing n -> F.FocusRing n
determineNextFocus action st = 
  case action of
    FocusDown -> case currentFocus of 
        Just RecipeName -> (F.focusNext)
        Just Description -> (F.focusNext)
        Just ServingSize -> (F.focusNext)
        Just IngrAmount -> (F.focusNext . F.focusNext . F.focusNext . F.focusNext)
        Just IngrUnit -> (F.focusNext . F.focusNext . F.focusNext)
        Just IngrName -> (F.focusNext . F.focusNext)
        Just IngrAttr -> (F.focusNext)
        Just Directions -> (F.focusNext)
        Just Tags -> (F.focusNext)
        Nothing -> (F.focusNext)
    FocusUp -> case currentFocus of
        Just RecipeName -> (F.focusPrev)
        Just Description -> (F.focusPrev)
        Just ServingSize -> (F.focusPrev)
        Just IngrAttr -> (F.focusPrev . F.focusPrev . F.focusPrev . F.focusPrev)
        Just IngrName -> (F.focusPrev . F.focusPrev . F.focusPrev)
        Just IngrUnit -> (F.focusPrev . F.focusPrev)
        Just IngrAmount -> (F.focusPrev)
        Just Directions -> (F.focusPrev . F.focusPrev . F.focusPrev . F.focusPrev)
        Just Tags -> (F.focusPrev)
        Nothing -> (F.focusPrev)
    FocusLeft -> case currentFocus of
        Just RecipeName -> (F.focusNext . F.focusNext)
        Just Description -> (F.focusNext)
        Just ServingSize -> (F.focusNext)
        Just IngrAmount -> (F.focusNext . F.focusNext . F.focusNext)
        Just IngrUnit -> (F.focusPrev)
        Just IngrName -> (F.focusPrev)
        Just IngrAttr -> (F.focusPrev)
        Just Directions -> (F.focusPrev . F.focusPrev . F.focusPrev . F.focusPrev)
        Just Tags -> (F.focusPrev . F.focusPrev . F.focusPrev . F.focusPrev . F.focusPrev)
        Nothing -> (F.focusNext)
    FocusRight -> case currentFocus of
        Just RecipeName -> (F.focusNext . F.focusNext)
        Just Description -> (F.focusNext)
        Just ServingSize -> (F.focusNext)
        Just IngrAmount -> (F.focusNext)
        Just IngrUnit -> (F.focusNext)
        Just IngrName -> (F.focusNext)
        Just IngrAttr -> (F.focusPrev . F.focusPrev . F.focusPrev)
        Just Directions -> (F.focusPrev . F.focusPrev . F.focusPrev . F.focusPrev)
        Just Tags -> (F.focusPrev . F.focusPrev . F.focusPrev . F.focusPrev . F.focusPrev)
        Nothing -> (F.focusNext)
  where currentFocus = F.focusGetCurrent $ st^.focusRing


initialState :: String -> String -> String -> String -> String -> String -> String -> String -> String -> St
initialState name desc serving amounts units ingrs attrs dirs tags =
    St (F.focusRing [RecipeName, Description, ServingSize, IngrAmount, IngrUnit, IngrName, IngrAttr, Directions, Tags])
       (E.editor RecipeName (Just 1) name)
       (E.editor Description Nothing desc)
       (E.editor ServingSize (Just 1) serving)
       (E.editor IngrAmount Nothing amounts)
       (E.editor IngrUnit Nothing units)
       (E.editor IngrName Nothing ingrs)
       (E.editor IngrAttr Nothing attrs)
       (E.editor Directions Nothing dirs)
       (E.editor Tags (Just 1) tags)

theMap :: A.AttrMap
theMap = A.attrMap V.defAttr
    [ (E.editAttr,                   V.white `on` V.black)
    , (E.editFocusedAttr,            V.black `on` V.white)
    ]

appCursor :: St -> [T.CursorLocation Name] -> Maybe (T.CursorLocation Name)
appCursor = F.focusRingCursor (^.focusRing)

theApp :: M.App St e Name
theApp =
    M.App { M.appDraw = drawUI
          , M.appChooseCursor = appCursor
          , M.appHandleEvent = appEvent
          , M.appStartEvent = return
          , M.appAttrMap = const theMap
          }

getEdit :: String -> String -> String -> String -> String -> String -> String -> String -> String -> IO ([[String]])
getEdit name desc serving amounts units ingrs attrs dirs tags = do
  st <- M.defaultMain theApp (initialState name desc serving amounts units ingrs attrs dirs tags)
  return $ [ E.getEditContents $ st^.edit1
             , E.getEditContents $ st^.edit2
             , E.getEditContents $ st^.edit3
             , E.getEditContents $ st^.edit4
             , E.getEditContents $ st^.edit5
             , E.getEditContents $ st^.edit6
             , E.getEditContents $ st^.edit7
             , E.getEditContents $ st^.edit8 
             , E.getEditContents $ st^.edit9
             ] 

getAddInput :: IO ([[String]])
getAddInput = do 
  st <- M.defaultMain theApp (initialState "" "" "" "" "" "" "" "" "")
  return $ [ E.getEditContents $ st^.edit1
             , E.getEditContents $ st^.edit2
             , E.getEditContents $ st^.edit3
             , E.getEditContents $ st^.edit4
             , E.getEditContents $ st^.edit5
             , E.getEditContents $ st^.edit6
             , E.getEditContents $ st^.edit7
             , E.getEditContents $ st^.edit8 
             , E.getEditContents $ st^.edit9
             ]