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

module Matterhorn.Draw.ListWindow
  ( drawListWindow
  , WindowPosition(..)
  )
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 :: forall n. Int -> Widget n -> Widget n
hLimitWithPadding Int
pad Widget n
contents = Widget
  { hSize :: Size
hSize  = Size
Fixed
  , vSize :: Size
vSize  = (forall n. Widget n -> Size
vSize Widget n
contents)
  , render :: RenderM n (Result n)
render =
      forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall a b. a -> (a -> b) -> b
& forall n. Lens' (Context n) Int
availWidthL  forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\ Int
n -> Int
n forall a. Num a => a -> a -> a
- (Int
2 forall a. Num a => a -> a -> a
* Int
pad))) forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Widget n
cropToContext Widget n
contents
  }

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

-- | Draw a ListWindowState. This draws a bordered box with the
-- window's search input and results list inside the box. The provided
-- functions determine how to render the window in various states.
drawListWindow :: ListWindowState a b
               -- ^ The window 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 window's
               -- list
               -> Maybe (Widget Name)
               -- ^ The footer widget to render underneath the search
               -- results
               -> WindowPosition
               -- ^ How to position the window layer
               -> Int
               -- ^ The maximum window width in columns
               -> Widget Name
drawListWindow :: forall a b.
ListWindowState a b
-> (b -> Widget Name)
-> (b -> Widget Name)
-> (b -> Widget Name)
-> (Bool -> a -> Widget Name)
-> Maybe (Widget Name)
-> WindowPosition
-> Int
-> Widget Name
drawListWindow ListWindowState a b
st b -> Widget Name
scopeHeader b -> Widget Name
scopeNoResults b -> Widget Name
scopePrompt Bool -> a -> Widget Name
renderItem Maybe (Widget Name)
footer WindowPosition
layerPos Int
maxWinWidth =
  forall n. Widget n -> Widget n
positionLayer forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimitWithPadding Int
10 forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit Int
25 forall a b. (a -> b) -> a -> b
$
  forall n. Int -> Widget n -> Widget n
hLimit Int
maxWinWidth forall a b. (a -> b) -> a -> b
$
  forall n. Widget n -> Widget n -> Widget n
borderWithLabel Widget Name
title Widget Name
body
  where
      title :: Widget Name
title = forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr forall a b. (a -> b) -> a -> b
$
              forall n. [Widget n] -> Widget n
hBox [ b -> Widget Name
scopeHeader b
scope
                   , case ListWindowState a b
stforall s a. s -> Getting a s a -> a
^.forall a b. Lens' (ListWindowState a b) (Maybe Int)
listWindowRecordCount of
                         Maybe Int
Nothing -> forall n. Widget n
emptyWidget
                         Just Int
c -> forall n. Text -> Widget n
txt Text
" (" forall n. Widget n -> Widget n -> Widget n
<+> forall n. String -> Widget n
str (forall a. Show a => a -> String
show Int
c) forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt Text
")"
                   ]
      positionLayer :: Widget n -> Widget n
positionLayer = case WindowPosition
layerPos of
          WindowPosition
WindowCenter -> forall n. Widget n -> Widget n
centerLayer
          WindowPosition
WindowUpperRight -> forall n. Widget n -> Widget n
upperRightLayer
      body :: Widget Name
body = forall n. [Widget n] -> Widget n
vBox [ (forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) Widget Name
promptMsg) forall n. Widget n -> Widget n -> Widget n
<+>
                    forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor (forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines) Bool
True (ListWindowState a b
stforall s a. s -> Getting a s a -> a
^.forall a b. Lens' (ListWindowState a b) (Editor Text Name)
listWindowSearchInput)
                  , forall n. Widget n
cursorPositionBorder
                  , Widget Name
showResults
                  , forall a. a -> Maybe a -> a
fromMaybe forall n. Widget n
emptyWidget Maybe (Widget Name)
footer
                  ]
      plural :: a -> a
plural a
1 = a
""
      plural a
_ = a
"s"
      cursorPositionBorder :: Widget n
cursorPositionBorder =
          if ListWindowState a b
stforall s a. s -> Getting a s a -> a
^.forall a b. Lens' (ListWindowState a b) Bool
listWindowSearching
          then forall n. Widget n -> Widget n
hBorderWithLabel forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"[Searching...]"
          else case ListWindowState a b
