-- |
-- Module: WildBind.FrontEnd
-- Description: Data types and type classes about front-ends.
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- Data types and type classes about front-ends.
-- 
-- You have to look at this module if you want to create a front-end
-- implementation.
module WildBind.FrontEnd
       ( FrontEvent(..),
         FrontEnd(..)
       ) where

import WildBind.Description (ActionDescription)

-- | Event from the front-end. @s@ is the state of the front-end. @i@ is the input.
data FrontEvent s i = FEInput i -- ^ An event that a new input is made.
                    | FEChange s  -- ^ An event that the front-end state is changed.
                    deriving (Int -> FrontEvent s i -> ShowS
[FrontEvent s i] -> ShowS
FrontEvent s i -> String
(Int -> FrontEvent s i -> ShowS)
-> (FrontEvent s i -> String)
-> ([FrontEvent s i] -> ShowS)
-> Show (FrontEvent s i)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s i. (Show i, Show s) => Int -> FrontEvent s i -> ShowS
forall s i. (Show i, Show s) => [FrontEvent s i] -> ShowS
forall s i. (Show i, Show s) => FrontEvent s i -> String
showList :: [FrontEvent s i] -> ShowS
$cshowList :: forall s i. (Show i, Show s) => [FrontEvent s i] -> ShowS
show :: FrontEvent s i -> String
$cshow :: forall s i. (Show i, Show s) => FrontEvent s i -> String
showsPrec :: Int -> FrontEvent s i -> ShowS
$cshowsPrec :: forall s i. (Show i, Show s) => Int -> FrontEvent s i -> ShowS
Show,FrontEvent s i -> FrontEvent s i -> Bool
(FrontEvent s i -> FrontEvent s i -> Bool)
-> (FrontEvent s i -> FrontEvent s i -> Bool)
-> Eq (FrontEvent s i)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall s i.
(Eq i, Eq s) =>
FrontEvent s i -> FrontEvent s i -> Bool
/= :: FrontEvent s i -> FrontEvent s i -> Bool
$c/= :: forall s i.
(Eq i, Eq s) =>
FrontEvent s i -> FrontEvent s i -> Bool
== :: FrontEvent s i -> FrontEvent s i -> Bool
$c== :: forall s i.
(Eq i, Eq s) =>
FrontEvent s i -> FrontEvent s i -> Bool
Eq,Eq (FrontEvent s i)
Eq (FrontEvent s i)
-> (FrontEvent s i -> FrontEvent s i -> Ordering)
-> (FrontEvent s i -> FrontEvent s i -> Bool)
-> (FrontEvent s i -> FrontEvent s i -> Bool)
-> (FrontEvent s i -> FrontEvent s i -> Bool)
-> (FrontEvent s i -> FrontEvent s i -> Bool)
-> (FrontEvent s i -> FrontEvent s i -> FrontEvent s i)
-> (FrontEvent s i -> FrontEvent s i -> FrontEvent s i)
-> Ord (FrontEvent s i)
FrontEvent s i -> FrontEvent s i -> Bool
FrontEvent s i -> FrontEvent s i -> Ordering
FrontEvent s i -> FrontEvent s i -> FrontEvent s i
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
forall s i. (Ord i, Ord s) => Eq (FrontEvent s i)
forall s i.
(Ord i, Ord s) =>
FrontEvent s i -> FrontEvent s i -> Bool
forall s i.
(Ord i, Ord s) =>
FrontEvent s i -> FrontEvent s i -> Ordering
forall s i.
(Ord i, Ord s) =>
FrontEvent s i -> FrontEvent s i -> FrontEvent s i
min :: FrontEvent s i -> FrontEvent s i -> FrontEvent s i
$cmin :: forall s i.
(Ord i, Ord s) =>
FrontEvent s i -> FrontEvent s i -> FrontEvent s i
max :: FrontEvent s i -> FrontEvent s i -> FrontEvent s i
$cmax :: forall s i.
(Ord i, Ord s) =>
FrontEvent s i -> FrontEvent s i -> FrontEvent s i
>= :: FrontEvent s i -> FrontEvent s i -> Bool
$c>= :: forall s i.
(Ord i, Ord s) =>
FrontEvent s i -> FrontEvent s i -> Bool
> :: FrontEvent s i -> FrontEvent s i -> Bool
$c> :: forall s i.
(Ord i, Ord s) =>
FrontEvent s i -> FrontEvent s i -> Bool
<= :: FrontEvent s i -> FrontEvent s i -> Bool
$c<= :: forall s i.
(Ord i, Ord s) =>
FrontEvent s i -> FrontEvent s i -> Bool
< :: FrontEvent s i -> FrontEvent s i -> Bool
$c< :: forall s i.
(Ord i, Ord s) =>
FrontEvent s i -> FrontEvent s i -> Bool
compare :: FrontEvent s i -> FrontEvent s i -> Ordering
$ccompare :: forall s i.
(Ord i, Ord s) =>
FrontEvent s i -> FrontEvent s i -> Ordering
$cp1Ord :: forall s i. (Ord i, Ord s) => Eq (FrontEvent s i)
Ord)

-- | Interface to the front-end. @s@ is the state of the front-end,
-- @i@ is the input.
data FrontEnd s i =
  FrontEnd
  { FrontEnd s i -> i -> ActionDescription
frontDefaultDescription :: i -> ActionDescription,
    -- ^ Default 'ActionDescription' for inputs
    FrontEnd s i -> i -> IO ()
frontSetGrab :: i -> IO (),
    -- ^ Action to grab (or capture) the specified input symbol on the device. 
    FrontEnd s i -> i -> IO ()
frontUnsetGrab :: i -> IO (),
    -- ^ Action to release the grab for the input symbol.
    FrontEnd s i -> IO (FrontEvent s i)
frontNextEvent :: IO (FrontEvent s i)
    -- ^ Action to retrieve the next event. It should block if no event is queued.
  }