-- | Module    : Hum.Types
-- Copyright   : (c) Itai Y. Efrat 2020-2021
-- License     : GPLv2-or-later (see LICENSE)
-- Maintainer  : Itai Y. Efrat <itai3397@gmail.com>
--
-- Types!

module Hum.Types where
import           Network.MPD
import           Brick.BChan
import           Brick.Types
import           Brick.Widgets.Edit
import           Brick.Widgets.List
import           Hum.Orphans ( )

-- | Describes the state of the app.
data HumState = HumState
    { HumState -> BChan HumEvent
chan        :: !(BChan HumEvent) -- ^ The channel for MPD and time events
    , HumState -> View
hview       :: !View -- ^ The current view: Queue, Library, etc.
    , HumState -> Maybe Status
status      :: !(Maybe Status) -- ^ MPD's status
    , HumState -> Mode
mode        :: !Mode -- ^ Input mode
    , HumState -> ExState
ex          :: !ExState -- ^ The state of the ex mode style prompt at the bottom
    , HumState -> Maybe Song
currentSong :: !(Maybe Song)
    , HumState -> SongList
queue       :: !SongList -- ^ Also called the playlist in MPD
    , HumState -> LibraryState
library     :: !LibraryState
    , HumState -> PlaylistsState
playlists   :: !PlaylistsState
    , HumState -> Clipboard
clipboard   :: !Clipboard
    , HumState -> Focus
focus       :: !Focus -- ^ The current focus in each view
    , HumState -> Bool
editable    :: !Bool -- ^ Whether the selected stored playlist is editable
    , HumState -> Prompts
prompts     :: !Prompts
    , HumState -> HelpState
help        :: !HelpState -- ^ Help View
    }


data LibraryState = LibraryState
    { LibraryState -> List Name Value
artists     :: !(List Name Value) -- ^ All album artists
    , LibraryState -> List Name (Value, Value)
yalbums     :: !(List Name (Value,Value)) -- ^ Year-Album pairs of the selected artist
    , LibraryState -> Bool
yalbumSort  :: !Bool -- ^ Toggle sort of yalbums between years and alphabeitcal order
    , LibraryState -> List Name Song
songs       :: !(List Name Song) -- ^ Songs in selected album
    }

-- | Stored playlists
data PlaylistsState = PlaylistsState
    { PlaylistsState -> List Name PlaylistName
plList  :: !(List Name PlaylistName) -- ^ List of stored playlists
    , PlaylistsState -> SongList
plSongs :: !SongList -- ^ Songs in selected playlist
    }
data HelpState = HelpState
    { HelpState -> Text
helpText      :: !Text -- ^ Contents of help screen
    , HelpState -> Int
helpSearchInt :: !Int -- ^ number of focused search match
    }
