{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Matterhorn.Draw.ListOverlay
  ( drawListOverlay
  , OverlayPosition(..)
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
import           Brick.Widgets.Border
import           Brick.Widgets.Center
import           Brick.Widgets.Edit
import qualified Brick.Widgets.List as L
import           Control.Monad.Trans.Reader ( withReaderT )
import qualified Data.Foldable as F
import qualified Data.Text as T
import           Graphics.Vty ( imageWidth, translateX)
import           Lens.Micro.Platform ( (%~), (.~), to )

import           Matterhorn.Themes
import           Matterhorn.Types


hLimitWithPadding :: Int -> Widget n -> Widget n
hLimitWithPadding :: Int -> Widget n -> Widget n
hLimitWithPadding Int
pad Widget n
contents = Widget :: forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget
  { hSize :: Size
hSize  = Size
Fixed
  , vSize :: Size
vSize  = (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
contents)
  , render :: RenderM n (Result n)
render =
      (Context -> Context)
-> RenderM n (Result n) -> RenderM n (Result n)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> Context -> Identity Context
Lens' Context Int
availWidthL  ((Int -> Identity Int) -> Context -> Identity Context)
-> (Int -> Int) -> Context -> Context
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\ Int
n -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pad))) (RenderM n (Result n) -> RenderM n (Result n))
-> RenderM n (Result n) -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
forall n. Widget n -> Widget n
cropToContext Widget n
contents
  }

data OverlayPosition =
    OverlayCenter
    | OverlayUpperRight
    deriving (OverlayPosition -> OverlayPosition -> Bool
(OverlayPosition -> OverlayPosition -> Bool)
-> (OverlayPosition -> OverlayPosition -> Bool)
-> Eq OverlayPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OverlayPosition -> OverlayPosition -> Bool
$c/= :: OverlayPosition -> OverlayPosition -> Bool
== :: OverlayPosition -> OverlayPosition -> Bool
$c== :: OverlayPosition -> OverlayPosition -> Bool
Eq, Int -> OverlayPosition -> ShowS
[OverlayPosition] -> ShowS
OverlayPosition -> String
(Int -> OverlayPosition -> ShowS)
-> (OverlayPosition -> String)
-> ([OverlayPosition] -> ShowS)
-> Show OverlayPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OverlayPosition] -> ShowS
$cshowList :: [OverlayPosition] -> ShowS
show :: OverlayPosition -> String
$cshow :: OverlayPosition -> String
showsPrec :: Int -> OverlayPosition -> ShowS
$cshowsPrec :: Int -> OverlayPosition -> ShowS
Show)

-- | Draw a ListOverlayState. This draws a bordered box with the
-- overlay's search input and results list inside the box. The provided
-- functions determine how to render the overlay in various states.
drawListOverlay :: ListOverlayState a b
                -- ^ The overlay state
                -> (b -> Widget Name)
                -- ^ The function to build the window title from the
                -- current search scope
                -> (b -> Widget Name)
                -- ^ The function to generate a message for the search
                -- scope indicating that no results were found
                -> (b -> Widget Name)
                -- ^ The function to generate the editor prompt for the
                -- search scope
                -> (Bool -> a -> Widget Name)
                -- ^ The function to render an item from the overlay's
                -- list
                -> Maybe (Widget Name)
                -- ^ The footer widget to render underneath the search
                -- results
                -> OverlayPosition
                -- ^ How to position the overlay layer
                -> Int
                -- ^ The maximum window width in columns
                -> Widget Name
drawListOverlay :: ListOverlayState a b
-> (b -> Widget Name)
-> (b -> Widget Name)
-> (b -> Widget Name)
-> (Bool -> a -> Widget Name)
-> Maybe (Widget Name)
-> OverlayPosition
-> Int
-> Widget Name
drawListOverlay ListOverlayState a b
st b -> Widget Name
scopeHeader b -> Widget Name
scopeNoResults b -> Widget Name
scopePrompt Bool -> a -> Widget Name
renderItem Maybe (Widget Name)
footer OverlayPosition
layerPos Int
maxWinWidth =
  Widget Name -> Widget Name
