module Taskell.Events.Actions.Types where

import ClassyPrelude hiding (Left, Nothing, Right)

data ActionType
    = Quit
    | Undo
    | Redo
    | Search
    | Due
    | Help
    | Previous
    | Next
    | Left
    | Right
    | Bottom
    | Top
    | New
    | NewAbove
    | NewBelow
    | Duplicate
    | Edit
    | Clear
    | Delete
    | Detail
    | DueDate
    | ClearDate
    | MoveUp
    | MoveDown
    | MoveLeftTop
    | MoveRightTop
    | MoveLeftBottom
    | MoveRightBottom
    | Complete
    | MoveMenu
    | ListNew
    | ListEdit
    | ListDelete
    | ListRight
    | ListLeft
    | Nothing
    deriving (Int -> ActionType -> ShowS
[ActionType] -> ShowS
ActionType -> String
(Int -> ActionType -> ShowS)
-> (ActionType -> String)
-> ([ActionType] -> ShowS)
-> Show ActionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActionType] -> ShowS
$cshowList :: [ActionType] -> ShowS
show :: ActionType -> String
$cshow :: ActionType -> String
showsPrec :: Int -> ActionType -> ShowS
$cshowsPrec :: Int -> ActionType -> ShowS
Show, ActionType -> ActionType -> Bool
(ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool) -> Eq ActionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionType -> ActionType -> Bool
$c/= :: ActionType -> ActionType -> Bool
== :: ActionType -> ActionType -> Bool
$c== :: ActionType -> ActionType -> Bool
Eq, Eq ActionType
Eq ActionType
-> (ActionType -> ActionType -> Ordering)
-> (ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> ActionType)
-> (ActionType -> ActionType -> ActionType)
-> Ord ActionType
ActionType -> ActionType -> Bool
ActionType -> ActionType -> Ordering
ActionType -> ActionType -> ActionType
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 :: ActionType -> ActionType -> ActionType
$cmin :: ActionType -> ActionType -> ActionType
max :: ActionType -> ActionType -> ActionType
$cmax :: ActionType -> ActionType -> ActionType
>= :: ActionType -> ActionType -> Bool
$c>= :: ActionType -> ActionType -> Bool
> :: ActionType -> ActionType -> Bool
$c> :: ActionType -> ActionType -> Bool
<= :: ActionType -> ActionType -> Bool
$c<= :: ActionType -> ActionType -> Bool
< :: ActionType -> ActionType -> Bool
$c< :: ActionType -> ActionType -> Bool
compare :: ActionType -> ActionType -> Ordering
$ccompare :: ActionType -> ActionType -> Ordering
$cp1Ord :: Eq ActionType
Ord, Int -> ActionType
ActionType -> Int
ActionType -> [ActionType]
ActionType -> ActionType
ActionType -> ActionType -> [ActionType]
ActionType -> ActionType -> ActionType -> [ActionType]
(ActionType -> ActionType)
-> (ActionType -> ActionType)
-> (Int -> ActionType)
-> (ActionType -> Int)
-> (ActionType -> [ActionType])
-> (ActionType -> ActionType -> [ActionType])
-> (ActionType -> ActionType -> [ActionType])
-> (ActionType -> ActionType -> ActionType -> [ActionType])
-> Enum ActionType
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 :: ActionType -> ActionType -> ActionType -> [ActionType]
$cenumFromThenTo :: ActionType -> ActionType -> ActionType -> [ActionType]
enumFromTo :: ActionType -> ActionType -> [ActionType]
$cenumFromTo :: ActionType -> ActionType -> [ActionType]
enumFromThen :: ActionType -> ActionType -> [ActionType]
$cenumFromThen :: ActionType -> ActionType -> [ActionType]
enumFrom :: ActionType -> [ActionType]
$cenumFrom :: ActionType -> [ActionType]
fromEnum :: ActionType -> Int
$cfromEnum :: ActionType -> Int
toEnum :: Int -> ActionType
$ctoEnum :: Int -> ActionType
pred :: ActionType -> ActionType
$cpred :: ActionType -> ActionType
succ :: ActionType -> ActionType
$csucc :: ActionType -> ActionType
Enum)

allActions :: [ActionType]
allActions :: [ActionType]
allActions = [Int -> ActionType
forall a. Enum a => Int -> a
toEnum Int
0 ..]

read :: Text -> ActionType
read :: Text -> ActionType
read Text
"quit"            = ActionType
Quit
read Text
"undo"            = ActionType
Undo
read Text
"redo"            = ActionType
Redo
read Text
"search"          = ActionType
Search
read Text
"due"             = ActionType
Due
read Text
"help"            = ActionType
Help
read Text
"previous"        = ActionType
Previous
read Text
"next"            = ActionType
Next
read Text
"left"            = ActionType
Left
read Text
"right"           = ActionType
Right
read Text
"bottom"          = ActionType
Bottom
read Text
"top"             = ActionType
Top
read Text
"new"             = ActionType
New
read Text
"newAbove"        = ActionType
NewAbove
read Text
"newBelow"        = ActionType
NewBelow
read Text
"duplicate"       = ActionType
Duplicate
read Text
"edit"            = ActionType
Edit
read Text
"clear"           = ActionType
Clear
read Text
"delete"          = ActionType
Delete
read Text
"detail"          = ActionType
Detail
read Text
"dueDate"         = ActionType
DueDate
read Text
"clearDate"       = ActionType
ClearDate
read Text
"moveUp"          = ActionType
MoveUp
read Text
"moveDown"        = ActionType
MoveDown
read Text
"moveLeftTop"     = ActionType
MoveLeftTop
read Text
"moveRightTop"    = ActionType
MoveRightTop
read Text
"moveLeft"        = ActionType
MoveLeftBottom
read Text
"moveRight"       = ActionType
MoveRightBottom
read Text
"moveLeftBottom"  = ActionType
MoveLeftBottom
read Text
"moveRightBottom" = ActionType
MoveRightBottom
read Text
"complete"        = ActionType
Complete
read Text
"moveMenu"        = ActionType
MoveMenu
read Text
"listNew"         = ActionType
ListNew
read Text
"listEdit"        = ActionType
ListEdit
read Text
"listDelete"      = ActionType
ListDelete
read Text
"listRight"       = ActionType
ListRight
read Text
"listLeft"        = ActionType
ListLeft
read Text
_                 = ActionType
Nothing