-- | Specific mode in the bottom prompt
data ExSubMode =
    Cmd -- ^ Function commands
  | FSearch -- ^ Forward search
  | BSearch -- ^ Backwards search
    deriving (Int -> ExSubMode -> ShowS
[ExSubMode] -> ShowS
ExSubMode -> String
(Int -> ExSubMode -> ShowS)
-> (ExSubMode -> String)
-> ([ExSubMode] -> ShowS)
-> Show ExSubMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExSubMode] -> ShowS
$cshowList :: [ExSubMode] -> ShowS
show :: ExSubMode -> String
$cshow :: ExSubMode -> String
showsPrec :: Int -> ExSubMode -> ShowS
$cshowsPrec :: Int -> ExSubMode -> ShowS
Show, ExSubMode -> ExSubMode -> Bool
(ExSubMode -> ExSubMode -> Bool)
-> (ExSubMode -> ExSubMode -> Bool) -> Eq ExSubMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExSubMode -> ExSubMode -> Bool
$c/= :: ExSubMode -> ExSubMode -> Bool
== :: ExSubMode -> ExSubMode -> Bool
$c== :: ExSubMode -> ExSubMode -> Bool
Eq, Eq ExSubMode
Eq ExSubMode
-> (ExSubMode -> ExSubMode -> Ordering)
-> (ExSubMode -> ExSubMode -> Bool)
-> (ExSubMode -> ExSubMode -> Bool)
-> (ExSubMode -> ExSubMode -> Bool)
-> (ExSubMode -> ExSubMode -> Bool)
-> (ExSubMode -> ExSubMode -> ExSubMode)
-> (ExSubMode -> ExSubMode -> ExSubMode)
-> Ord ExSubMode
ExSubMode -> ExSubMode -> Bool
ExSubMode -> ExSubMode -> Ordering
ExSubMode -> ExSubMode -> ExSubMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExSubMode -> ExSubMode -> ExSubMode
$cmin :: ExSubMode -> ExSubMode -> ExSubMode
max :: ExSubMode -> ExSubMode -> ExSubMode
$cmax :: ExSubMode -> ExSubMode -> ExSubMode
>= :: ExSubMode -> ExSubMode -> Bool
$c>= :: ExSubMode -> ExSubMode -> Bool
> :: ExSubMode -> ExSubMode -> Bool
$c> :: ExSubMode -> ExSubMode -> Bool
<= :: ExSubMode -> ExSubMode -> Bool
$c<= :: ExSubMode -> ExSubMode -> Bool
< :: ExSubMode -> ExSubMode -> Bool
$c< :: ExSubMode -> ExSubMode -> Bool
compare :: ExSubMode -> ExSubMode -> Ordering
$ccompare :: ExSubMode -> ExSubMode -> Ordering
$cp1Ord :: Eq ExSubMode
Ord)

data ExState = ExState
    { ExState -> ExSubMode
exPrefix        :: !ExSubMode
    , ExState -> Editor Text Name
exEditor        :: !(Editor Text Name)
    , ExState -> Bool
searchDirection :: !Bool -- ^ Search direction of last search
    , ExState -> [Text]
searchHistory   :: ![Text]
    , ExState -> [Text]
cmdHistory      :: ![Text]
    }

data Prompts = Prompts
    { Prompts -> PromptType
currentPrompt      :: !PromptType
    , Prompts -> Text
promptTitle        :: Text
    , Prompts -> List Name (Maybe PlaylistName)
plSelectPrompt     :: !(List Name (Maybe PlaylistName)) -- ^ List to select playlist from
    , Prompts -> Editor Text Name
textPrompt         :: !(Editor Text Name) -- ^ Editor if needed
    , Prompts -> Bool -> HumState -> EventM Name HumState
exitPromptFunc     :: Bool -> HumState -> EventM Name HumState -- ^ Executes on exit from prompt, True for execute and False for quit.
    }

data PromptType =
    PlSelectPrompt -- ^ Select playlist to add songs to
  | YNPrompt -- ^ General yes/no prompt
  | TextPrompt -- ^ General enter text and do stuff prompt
  deriving (Int -> PromptType -> ShowS
[PromptType] -> ShowS
PromptType -> String
(Int -> PromptType -> ShowS)
-> (PromptType -> String)
-> ([PromptType] -> ShowS)
-> Show PromptType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PromptType] -> ShowS
$cshowList :: [PromptType] -> ShowS
show :: PromptType -> String
$cshow :: PromptType -> String
showsPrec :: Int -> PromptType -> ShowS
$cshowsPrec :: Int -> PromptType -> ShowS
Show,PromptType -> PromptType -> Bool
(PromptType -> PromptType -> Bool)
-> (PromptType -> PromptType -> Bool) -> Eq PromptType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PromptType -> PromptType -> Bool
$c/= :: PromptType -> PromptType -> Bool
== :: PromptType -> PromptType -> Bool
$c== :: PromptType -> PromptType -> Bool
Eq)

