{-# LANGUAGE LambdaCase #-}
-- |

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.Map.Strict               as Map
import qualified Data.Text                     as T
import           Brick.Widgets.List
import           Control.Lens

drawNowPlaying :: HState -> Widget Name
drawNowPlaying :: HState -> Widget Name
drawNowPlaying HState
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
  (HState -> Maybe Song
currentSong HState
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
queueTitleAttr (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
queueAlbumAttr (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
queueDateAttr (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
queueArtistAttr (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
queueTimeAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ HState -> Widget Name
drawProgressBar HState
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)
      (HState -> Maybe Status
status HState
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
      )
      (HState -> Maybe Status
status HState
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
"]"

drawProgressBar :: HState -> Widget Name
drawProgressBar :: HState -> Widget Name
drawProgressBar HState
st = case Int
width of
  Int
0 -> Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. ToText a => a -> Text
Prelude.toText String
timeText
  Int
_ -> Widget Name
forall n. Widget n
bar
 where
  width :: Int
width =
    Int -> (Extent Name -> Int) -> Maybe (Extent Name) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 ((Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int)
-> (Extent Name -> (Int, Int)) -> Extent Name -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extent Name -> (Int, Int)
forall n. Extent n -> (Int, Int)
extentSize) (Maybe (Maybe (Extent Name)) -> Maybe (Extent Name)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Name
-> Map Name (Maybe (Extent Name)) -> Maybe (Maybe (Extent Name))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
NowPlaying (Map Name (Maybe (Extent Name)) -> Maybe (Maybe (Extent Name)))
-> Map Name (Maybe (Extent Name)) -> Maybe (Maybe (Extent Name))
forall a b. (a -> b) -> a -> b
$ HState -> Map Name (Maybe (Extent Name))
extentMap HState
st))
  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
=<< HState -> Maybe Status
status HState
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 :: Int
completed = (\Int
w (FractionalSeconds
i, FractionalSeconds
j) -> FractionalSeconds -> Int
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
* Int -> FractionalSeconds
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w)) Int
width (FractionalSeconds, FractionalSeconds)
songTime
  bar :: Widget n
bar       = 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
completed 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
completed) Char
' ')
    )

--drawEx :: HState -> Widget Name
--drawEx st =

data PerCol = Per Int | Col Int
column :: Maybe PerCol -> Padding -> 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

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)


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)

drawPrompt :: HState -> Widget Name
drawPrompt :: HState -> Widget Name
drawPrompt HState
st = case HState
st HState -> Getting PromptType HState PromptType -> PromptType
forall s a. s -> Getting a s a -> a
^. (Prompts -> Const PromptType Prompts)
-> HState -> Const PromptType HState
Lens' HState Prompts
promptsL ((Prompts -> Const PromptType Prompts)
 -> HState -> Const PromptType HState)
-> ((PromptType -> Const PromptType PromptType)
    -> Prompts -> Const PromptType Prompts)
-> Getting PromptType HState 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
$ HState
st HState -> Getting Text HState Text -> Text
forall s a. s -> Getting a s a -> a
^. (Prompts -> Const Text Prompts) -> HState -> Const Text HState
Lens' HState Prompts
promptsL ((Prompts -> Const Text Prompts) -> HState -> Const Text HState)
-> ((Text -> Const Text Text) -> Prompts -> Const Text Prompts)
-> Getting Text HState 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
choosePlRow
                              Bool
True
                              (HState
st HState
-> Getting
     (GenericList Name Vector (Maybe PlaylistName))
     HState
     (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)
-> HState
-> Const (GenericList Name Vector (Maybe PlaylistName)) HState
Lens' HState Prompts
promptsL ((Prompts
  -> Const (GenericList Name Vector (Maybe PlaylistName)) Prompts)
 -> HState
 -> Const (GenericList Name Vector (Maybe PlaylistName)) HState)
-> ((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))
     HState
     (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
$ HState
st HState -> Getting Text HState Text -> Text
forall s a. s -> Getting a s a -> a
^. (Prompts -> Const Text Prompts) -> HState -> Const Text HState
Lens' HState Prompts
promptsL ((Prompts -> Const Text Prompts) -> HState -> Const Text HState)
-> ((Text -> Const Text Text) -> Prompts -> Const Text Prompts)
-> Getting Text HState 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 (HState
st HState
-> Getting (Editor Text Name) HState (Editor Text Name)
-> Editor Text Name
forall s a. s -> Getting a s a -> a
^. (Prompts -> Const (Editor Text Name) Prompts)
-> HState -> Const (Editor Text Name) HState
Lens' HState Prompts
promptsL ((Prompts -> Const (Editor Text Name) Prompts)
 -> HState -> Const (Editor Text Name) HState)
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> Prompts -> Const (Editor Text Name) Prompts)
-> Getting (Editor Text Name) HState (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
$ HState
st HState -> Getting Text HState Text -> Text
forall s a. s -> Getting a s a -> a
^. (Prompts -> Const Text Prompts) -> HState -> Const Text HState
Lens' HState Prompts
promptsL ((Prompts -> Const Text Prompts) -> HState -> Const Text HState)
-> ((Text -> Const Text Text) -> Prompts -> Const Text Prompts)
-> Getting Text HState 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]")


choosePlRow :: Int -> Bool -> Maybe MPD.PlaylistName -> Widget n
choosePlRow :: Int -> Bool -> Maybe PlaylistName -> Widget n
choosePlRow 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)