stforall s a. s -> Getting a s a -> a
^.forall a b. Lens' (ListWindowState a b) (List Name a)
listWindowSearchResultsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
L.listSelectedL of
              Maybe Int
Nothing -> forall n. Widget n
hBorder
              Just Int
_ ->
                  let showingFirst :: String
showingFirst = String
"Showing first " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
numSearchResults forall a. Semigroup a => a -> a -> a
<>
                                     String
" result" forall a. Semigroup a => a -> a -> a
<> forall {a} {a}. (Eq a, Num a, IsString a) => a -> a
plural Int
numSearchResults
                      showingAll :: String
showingAll = String
"Showing all " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
numSearchResults forall a. Semigroup a => a -> a -> a
<>
                                   String
" result" forall a. Semigroup a => a -> a -> a
<> forall {a} {a}. (Eq a, Num a, IsString a) => a -> a
plural Int
numSearchResults
                      showing :: String
showing = String
"Showing " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
numSearchResults forall a. Semigroup a => a -> a -> a
<>
                                String
" result" forall a. Semigroup a => a -> a -> a
<> forall {a} {a}. (Eq a, Num a, IsString a) => a -> a
plural Int
numSearchResults
                      msg :: String
msg = case forall t n. Monoid t => Editor t n -> [t]
getEditContents (ListWindowState a b
stforall s a. s -> Getting a s a -> a
^.forall a b. Lens' (ListWindowState a b) (Editor Text Name)
listWindowSearchInput) of
                          [Text
""] ->
                              case ListWindowState a b
stforall s a. s -> Getting a s a -> a
^.forall a b. Lens' (ListWindowState a b) (Maybe Int)
listWindowRecordCount of
                                  Maybe Int
Nothing -> String
showing
                                  Just Int
total -> if Int
numSearchResults forall a. Ord a => a -> a -> Bool
< Int
total
                                                then String
showingFirst
                                                else String
showingAll
                          [Text]
_ -> String
showing
                  in forall n. Widget n -> Widget n
hBorderWithLabel forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ String
"[" forall a. Semigroup a => a -> a -> a
<> String
msg forall a. Semigroup a => a -> a -> a
<> String
"]"

      scope :: b
scope = ListWindowState a b
stforall s a. s -> Getting a s a -> a
^.forall a b. Lens' (ListWindowState a b) b
listWindowSearchScope
      promptMsg :: Widget Name
promptMsg = b -> Widget Name
scopePrompt b
scope

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

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

      renderedUserList :: Widget Name
renderedUserList = 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 (ListWindowState a b
stforall s a. s -> Getting a s a -> a
^.forall a b. Lens' (ListWindowState a b) (List Name a)
listWindowSearchResults)
      numSearchResults :: Int
numSearchResults = forall (t :: * -> *) a. Foldable t => t a -> Int
F.length forall a b. (a -> b) -> a -> b
$ ListWindowState a b
stforall s a. s -> Getting a s a -> a
^.forall a b. Lens' (ListWindowState a b) (List Name a)
listWindowSearchResultsforall b c a. (b -> c) -> (a -> b) -> a -> c
.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 :: forall n. Widget n -> Widget n
upperRightLayer Widget a
w =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget a
w) (forall n. Widget n -> Size
vSize Widget a
w) forall a b. (a -> b) -> a -> b
$ do
        Result a
result <- forall n. Widget n -> RenderM n (Result n)
render Widget a
w
        Context a
c <- forall n. RenderM n (Context n)
getContext
        let rWidth :: Int
rWidth = Result a
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
imageWidth
            leftPaddingAmount :: Int
leftPaddingAmount = forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ Context a
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL forall a. Num a => a -> a -> a
- Int
rWidth
            paddedImage :: Image
paddedImage = Int -> Image -> Image
translateX Int
leftPaddingAmount forall a b. (a -> b) -> a -> b
$ Result a
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL
            off :: Location
off = (Int, Int) -> Location
Location (Int
leftPaddingAmount, Int
0)
        if Int
leftPaddingAmount forall a. Eq a => a -> a -> Bool
== Int
0 then
            forall (m :: * -> *) a. Monad m => a -> m a
return Result a
result else
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. Location -> Result n -> Result n
addResultOffset Location
off
                   forall a b. (a -> b) -> a -> b
$ Result a
result forall a b. a -> (a -> b) -> b
& forall n. Lens' (Result n) Image
imageL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Image
paddedImage