data Clipboard = Clipboard { Clipboard -> SongList
clSongs  :: !SongList -- ^ Last list of songs copied
                           , Clipboard -> Maybe PlaylistName
clPlName :: !(Maybe PlaylistName) -- ^ Last playlist name copied
                           }
-- | General input mode
data Mode =
    NormalMode -- ^ Vim normal mode style movement
  | ExMode -- ^ Type ex style commands or search
  | PromptMode -- ^ Interact with a prompt
  deriving (Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show,Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq)

type Highlight = Bool

type SongList = List Name (Song, Highlight)

type HumEvent = Either Tick (Response [Subsystem])

-- | Brick widget names
data Name =
    NowPlaying | ClSongs
  | Queue | QueueList
  | Library | ArtistsList | LibraryLeft | AlbumsList | YalbumsList | LibraryMid | SongsList | LibraryRight
  | PlaylistList | PlaylistLeft | PlaylistSongs | PlaylistRight
  | Help
  | ExEditor
  | TextPromptEditor
 deriving (Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show, Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Eq Name
Eq Name
-> (Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c< :: Name -> Name -> Bool
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
$cp1Ord :: Eq Name
Ord)

data Focus = Focus
    { Focus -> FocQueue
focQueue :: FocQueue
    , Focus -> FocLib
focLib   :: FocLib
    , Focus -> FocPlay
focPlay  :: FocPlay
    , Focus -> Bool
focEx    :: Bool
    }
    deriving (Int -> Focus -> ShowS
[Focus] -> ShowS
Focus -> String
(Int -> Focus -> ShowS)
-> (Focus -> String) -> ([Focus] -> ShowS) -> Show Focus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Focus] -> ShowS
$cshowList :: [Focus] -> ShowS
show :: Focus -> String
$cshow :: Focus -> String
showsPrec :: Int -> Focus -> ShowS
$cshowsPrec :: Int -> Focus -> ShowS
Show, Focus -> Focus -> Bool
(Focus -> Focus -> Bool) -> (Focus -> Focus -> Bool) -> Eq Focus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Focus -> Focus -> Bool
$c/= :: Focus -> Focus -> Bool
== :: Focus -> Focus -> Bool
$c== :: Focus -> Focus -> Bool
Eq, Eq Focus
Eq Focus
-> (Focus -> Focus -> Ordering)
-> (Focus -> Focus -> Bool)
-> (Focus -> Focus -> Bool)
-> (Focus -> Focus -> Bool)
-> (Focus -> Focus -> Bool)
-> (Focus -> Focus -> Focus)
-> (Focus -> Focus -> Focus)
-> Ord Focus
Focus -> Focus -> Bool
Focus -> Focus -> Ordering
Focus -> Focus -> Focus
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Focus -> Focus -> Focus
$cmin :: Focus -> Focus -> Focus
max :: Focus -> Focus -> Focus
$cmax :: Focus -> Focus -> Focus
>= :: Focus -> Focus -> Bool
$c>= :: Focus -> Focus -> Bool
> :: Focus -> Focus -> Bool
$c> :: Focus -> Focus -> Bool
<= :: Focus -> Focus -> Bool
$c<= :: Focus -> Focus -> Bool
< :: Focus -> Focus -> Bool
$c< :: Focus -> Focus -> Bool
compare :: Focus -> Focus -> Ordering
$ccompare :: Focus -> Focus -> Ordering
$cp1Ord :: Eq Focus
Ord)

