-- | Module    : Hum.Views.Library
-- Copyright   : (c) Itai Y. Efrat 2020-2021
-- License     : GPLv2-or-later (see LICENSE)
-- Maintainer  : Itai Y. Efrat <itai3397@gmail.com>
--
-- Functions for the Help view.

module Hum.Views.Common where
import           Hum.Types
import           Brick.Types
import           Brick.Widgets.Core
import           Brick.Widgets.Center
import           Brick.Widgets.Edit
import           Brick.Widgets.Border
import           Hum.Attributes
import           Hum.Utils
import qualified Network.MPD                   as MPD
import qualified Data.Text                     as T
import           Brick.Widgets.List
import           Control.Lens

-- | Draw Now Playing box.
drawNowPlaying :: HumState -> Widget Name
drawNowPlaying :: HumState -> Widget Name
drawNowPlaying HumState
st = Name -> Widget Name -> Widget Name
forall n. n -> Widget n -> Widget n
reportExtent Name
NowPlaying (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
5 (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name -> Widget Name
forall n. Widget n -> Widget n
center (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name -> (Song -> Widget Name) -> Maybe Song -> Widget Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
  (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"nothing.")
  Song -> Widget Name
nowPlaying
  (HumState -> Maybe Song
currentSong HumState
st)
 where
  nowPlaying :: Song -> Widget Name
nowPlaying Song
song =
    Text -> Widget Name
forall n. Text -> Widget n
txt Text
"\n"
      Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter Widget Name
forall n. Widget n
title
      Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name
forall n. Widget n
artist Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget Name
forall n. Text -> Widget n
txt Text
" - " Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
forall n. Widget n
album)
      Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
progbar
      Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> (Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max Widget Name
forall n. Widget n
playing Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max Widget Name
forall n. Widget n
mode)
   where
    title :: Widget n
title = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
titleAttr (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 -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Metadata -> Song -> Text
meta Text
"<no title>" Metadata
MPD.Title Song
song
    album :: Widget n
album =
      AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
albumAttr (Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Metadata -> Song -> Text
meta Text
"<no album>" Metadata
MPD.Album Song
song)
        Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget n
forall n. Text -> Widget n
txt Text
" ("
        Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
dateAttr (Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Metadata -> Song -> Text
meta Text
"????" Metadata
MPD.Date Song
song)
        Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget n
forall n. Text -> Widget n
txt Text
")"
    artist :: Widget n
artist  = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
artistAttr (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 -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Metadata -> Song -> Text
meta Text
"<no one>" Metadata
MPD.Artist Song
song
    progbar :: Widget Name
progbar = AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
timeAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ HumState -> Widget Name
drawProgressBar HumState
st
    playing :: Widget n
playing = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> (Status -> Text) -> Maybe Status -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      Text
"[       ]"
      ((\Text
t -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") (Text -> Text) -> (Status -> Text) -> Status -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (Status -> Text) -> Status -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlaybackState -> Text
forall b a. (Show a, IsString b) => a -> b
show (PlaybackState -> Text)
-> (Status -> PlaybackState) -> Status -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> PlaybackState
MPD.stState)
      (HumState -> Maybe Status
status HumState
st)
    formatMode :: b -> (Status -> Bool) -> b
formatMode b
t Status -> Bool
modeFun = b -> (Status -> b) -> Maybe Status -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      b
"-"
      ( (\case
          Bool
False -> b
"-"
          Bool
True  -> b
t
        )
      (Bool -> b) -> (Status -> Bool) -> Status -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Bool
modeFun
      )
      (HumState -> Maybe Status
status HumState
st)
    repeatmpd :: Text
repeatmpd = Text -> (Status -> Bool) -> Text
forall b. IsString b => b -> (Status -> Bool) -> b
formatMode Text
"r" Status -> Bool
MPD.stRepeat
    random :: Text
random    = Text -> (Status -> Bool) -> Text
forall b. IsString b => b -> (Status -> Bool) -> b
formatMode Text
"z" Status -> Bool
MPD.stRandom
    single :: Text
single    = Text -> (Status -> Bool) -> Text
forall b. IsString b => b -> (Status -> Bool) -> b
formatMode Text
"s" Status -> Bool
MPD.stSingle
    consume :: Text
consume   = Text -> (Status -> Bool) -> Text
forall b. IsString b => b -> (Status -> Bool) -> b
formatMode Text
"c" Status -> Bool
MPD.stConsume
    crossfade :: Text
crossfade = Text -> (Status -> Bool) -> Text
forall b. IsString b => b -> (Status -> Bool) -> b
formatMode Text
"x" ((Seconds -> Seconds -> Bool
forall a. Eq a => a -> a -> Bool
/= Seconds
0) (Seconds -> Bool) -> (Status -> Seconds) -> Status -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Seconds
MPD.stXFadeWidth)
    mode :: Widget n
mode =
      Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
repeatmpd Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
random Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
single Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
consume Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
crossfade Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"

-- | Draw progress bar for song time.
drawProgressBar :: HumState -> Widget Name
drawProgressBar :: HumState -> Widget Name
drawProgressBar HumState
st =
  Size -> Size -> RenderM Name (Result Name) -> Widget Name
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed  (RenderM Name (Result Name) -> Widget Name)
-> RenderM Name (Result Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ do
    Context
ctx <- RenderM Name Context
forall n. RenderM n Context
getContext
    let width :: Int
width = Context
ctx Context -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Context Int
Lens' Context Int
windowWidthL
    Widget Name -> RenderM Name (Result Name)
forall n. Widget n -> RenderM n (Result n)
render (Widget Name -> RenderM Name (Result Name))
-> Widget Name -> RenderM Name (Result Name)
forall a b. (a -> b) -> a -> b
$ Int -> Widget Name
forall n. Int -> Widget n
bar Int
width
 where
  songTime :: (FractionalSeconds, FractionalSeconds)
songTime = (FractionalSeconds, FractionalSeconds)
-> Maybe (FractionalSeconds, FractionalSeconds)
-> (FractionalSeconds, FractionalSeconds)
forall a. a -> Maybe a -> a
fromMaybe (FractionalSeconds
0, FractionalSeconds
1) (Status -> Maybe (FractionalSeconds, FractionalSeconds)
MPD.stTime (Status -> Maybe (FractionalSeconds, FractionalSeconds))
-> Maybe Status -> Maybe (FractionalSeconds, FractionalSeconds)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HumState -> Maybe Status
status HumState
st)
  timeText :: String
timeText =
    Text -> String
forall a. ToString a => a -> String
toString
      (Text -> String)
-> ((FractionalSeconds, FractionalSeconds) -> Text)
-> (FractionalSeconds, FractionalSeconds)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(FractionalSeconds
i, FractionalSeconds
j) -> Seconds -> Text
secondsToTime (FractionalSeconds -> Seconds
forall a b. (RealFrac a, Integral b) => a -> b
round FractionalSeconds
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Seconds -> Text
secondsToTime (FractionalSeconds -> Seconds
forall a b. (RealFrac a, Integral b) => a -> b
round FractionalSeconds
j))
      ((FractionalSeconds, FractionalSeconds) -> String)
-> (FractionalSeconds, FractionalSeconds) -> String
forall a b. (a -> b) -> a -> b
$ (FractionalSeconds, FractionalSeconds)
songTime
  completed :: a -> b
completed a
width = (\a
w (FractionalSeconds
i, FractionalSeconds
j) -> FractionalSeconds -> b
forall a b. (RealFrac a, Integral b) => a -> b
round ((FractionalSeconds
i FractionalSeconds -> FractionalSeconds -> FractionalSeconds
forall a. Fractional a => a -> a -> a
/ FractionalSeconds
j) FractionalSeconds -> FractionalSeconds -> FractionalSeconds
forall a. Num a => a -> a -> a
* a -> FractionalSeconds
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w)) a
width (FractionalSeconds, FractionalSeconds)
songTime
  bar :: Int -> Widget n
bar Int
width     = String -> Widget n
forall n. String -> Widget n
str
    ((Char -> Char -> Char) -> String -> String -> String
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
      (\Char
a Char
b -> if Char
a Char -> String -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` (String
"1234567890/:" :: String) then Char
a else Char
b)
      (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (-Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
width Int
2) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
timeText String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate
        (-Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
width Int
2)
        Char
' '
      )
      (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int -> Int
forall b a. (Integral b, Integral a) => a -> b
completed Int
width) Char
'=' String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int -> Int
forall b a. (Integral b, Integral a) => a -> b
completed Int
width)) Char
' ')
    )

-- | Either a number or a percent. To be used for widget horizontal size.
data PerCol =
    Per Int -- ^ percent size
  | Col Int -- ^ column number size

-- | Helper function for drawing column rows.
column
  :: Maybe PerCol -- ^ Maximum width, greedy if Nothing.
  -> Padding -- ^ Left padding
  -> Padding -- ^ Right padding
  -> Widget n
  -> Widget n
column :: Maybe PerCol -> Padding -> Padding -> Widget n -> Widget n
column Maybe PerCol
maxWidth Padding
left Padding
right Widget n
w = case Maybe PerCol
maxWidth of
  Maybe PerCol
Nothing      -> Widget n
wpad
  Just (Per Int
m) -> Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimitPercent Int
m Widget n
wpad
  Just (Col Int
m) -> Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
m Widget n
wpad
  where wpad :: Widget n
wpad = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft Padding
left (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight Padding
right (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n
w

-- | Returns True if text is substring of one of the given tags of the given song.
songSearch :: Text -> [MPD.Metadata] -> MPD.Song -> Bool
songSearch :: Text -> [Metadata] -> Song -> Bool
songSearch Text
text [Metadata]
metadata Song
song =
  let mtags :: [Maybe Text]
mtags = (Text -> Text
T.toLower (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe Text -> Maybe Text)
-> (Metadata -> Maybe Text) -> Metadata -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Metadata -> Song -> Maybe Text
`mmeta` Song
song) (Metadata -> Maybe Text) -> [Metadata] -> [Maybe Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Metadata]
metadata
  in  [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> [Maybe Bool] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Text -> Bool
T.isInfixOf (Text -> Text
T.toLower Text
text) (Text -> Bool) -> [Maybe Text] -> [Maybe Bool]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> [Maybe Text]
mtags)

-- | Returns True if text is substring of the given strings.
stringySearch :: MPD.ToString a => Text -> a -> Bool
stringySearch :: Text -> a -> Bool
stringySearch Text
text a
value =
  Text -> Text -> Bool
T.isInfixOf (Text -> Text
T.toLower Text
text) (Text -> Text
T.toLower (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToString a => a -> Text
MPD.toText (a -> Text) -> a -> Text
forall a b. (a -> b) -> a -> b
$ a
value)

-- | Draws a prompt.
drawPrompt :: HumState -> Widget Name
drawPrompt :: HumState -> Widget Name
drawPrompt HumState
st = case HumState
st HumState -> Getting PromptType HumState PromptType -> PromptType
forall s a. s -> Getting a s a -> a
^. (Prompts -> Const PromptType Prompts)
-> HumState -> Const PromptType HumState
Lens' HumState Prompts
promptsL ((Prompts -> Const PromptType Prompts)
 -> HumState -> Const PromptType HumState)
-> ((PromptType -> Const PromptType PromptType)
    -> Prompts -> Const PromptType Prompts)
-> Getting PromptType HumState PromptType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PromptType -> Const PromptType PromptType)
-> Prompts -> Const PromptType Prompts
Lens' Prompts PromptType
currentPromptL of
  PromptType
PlSelectPrompt ->
    Widget Name -> Widget Name
forall n. Widget n -> Widget n
centerLayer
      (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   Widget Name -> Widget Name
forall n. Widget n -> Widget n
border
      (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   (Int, Int) -> Widget Name -> Widget Name
forall n. (Int, Int) -> Widget n -> Widget n
setAvailableSize (Int
30, Int
10)
      (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   Widget Name -> Widget Name
forall n. Widget n -> Widget n
center
      (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
hCenter (Widget Name -> Widget Name)
-> (Text -> Widget Name) -> Text -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ HumState
st HumState -> Getting Text HumState Text -> Text
forall s a. s -> Getting a s a -> a
^. (Prompts -> Const Text Prompts) -> HumState -> Const Text HumState
Lens' HumState Prompts
promptsL ((Prompts -> Const Text Prompts)
 -> HumState -> Const Text HumState)
-> ((Text -> Const Text Text) -> Prompts -> Const Text Prompts)
-> Getting Text HumState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> Prompts -> Const Text Prompts
Lens' Prompts Text
promptTitleL)
      Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
forall n. Widget n
hBorder
      Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> (Int -> Bool -> Maybe PlaylistName -> Widget Name)
-> Bool
-> GenericList Name Vector (Maybe PlaylistName)
-> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Int -> Bool -> e -> Widget n)
-> Bool -> GenericList n t e -> Widget n
renderListWithIndex Int -> Bool -> Maybe PlaylistName -> Widget Name
forall n. Int -> Bool -> Maybe PlaylistName -> Widget n
drawPlSelectRow
                              Bool
True
                              (HumState
st HumState
-> Getting
     (GenericList Name Vector (Maybe PlaylistName))
     HumState
     (GenericList Name Vector (Maybe PlaylistName))
-> GenericList Name Vector (Maybe PlaylistName)
forall s a. s -> Getting a s a -> a
^. (Prompts
 -> Const (GenericList Name Vector (Maybe PlaylistName)) Prompts)
-> HumState
-> Const (GenericList Name Vector (Maybe PlaylistName)) HumState
Lens' HumState Prompts
promptsL ((Prompts
  -> Const (GenericList Name Vector (Maybe PlaylistName)) Prompts)
 -> HumState
 -> Const (GenericList Name Vector (Maybe PlaylistName)) HumState)
-> ((GenericList Name Vector (Maybe PlaylistName)
     -> Const
          (GenericList Name Vector (Maybe PlaylistName))
          (GenericList Name Vector (Maybe PlaylistName)))
    -> Prompts
    -> Const (GenericList Name Vector (Maybe PlaylistName)) Prompts)
-> Getting
     (GenericList Name Vector (Maybe PlaylistName))
     HumState
     (GenericList Name Vector (Maybe PlaylistName))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenericList Name Vector (Maybe PlaylistName)
 -> Const
      (GenericList Name Vector (Maybe PlaylistName))
      (GenericList Name Vector (Maybe PlaylistName)))
-> Prompts
-> Const (GenericList Name Vector (Maybe PlaylistName)) Prompts
Lens' Prompts (GenericList Name Vector (Maybe PlaylistName))
plSelectPromptL)
  PromptType
TextPrompt ->
    Widget Name -> Widget Name
forall n. Widget n -> Widget n
centerLayer
      (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   Widget Name -> Widget Name
forall n. Widget n -> Widget n
border
      (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   (Int, Int) -> Widget Name -> Widget Name
forall n. (Int, Int) -> Widget n -> Widget n
setAvailableSize (Int
30, Int
3)
      (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   Widget Name -> Widget Name
forall n. Widget n -> Widget n
center
      (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
hCenter (Widget Name -> Widget Name)
-> (Text -> Widget Name) -> Text -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ HumState
st HumState -> Getting Text HumState Text -> Text
forall s a. s -> Getting a s a -> a
^. (Prompts -> Const Text Prompts) -> HumState -> Const Text HumState
Lens' HumState Prompts
promptsL ((Prompts -> Const Text Prompts)
 -> HumState -> Const Text HumState)
-> ((Text -> Const Text Text) -> Prompts -> Const Text Prompts)
-> Getting Text HumState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> Prompts -> Const Text Prompts
Lens' Prompts Text
promptTitleL)
      Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
forall n. Widget n
hBorder
      Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> (Widget Name -> Widget Name
forall n. Widget n -> Widget n
center (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Widget Name -> Widget Name
forall n. (Int, Int) -> Widget n -> Widget n
setAvailableSize (Int
25, Int
1) (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
editorAttr)
            (([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 (HumState
st HumState
-> Getting (Editor Text Name) HumState (Editor Text Name)
-> Editor Text Name
forall s a. s -> Getting a s a -> a
^. (Prompts -> Const (Editor Text Name) Prompts)
-> HumState -> Const (Editor Text Name) HumState
Lens' HumState Prompts
promptsL ((Prompts -> Const (Editor Text Name) Prompts)
 -> HumState -> Const (Editor Text Name) HumState)
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> Prompts -> Const (Editor Text Name) Prompts)
-> Getting (Editor Text Name) HumState (Editor Text Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Editor Text Name -> Const (Editor Text Name) (Editor Text Name))
-> Prompts -> Const (Editor Text Name) Prompts
Lens' Prompts (Editor Text Name)
textPromptL))
  PromptType
YNPrompt ->
    Widget Name -> Widget Name
forall n. Widget n -> Widget n
centerLayer
      (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   Widget Name -> Widget Name
forall n. Widget n -> Widget n
border
      (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
30
      (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
hCenter (Widget Name -> Widget Name)
-> (Text -> Widget Name) -> Text -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ HumState
st HumState -> Getting Text HumState Text -> Text
forall s a. s -> Getting a s a -> a
^. (Prompts -> Const Text Prompts) -> HumState -> Const Text HumState
Lens' HumState Prompts
promptsL ((Prompts -> Const Text Prompts)
 -> HumState -> Const Text HumState)
-> ((Text -> Const Text Text) -> Prompts -> Const Text Prompts)
-> Getting Text HumState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> Prompts -> Const Text Prompts
Lens' Prompts Text
promptTitleL)
      Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> (Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name)
-> (Text -> Widget Name) -> Text -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text
"[y/n]")

-- | Draw row in playlist select prompt.
drawPlSelectRow :: Int -> Bool -> Maybe MPD.PlaylistName -> Widget n
drawPlSelectRow :: Int -> Bool -> Maybe PlaylistName -> Widget n
drawPlSelectRow Int
i Bool
_ Maybe PlaylistName
pl = if Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0 then
  String -> Widget n
forall n. String -> Widget n
str String
"New Playlist" Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> (Attr -> Attr) -> Widget n -> Widget n
forall n. (Attr -> Attr) -> Widget n -> Widget n
modifyDefAttr (Attr -> Attr -> Attr
forall a b. a -> b -> a
const Attr
wobAttr) Widget n
forall n. Widget n
hBorder
  else String -> Widget n
forall n. String -> Widget n
str (PlaylistName -> String
forall a. ToString a => a -> String
MPD.toString (PlaylistName -> String) -> PlaylistName -> String
forall a b. (a -> b) -> a -> b
$ PlaylistName -> Maybe PlaylistName -> PlaylistName
forall a. a -> Maybe a -> a
fromMaybe PlaylistName
"<error getting playlist name>" Maybe PlaylistName
pl)