forall n. Widget n -> Widget n
positionLayer (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimitWithPadding Int
10 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
25 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
  Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
maxWinWidth (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
  Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
borderWithLabel Widget Name
title Widget Name
body
  where
      title :: Widget Name
title = AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
              [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ b -> Widget Name
scopeHeader b
scope
                   , case ListOverlayState a b
stListOverlayState a b
-> Getting (Maybe Int) (ListOverlayState a b) (Maybe Int)
-> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) (ListOverlayState a b) (Maybe Int)
forall a b. Lens' (ListOverlayState a b) (Maybe Int)
listOverlayRecordCount of
                         Maybe Int
Nothing -> Widget Name
forall n. Widget n
emptyWidget
                         Just Int
c -> Text -> Widget Name
forall n. Text -> Widget n
txt Text
" (" Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget Name
forall n. String -> Widget n
str (Int -> String
forall a. Show a => a -> String
show Int
c) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget Name
forall n. Text -> Widget n
txt Text
")"
                   ]
      positionLayer :: Widget n -> Widget n
positionLayer = case OverlayPosition
layerPos of
          OverlayPosition
OverlayCenter -> Widget n -> Widget n
forall n. Widget n -> Widget n
centerLayer
          OverlayPosition
OverlayUpperRight -> Widget n -> Widget n
forall n. Widget n -> Widget n
upperRightLayer
      body :: Widget Name
body = [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [ (Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) Widget Name
promptMsg) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>
                    ([Text] -> Widget Name) -> Bool -> Editor Text Name -> Widget Name
forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor (Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> ([Text] -> Text) -> [Text] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines) Bool
True (ListOverlayState a b
stListOverlayState a b
-> Getting
     (Editor Text Name) (ListOverlayState a b) (Editor Text Name)
-> Editor Text Name
forall s a. s -> Getting a s a -> a
^.Getting
  (Editor Text Name) (ListOverlayState a b) (Editor Text Name)
forall a b. Lens' (ListOverlayState a b) (Editor Text Name)
listOverlaySearchInput)
                  , Widget Name
forall n. Widget n
cursorPositionBorder
                  , Widget Name
showResults
                  , Widget Name -> Maybe (Widget Name) -> Widget Name
forall a. a -> Maybe a -> a
fromMaybe Widget Name
forall n. Widget n
emptyWidget Maybe (Widget Name)
footer
                  ]
      plural :: a -> p
plural a
1 = p
""
      plural a
_ = p
"s"
      cursorPositionBorder :: Widget n
cursorPositionBorder =
          if ListOverlayState a b
stListOverlayState a b
-> Getting Bool (ListOverlayState a b) Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool (ListOverlayState a b) Bool
forall a b. Lens' (ListOverlayState a b) Bool
listOverlaySearching
          then Widget n -> Widget n
forall n. Widget n -> Widget n
hBorderWithLabel (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
"[Searching...]"
          else case ListOverlayState a b
stListOverlayState a b
-> Getting (Maybe Int) (ListOverlayState a b) (Maybe Int)
-> Maybe Int
forall s a. s -> Getting a s a -> a
^.(List Name a -> Const (Maybe Int) (List Name a))
-> ListOverlayState a b -> Const (Maybe Int) (ListOverlayState a b)
forall a b. Lens' (ListOverlayState a b) (List Name a)
listOverlaySearchResults((List Name a -> Const (Maybe Int) (List Name a))
 -> ListOverlayState a b
 -> Const (Maybe Int) (ListOverlayState a b))
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> List Name a -> Const (Maybe Int) (List Name a))
-> Getting (Maybe Int) (ListOverlayState a b) (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Int -> Const (Maybe Int) (Maybe Int))
-> List Name a -> Const (Maybe Int) (List Name a)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
L.listSelectedL of
              Maybe Int
Nothing -> Widget n
forall n. Widget n
hBorder
              Just Int
_ ->
                  let showingFirst :: String
showingFirst = String
"Showing first " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
numSearchResults String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                                     String
" result" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a p. (Eq a, Num a, IsString p) => a -> p
plural Int
numSearchResults
                      showingAll :: String
showingAll = String
"Showing all " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
numSearchResults String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                                   String
" result" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a p. (Eq a, Num a, IsString p) => a -> p
plural Int
numSearchResults
                      showing :: String
showing = String
"Showing " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
numSearchResults String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                                String
" result" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a p. (Eq a, Num a, IsString p) => a -> p
plural Int
numSearchResults
                      msg :: String
msg = case Editor Text Name -> [Text]
forall t n. Monoid t => Editor t n -> [t]
getEditContents (ListOverlayState a b
stListOverlayState a b
-> Getting
     (Editor Text Name) (ListOverlayState a b) (Editor Text Name)
-> Editor Text Name
forall s a. s -> Getting a s a -> a
^.Getting
  (Editor Text Name) (ListOverlayState a b) (Editor Text Name)
forall a b. Lens' (ListOverlayState a b) (Editor Text Name)
listOverlaySearchInput) of
                          [Text
""] ->
                              case ListOverlayState a b
stListOverlayState a b
-> Getting (Maybe Int) (ListOverlayState a b) (Maybe Int)
-> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) (ListOverlayState a b) (Maybe Int)
forall a b. Lens' (ListOverlayState a b) (Maybe Int)
listOverlayRecordCount of
                                  Maybe Int
Nothing -> String
showing
                                  Just Int
total -> if Int
numSearchResults Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
total
                                                then String
showingFirst
                                                else String
showingAll
                          [Text]
_ -> String
showing
                  in Widget n -> Widget n