data FocQueue = FocQueue
    deriving (Int -> FocQueue -> ShowS
[FocQueue] -> ShowS
FocQueue -> String
(Int -> FocQueue -> ShowS)
-> (FocQueue -> String) -> ([FocQueue] -> ShowS) -> Show FocQueue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FocQueue] -> ShowS
$cshowList :: [FocQueue] -> ShowS
show :: FocQueue -> String
$cshow :: FocQueue -> String
showsPrec :: Int -> FocQueue -> ShowS
$cshowsPrec :: Int -> FocQueue -> ShowS
Show, FocQueue -> FocQueue -> Bool
(FocQueue -> FocQueue -> Bool)
-> (FocQueue -> FocQueue -> Bool) -> Eq FocQueue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FocQueue -> FocQueue -> Bool
$c/= :: FocQueue -> FocQueue -> Bool
== :: FocQueue -> FocQueue -> Bool
$c== :: FocQueue -> FocQueue -> Bool
Eq, Eq FocQueue
Eq FocQueue
-> (FocQueue -> FocQueue -> Ordering)
-> (FocQueue -> FocQueue -> Bool)
-> (FocQueue -> FocQueue -> Bool)
-> (FocQueue -> FocQueue -> Bool)
-> (FocQueue -> FocQueue -> Bool)
-> (FocQueue -> FocQueue -> FocQueue)
-> (FocQueue -> FocQueue -> FocQueue)
-> Ord FocQueue
FocQueue -> FocQueue -> Bool
FocQueue -> FocQueue -> Ordering
FocQueue -> FocQueue -> FocQueue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FocQueue -> FocQueue -> FocQueue
$cmin :: FocQueue -> FocQueue -> FocQueue
max :: FocQueue -> FocQueue -> FocQueue
$cmax :: FocQueue -> FocQueue -> FocQueue
>= :: FocQueue -> FocQueue -> Bool
$c>= :: FocQueue -> FocQueue -> Bool
> :: FocQueue -> FocQueue -> Bool
$c> :: FocQueue -> FocQueue -> Bool
<= :: FocQueue -> FocQueue -> Bool
$c<= :: FocQueue -> FocQueue -> Bool
< :: FocQueue -> FocQueue -> Bool
$c< :: FocQueue -> FocQueue -> Bool
compare :: FocQueue -> FocQueue -> Ordering
$ccompare :: FocQueue -> FocQueue -> Ordering
$cp1Ord :: Eq FocQueue
Ord)

data FocLib = FocArtists | FocAlbums | FocSongs
  deriving(Int -> FocLib -> ShowS
[FocLib] -> ShowS
FocLib -> String
(Int -> FocLib -> ShowS)
-> (FocLib -> String) -> ([FocLib] -> ShowS) -> Show FocLib
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FocLib] -> ShowS
$cshowList :: [FocLib] -> ShowS
show :: FocLib -> String
$cshow :: FocLib -> String
showsPrec :: Int -> FocLib -> ShowS
$cshowsPrec :: Int -> FocLib -> ShowS
Show,FocLib -> FocLib -> Bool
(FocLib -> FocLib -> Bool)
-> (FocLib -> FocLib -> Bool) -> Eq FocLib
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FocLib -> FocLib -> Bool
$c/= :: FocLib -> FocLib -> Bool
== :: FocLib -> FocLib -> Bool
$c== :: FocLib -> FocLib -> Bool
Eq,Eq FocLib
Eq FocLib
-> (FocLib -> FocLib -> Ordering)
-> (FocLib -> FocLib -> Bool)
-> (FocLib -> FocLib -> Bool)
-> (FocLib -> FocLib -> Bool)
-> (FocLib -> FocLib -> Bool)
-> (FocLib -> FocLib -> FocLib)
-> (FocLib -> FocLib -> FocLib)
-> Ord FocLib
FocLib -> FocLib -> Bool
FocLib -> FocLib -> Ordering
FocLib -> FocLib -> FocLib
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FocLib -> FocLib -> FocLib
$cmin :: FocLib -> FocLib -> FocLib
max :: FocLib -> FocLib -> FocLib
$cmax :: FocLib -> FocLib -> FocLib
>= :: FocLib -> FocLib -> Bool
$c>= :: FocLib -> FocLib -> Bool
> :: FocLib -> FocLib -> Bool
$c> :: FocLib -> FocLib -> Bool
<= :: FocLib -> FocLib -> Bool
$c<= :: FocLib -> FocLib -> Bool
< :: FocLib -> FocLib -> Bool
$c< :: FocLib -> FocLib -> Bool
compare :: FocLib -> FocLib -> Ordering
$ccompare :: FocLib -> FocLib -> Ordering
$cp1Ord :: Eq FocLib
Ord,Int -> FocLib
FocLib -> Int
FocLib -> [FocLib]
FocLib -> FocLib
FocLib -> FocLib -> [FocLib]
FocLib -> FocLib -> FocLib -> [FocLib]
(FocLib -> FocLib)
-> (FocLib -> FocLib)
-> (Int -> FocLib)
-> (FocLib -> Int)
-> (FocLib -> [FocLib])
-> (FocLib -> FocLib -> [FocLib])
-> (FocLib -> FocLib -> [FocLib])
-> (FocLib -> FocLib -> FocLib -> [FocLib])
-> Enum FocLib
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FocLib -> FocLib -> FocLib -> [FocLib]
$cenumFromThenTo :: FocLib -> FocLib -> FocLib -> [FocLib]
enumFromTo :: FocLib -> FocLib -> [FocLib]
$cenumFromTo :: FocLib -> FocLib -> [FocLib]
enumFromThen :: FocLib -> FocLib -> [FocLib]
$cenumFromThen :: FocLib -> FocLib -> [FocLib]
enumFrom :: FocLib -> [FocLib]
$cenumFrom :: FocLib -> [FocLib]
fromEnum :: FocLib -> Int
$cfromEnum :: FocLib -> Int
toEnum :: Int -> FocLib
$ctoEnum :: Int -> FocLib
pred :: FocLib -> FocLib
$cpred :: FocLib -> FocLib
succ :: FocLib -> FocLib
$csucc :: FocLib -> FocLib
Enum)

