{-#LANGUAGE RankNTypes#-}
-- |

module Hum.Views.Help where
import           Prelude                 hiding ( Down )
import           Hum.Types
import           Brick.Types
import           Graphics.Vty.Input.Events
import           Brick.Main
import           Brick.Widgets.Core
import           Brick.Widgets.Center
import           Control.Lens


drawViewHelp :: HState -> Widget Name
drawViewHelp :: HState -> Widget Name
drawViewHelp HState
st = Widget Name -> Widget Name
forall n. Widget n -> Widget n
center ((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
"j/k cycle between help screens.") Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Text -> Widget Name
forall n. Text -> Widget n
txt (HState -> Text
helpText HState
st))

helpText :: HState -> Text
helpText :: HState -> Text
helpText HState
st = [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ case HState
stHState -> Getting Int HState Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int HState Int
Lens' HState Int
helpScreenL of
  Int
0 -> [
          Text
"Change views:"
        , Text
"  1 - queue"
        , Text
"  2 - library"
        , Text
"  3 - playlists"
        , Text
""
        , Text
"General Bindings:"
        , Text
"  t       - play/pause toggle"
        , Text
"  ,       - previous song"
        , Text
"  .       - next song"
        , Text
"  [ and ] - skip 5 second in either direction"
        , Text
"  { and } - skip 30 second in either direction"
        , Text
"  hjkl    - vim movements"
        , Text
"  / and ? - forwards and backwards search"
        , Text
"  n and N - move to next and previous match of search"
        , Text
"  :       - execute commands"
        , Text
"  q       - quit"
        , Text
"  s       - toggle single mode in mpd"
        , Text
"  c       - toggle consume mode in mpd"
        , Text
"  x       - toggle crossfade mode in mpd"
        , Text
"  r       - toggle repeat mode in mpd"
        , Text
"  z       - toggle random mode in mpd"]
  Int
1 -> [
          Text
"Queue keybindings:"
        , Text
"  SPC - select song"
        , Text
"  y and d - yank and delete the selected songs"
        , Text
"  p   - paste selected song"
        , Text
"  a   - add selected songs to playlist"
        , Text
""
        , Text
"Library and Playlists keybindigns:"
        , Text
"  SPC - add song/song collection to queue"
        , Text
"  RET - add song/song collection to queue, and start playing the first one"
        , Text
""
        , Text
"Playlists keybindigns:"
        , Text
" on playlist conents:"
        , Text
"  e - make playlist editable, press again to get save prompt."
        , Text
"      editing a playlist is the same as editing the queue"
        , Text
" on list of playlists:"
        , Text
"  y and p - copy and paste playlists (with -copy added to the name)"
        , Text
"  d       - delete playlist (with prompt)"
        , Text
""
        , Text
"Commands:"
        , Text
":help       - gets you this"
        , Text
":q          - quits"
        , Text
":save $name - saves the queue to a playlist called $name"
        ]
  Int
_ -> [Text
"something went wrong."]


handleEventHelp
  :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState)
handleEventHelp :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState)
handleEventHelp HState
s BrickEvent Name HumEvent
e = case BrickEvent Name HumEvent
e of
  VtyEvent Event
vtye -> case Event
vtye of
    EvKey (KChar Char
'j') [] -> HState -> EventM Name (Next HState)
forall s n. s -> EventM n (Next s)
continue (HState -> EventM Name (Next HState))
-> HState -> EventM Name (Next HState)
forall a b. (a -> b) -> a -> b
$ HState
s HState -> (HState -> HState) -> HState
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> HState -> Identity HState
Lens' HState Int
helpScreenL ((Int -> Identity Int) -> HState -> Identity HState)
-> (Int -> Int) -> HState -> HState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\Int
x -> if Int
xInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1 then Int
0 else Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    EvKey (KChar Char
'k') [] -> HState -> EventM Name (Next HState)
forall s n. s -> EventM n (Next s)
continue (HState -> EventM Name (Next HState))
-> HState -> EventM Name (Next HState)
forall a b. (a -> b) -> a -> b
$ HState
s HState -> (HState -> HState) -> HState
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> HState -> Identity HState
Lens' HState Int
helpScreenL ((Int -> Identity Int) -> HState -> Identity HState)
-> (Int -> Int) -> HState -> HState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\Int
x -> if Int
xInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0 then Int
1 else Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    EvKey (KChar Char
'n') [] -> HState -> EventM Name (Next HState)
forall s n. s -> EventM n (Next s)
continue HState
s
    EvKey (KChar Char
'N') [] -> HState -> EventM Name (Next HState)
forall s n. s -> EventM n (Next s)
continue HState
s
    EvKey (KChar Char
'G') [] -> HState -> EventM Name (Next HState)
forall s n. s -> EventM n (Next s)
continue HState
s
    EvKey (KChar Char
'g') [] -> HState -> EventM Name (Next HState)
forall s n. s -> EventM n (Next s)
continue HState
s
    Event
_                    -> HState -> EventM Name (Next HState)
forall s n. s -> EventM n (Next s)
continue HState
s
  BrickEvent Name HumEvent
_ -> HState -> EventM Name (Next HState)
forall s n. s -> EventM n (Next s)
continue HState
s