forall n. Widget n -> Widget n
hBorderWithLabel (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"

      scope :: b
scope = ListOverlayState a b
stListOverlayState a b -> Getting b (ListOverlayState a b) b -> b
forall s a. s -> Getting a s a -> a
^.Getting b (ListOverlayState a b) b
forall a b. Lens' (ListOverlayState a b) b
listOverlaySearchScope
      promptMsg :: Widget Name
promptMsg = b -> Widget Name
scopePrompt b
scope

      showMessage :: Widget n -> Widget n
showMessage = Widget n -> Widget n
forall n. Widget n -> Widget n
center (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr

      showResults :: Widget Name
showResults
        | Int
numSearchResults Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Widget Name -> Widget Name
forall n. Widget n -> Widget n
showMessage (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ b -> Widget Name
scopeNoResults b
scope
        | Bool
otherwise = Widget Name
renderedUserList

      renderedUserList :: Widget Name
renderedUserList = (Bool -> a -> Widget Name) -> Bool -> List Name a -> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
L.renderList Bool -> a -> Widget Name
renderItem Bool
True (ListOverlayState a b
stListOverlayState a b
-> Getting (List Name a) (ListOverlayState a b) (List Name a)
-> List Name a
forall s a. s -> Getting a s a -> a
^.Getting (List Name a) (ListOverlayState a b) (List Name a)
forall a b. Lens' (ListOverlayState a b) (List Name a)
listOverlaySearchResults)
      numSearchResults :: Int
numSearchResults = Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length (Vector a -> Int) -> Vector a -> Int
forall a b. (a -> b) -> a -> b
$ ListOverlayState a b
stListOverlayState a b
-> Getting (Vector a) (ListOverlayState a b) (Vector a) -> Vector a
forall s a. s -> Getting a s a -> a
^.(List Name a -> Const (Vector a) (List Name a))
-> ListOverlayState a b -> Const (Vector a) (ListOverlayState a b)
forall a b. Lens' (ListOverlayState a b) (List Name a)
listOverlaySearchResults((List Name a -> Const (Vector a) (List Name a))
 -> ListOverlayState a b -> Const (Vector a) (ListOverlayState a b))
-> ((Vector a -> Const (Vector a) (Vector a))
    -> List Name a -> Const (Vector a) (List Name a))
-> Getting (Vector a) (ListOverlayState a b) (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector a -> Const (Vector a) (Vector a))
-> List Name a -> Const (Vector a) (List Name a)
forall n (t1 :: * -> *) e1 (t2 :: * -> *) e2.
Lens (GenericList n t1 e1) (GenericList n t2 e2) (t1 e1) (t2 e2)
L.listElementsL

upperRightLayer :: Widget a -> Widget a
upperRightLayer :: Widget a -> Widget a
upperRightLayer Widget a
w =
    Size -> Size -> RenderM a (Result a) -> Widget a
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget a -> Size
forall n. Widget n -> Size
hSize Widget a
w) (Widget a -> Size
forall n. Widget n -> Size
vSize Widget a
w) (RenderM a (Result a) -> Widget a)
-> RenderM a (Result a) -> Widget a
forall a b. (a -> b) -> a -> b
$ do
        Result a
result <- Widget a -> RenderM a (Result a)
forall n. Widget n -> RenderM n (Result n)
render Widget a
w
        Context
c <- RenderM a Context
forall n. RenderM n Context
getContext
        let rWidth :: Int
rWidth = Result a
resultResult a -> Getting Int (Result a) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Image -> Const Int Image) -> Result a -> Const Int (Result a)
forall n. Lens' (Result n) Image
imageL((Image -> Const Int Image) -> Result a -> Const Int (Result a))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result a) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Image -> Int) -> SimpleGetter Image Int
forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
imageWidth
            leftPaddingAmount :: Int
leftPaddingAmount = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rWidth
            paddedImage :: Image
paddedImage = Int -> Image -> Image
translateX Int
leftPaddingAmount (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$ Result a
resultResult a -> Getting Image (Result a) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result a) Image
forall n. Lens' (Result n) Image
imageL
            off :: Location
off = (Int, Int) -> Location
Location (Int
leftPaddingAmount, Int
0)
        if Int
leftPaddingAmount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
            Result a -> RenderM a (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return Result a
result else
            Result a -> RenderM a (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a -> RenderM a (Result a))
-> Result a -> RenderM a (Result a)
forall a b. (a -> b) -> a -> b
$ Location -> Result a -> Result a
forall n. Location -> Result n -> Result n
addResultOffset Location
off
                   (Result a -> Result a) -> Result a -> Result a
forall a b. (a -> b) -> a -> b
$ Result a
result Result a -> (Result a -> Result a) -> Result a
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result a -> Identity (Result a)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result a -> Identity (Result a))
-> Image -> Result a -> Result a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Image
paddedImage