AutoComplete.hs

module UI.Widgets.AutoComplete where

import Data.Text as T
import Data.Typeable (Proxy, eqT, (:~:)(..))
import System.Console.ANSI (Color(..))
import Text.Printf

import Common
import Highlighter.Highlighter
import UI.Widgets.Common

data AutoCompleteWidget = AutoCompleteWidget
  { acwContent    :: [(Text, Text)]
  , acwSelected   :: Int
  , acwPos        :: ScreenPos
  , acwVisibility :: Bool
  }

instance Container AutoCompleteWidget [(Text, Text)] where
  setContent ref t = do
    modifyWRef ref (\tcw -> tcw { acwContent = t, acwSelected = 0 })
  getContent ref =
    acwContent <$> readWRef ref

instance Selectable AutoCompleteWidget  where
  getSelection ref = do
    w <- readWRef ref
    case safeIndex (acwContent w) (acwSelected w) of
      Just (x, _) -> pure x
      Nothing -> pure ""

instance KeyInput AutoCompleteWidget  where
  getCursorInfo _ = pure Nothing
  handleInput ref ev =
    case ev of
      KeyCtrl _ _ _ ArrowUp -> do
        w <- readWRef ref
        let selected = acwSelected w
        if (selected > 0)
          then modifyWRef ref (\a -> a { acwSelected = selected - 1 } )
          else pure ()
      KeyCtrl _ _  _ ArrowDown -> do
        w <- readWRef ref
        let selected = acwSelected w
        if (selected < (Prelude.length (acwContent w) - 1))
          then modifyWRef ref (\a -> a { acwSelected = selected + 1 } )
          else pure ()
      _ -> pure ()

instance Moveable AutoCompleteWidget where
  move r p = modifyWRef r (\w -> w { acwPos =  p })
  getPos r = acwPos <$> readWRef r
  getDim r = do
    w <- readWRef r
    let
      c = acwContent w
      contentLength = Prelude.length $ acwContent w
      maxContentLength = case c of
        [] -> 0
        cnt@(_:_) -> Prelude.maximum $ (T.length . snd) <$> cnt
    pure $ Dimensions (maxContentLength+2) (contentLength+2)
  resize _ _ = pure ()

instance Widget AutoCompleteWidget where
  hasCapability (DrawableCap _) = Just Dict
  hasCapability (SelectableCap _) = Just Dict
  hasCapability (KeyInputCap _) = Just Dict
  hasCapability (MoveableCap _) = Just Dict
  hasCapability (ContainerCap _ (_ :: Proxy cnt)) = case eqT @cnt @([(Text, Text)]) of
    Just Refl -> Just Dict
    Nothing   -> Nothing

instance Drawable AutoCompleteWidget where
  setVisibility ref v = modifyWRef ref (\c -> c { acwVisibility = v })
  getVisibility ref = acwVisibility <$> readWRef ref
  draw ref = do
    w <- readWRef ref
    if (acwVisibility w)
      then do
        case acwContent w of
          (_:_) -> do
            let contentLen = Prelude.length $ acwContent w
            let maxWidth = Prelude.maximum (0 : ((T.length . snd) <$> acwContent w))
            drawBorderBox  (acwPos w) (Dimensions (maxWidth + 2) (2 + contentLen))
            mapM_ (putOneItem w (acwPos w) maxWidth) $ Prelude.zip [0..] (acwContent w)
          _ -> pure ()
      else pure ()
    where
      putOneItem w sp mw (offset, item) = do
        wSetCursor
          $ moveDown (offset + 1) $ moveRight 1 sp
        let stx = "%-" <> (show mw) <>"s"
        if offset == (acwSelected w)
            then csPutText (colorTextFg Blue  (T.pack $ printf stx (snd item)))
            else csPutText (colorTextFg White (T.pack $ printf stx (snd item)))

autoComplete
  :: WidgetM m (WRef AutoCompleteWidget)
autoComplete = newWRef $ AutoCompleteWidget [] 0 origin False