data FocPlay = FocPlaylists | FocPSongs
  deriving(Int -> FocPlay -> ShowS
[FocPlay] -> ShowS
FocPlay -> String
(Int -> FocPlay -> ShowS)
-> (FocPlay -> String) -> ([FocPlay] -> ShowS) -> Show FocPlay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FocPlay] -> ShowS
$cshowList :: [FocPlay] -> ShowS
show :: FocPlay -> String
$cshow :: FocPlay -> String
showsPrec :: Int -> FocPlay -> ShowS
$cshowsPrec :: Int -> FocPlay -> ShowS
Show,FocPlay -> FocPlay -> Bool
(FocPlay -> FocPlay -> Bool)
-> (FocPlay -> FocPlay -> Bool) -> Eq FocPlay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FocPlay -> FocPlay -> Bool
$c/= :: FocPlay -> FocPlay -> Bool
== :: FocPlay -> FocPlay -> Bool
$c== :: FocPlay -> FocPlay -> Bool
Eq,Eq FocPlay
Eq FocPlay
-> (FocPlay -> FocPlay -> Ordering)
-> (FocPlay -> FocPlay -> Bool)
-> (FocPlay -> FocPlay -> Bool)
-> (FocPlay -> FocPlay -> Bool)
-> (FocPlay -> FocPlay -> Bool)
-> (FocPlay -> FocPlay -> FocPlay)
-> (FocPlay -> FocPlay -> FocPlay)
-> Ord FocPlay
FocPlay -> FocPlay -> Bool
FocPlay -> FocPlay -> Ordering
FocPlay -> FocPlay -> FocPlay
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FocPlay -> FocPlay -> FocPlay
$cmin :: FocPlay -> FocPlay -> FocPlay
max :: FocPlay -> FocPlay -> FocPlay
$cmax :: FocPlay -> FocPlay -> FocPlay
>= :: FocPlay -> FocPlay -> Bool
$c>= :: FocPlay -> FocPlay -> Bool
> :: FocPlay -> FocPlay -> Bool
$c> :: FocPlay -> FocPlay -> Bool
<= :: FocPlay -> FocPlay -> Bool
$c<= :: FocPlay -> FocPlay -> Bool
< :: FocPlay -> FocPlay -> Bool
$c< :: FocPlay -> FocPlay -> Bool
compare :: FocPlay -> FocPlay -> Ordering
$ccompare :: FocPlay -> FocPlay -> Ordering
$cp1Ord :: Eq FocPlay
Ord,Int -> FocPlay
FocPlay -> Int
FocPlay -> [FocPlay]
FocPlay -> FocPlay
FocPlay -> FocPlay -> [FocPlay]
FocPlay -> FocPlay -> FocPlay -> [FocPlay]
(FocPlay -> FocPlay)
-> (FocPlay -> FocPlay)
-> (Int -> FocPlay)
-> (FocPlay -> Int)
-> (FocPlay -> [FocPlay])
-> (FocPlay -> FocPlay -> [FocPlay])
-> (FocPlay -> FocPlay -> [FocPlay])
-> (FocPlay -> FocPlay -> FocPlay -> [FocPlay])
-> Enum FocPlay
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FocPlay -> FocPlay -> FocPlay -> [FocPlay]
$cenumFromThenTo :: FocPlay -> FocPlay -> FocPlay -> [FocPlay]
enumFromTo :: FocPlay -> FocPlay -> [FocPlay]
$cenumFromTo :: FocPlay -> FocPlay -> [FocPlay]
enumFromThen :: FocPlay -> FocPlay -> [FocPlay]
$cenumFromThen :: FocPlay -> FocPlay -> [FocPlay]
enumFrom :: FocPlay -> [FocPlay]
$cenumFrom :: FocPlay -> [FocPlay]
fromEnum :: FocPlay -> Int
$cfromEnum :: FocPlay -> Int
toEnum :: Int -> FocPlay
$ctoEnum :: Int -> FocPlay
pred :: FocPlay -> FocPlay
$cpred :: FocPlay -> FocPlay
succ :: FocPlay -> FocPlay
$csucc :: FocPlay -> FocPlay
Enum)

data View = QueueView | LibraryView | PlaylistsView | HelpView
 deriving (Int -> View -> ShowS
[View] -> ShowS
View -> String
(Int -> View -> ShowS)
-> (View -> String) -> ([View] -> ShowS) -> Show View
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [View] -> ShowS
$cshowList :: [View] -> ShowS
show :: View -> String
$cshow :: View -> String
showsPrec :: Int -> View -> ShowS
$cshowsPrec :: Int -> View -> ShowS
Show,View -> View -> Bool
(View -> View -> Bool) -> (View -> View -> Bool) -> Eq View
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: View -> View -> Bool
$c/= :: View -> View -> Bool
== :: View -> View -> Bool
$c== :: View -> View -> Bool
Eq,Eq View
Eq View
-> (View -> View -> Ordering)
-> (View -> View -> Bool)
-> (View -> View -> Bool)
-> (View -> View -> Bool)
-> (View -> View -> Bool)
-> (View -> View -> View)
-> (View -> View -> View)
-> Ord View
View -> View -> Bool
View -> View -> Ordering
View -> View -> View
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: View -> View -> View
$cmin :: View -> View -> View
max :: View -> View -> View
$cmax :: View -> View -> View
>= :: View -> View -> Bool
$c>= :: View -> View -> Bool
> :: View -> View -> Bool
$c> :: View -> View -> Bool
<= :: View -> View -> Bool
$c<= :: View -> View -> Bool
< :: View -> View -> Bool
$c< :: View -> View -> Bool
compare :: View -> View -> Ordering
$ccompare :: View -> View -> Ordering
$cp1Ord :: Eq View
Ord)

data Tick = Tick

suffixLenses ''HumState
suffixLenses ''Focus
suffixLenses ''LibraryState
suffixLenses ''PlaylistsState
suffixLenses ''HelpState
suffixLenses ''ExState
suffixLenses ''Prompts
suffixLenses ''Clipboard