{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Graphics.Blank.Types.Cursor where
import Data.String (IsString(..))
import qualified Data.Text as TS (Text)
import Data.Text (pack)
import Graphics.Blank.JavaScript
import Graphics.Blank.Parser (stringCI, unlift)
import Prelude.Compat
import Text.ParserCombinators.ReadP (ReadP, (<++), between, char,
choice, munch, skipSpaces)
import Text.ParserCombinators.ReadPrec (lift)
import Text.Read (Read(..), readListPrecDefault)
import TextShow
class CanvasCursor a where
jsCanvasCursor :: a -> Builder
instance CanvasCursor TS.Text where
jsCanvasCursor :: Text -> Builder
jsCanvasCursor = Text -> Builder
jsText
instance CanvasCursor Cursor where
jsCanvasCursor :: Cursor -> Builder
jsCanvasCursor = Cursor -> Builder
jsCursor
data Cursor = Auto
| Default
| None
|
| Help
| Pointer
| Progress
| Wait
| Cell
| Crosshair
| Text
| VerticalText
| Alias
| Copy
| Move
| NoDrop
| NotAllowed
| AllScroll
| ColResize
| RowResize
| NResize
| EResize
| SResize
| WResize
| NEResize
| NWResize
| SEResize
| SWResize
| EWResize
| NSResize
| NESWResize
| NWSEResize
| ZoomIn
| ZoomOut
| Grab
| Grabbing
| URL TS.Text Cursor
deriving (Cursor -> Cursor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cursor -> Cursor -> Bool
$c/= :: Cursor -> Cursor -> Bool
== :: Cursor -> Cursor -> Bool
$c== :: Cursor -> Cursor -> Bool
Eq, Eq Cursor
Cursor -> Cursor -> Bool
Cursor -> Cursor -> Ordering
Cursor -> Cursor -> Cursor
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 :: Cursor -> Cursor -> Cursor
$cmin :: Cursor -> Cursor -> Cursor
max :: Cursor -> Cursor -> Cursor
$cmax :: Cursor -> Cursor -> Cursor
>= :: Cursor -> Cursor -> Bool
$c>= :: Cursor -> Cursor -> Bool
> :: Cursor -> Cursor -> Bool
$c> :: Cursor -> Cursor -> Bool
<= :: Cursor -> Cursor -> Bool
$c<= :: Cursor -> Cursor -> Bool
< :: Cursor -> Cursor -> Bool
$c< :: Cursor -> Cursor -> Bool
compare :: Cursor -> Cursor -> Ordering
$ccompare :: Cursor -> Cursor -> Ordering
Ord)
instance IsString Cursor where
fromString :: String -> Cursor
fromString = forall a. Read a => String -> a
read
instance JSArg Cursor where
showbJS :: Cursor -> Builder
showbJS = Cursor -> Builder
jsCursor
jsCursor :: Cursor -> Builder
jsCursor :: Cursor -> Builder
jsCursor = Builder -> Builder
jsLiteralBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TextShow a => a -> Builder
showb
instance Read Cursor where
readPrec :: ReadPrec Cursor
readPrec = forall a. ReadP a -> ReadPrec a
lift forall a b. (a -> b) -> a -> b
$ do
ReadP ()
skipSpaces
forall a. [ReadP a] -> ReadP a
choice
[ Cursor
Auto forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"auto"
, Cursor
Default forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"default"
, Cursor
None forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"none"
, Cursor
ContextMenu forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"context-menu"
, Cursor
Help forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"help"
, Cursor
Pointer forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"pointer"
, Cursor
Progress forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"progress"
, Cursor
Wait forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"wait"
, Cursor
Cell forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"cell"
, Cursor
Crosshair forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"crosshair"
, Cursor
Text forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"text"
, Cursor
VerticalText forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"vertical-text"
, Cursor
Alias forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"alias"
, Cursor
Copy forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"copy"
, Cursor
Move forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"move"
, Cursor
NoDrop forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"no-drop"
, Cursor
NotAllowed forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"not-allowed"
, Cursor
AllScroll forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"all-scroll"
, Cursor
ColResize forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"col-resize"
, Cursor
RowResize forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"row-resize"
, Cursor
NResize forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"n-resize"
, Cursor
EResize forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"e-resize"
, Cursor
SResize forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"s-resize"
, Cursor
WResize forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"w-resize"
, Cursor
NEResize forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"ne-resize"
, Cursor
NWResize forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"nw-resize"
, Cursor
SEResize forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"se-resize"
, Cursor
SWResize forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"sw-resize"
, Cursor
EWResize forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"ew-resize"
, Cursor
NSResize forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"ns-resize"
, Cursor
NESWResize forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"nesw-resize"
, Cursor
NWSEResize forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"nwse-resize"
, Cursor
ZoomIn forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"zoom-in"
, Cursor
ZoomOut forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"zoom-out"
, Cursor
Grab forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"grab"
, Cursor
Grabbing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"grabbing"
, do String
_ <- String -> ReadP String
stringCI String
"url("
let quoted :: Char -> ReadP a -> ReadP a
quoted Char
quote = forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
between (Char -> ReadP Char
char Char
quote) (Char -> ReadP Char
char Char
quote)
Text
url' <- forall {a}. Char -> ReadP a -> ReadP a
quoted Char
'"' (Maybe Char -> ReadP Text
readURL forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Char
'"')
forall a. ReadP a -> ReadP a -> ReadP a
<++ forall {a}. Char -> ReadP a -> ReadP a
quoted Char
'\'' (Maybe Char -> ReadP Text
readURL forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Char
'\'')
forall a. ReadP a -> ReadP a -> ReadP a
<++ Maybe Char -> ReadP Text
readURL forall a. Maybe a
Nothing
Char
_ <- Char -> ReadP Char
char Char
')'
ReadP ()
skipSpaces
Char
_ <- Char -> ReadP Char
char Char
','
Text -> Cursor -> Cursor
URL Text
url' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadPrec a -> ReadP a
unlift forall a. Read a => ReadPrec a
readPrec
]
readListPrec :: ReadPrec [Cursor]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault
readURL :: Maybe Char -> ReadP TS.Text
readURL :: Maybe Char -> ReadP Text
readURL Maybe Char
mQuote = do
String
url' <- case Maybe Char
mQuote of
Just Char
quote -> (Char -> Bool) -> ReadP String
munch (forall a. Eq a => a -> a -> Bool
/= Char
quote)
Maybe Char
Nothing -> (Char -> Bool) -> ReadP String
munch (forall a. Eq a => a -> a -> Bool
/= Char
')')
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
url'
instance Show Cursor where
showsPrec :: Int -> Cursor -> ShowS
showsPrec Int
p = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> FromTextShow a
FromTextShow
instance TextShow Cursor where
showb :: Cursor -> Builder
showb Cursor
Auto = Builder
"auto"
showb Cursor
Default = Builder
"default"
showb Cursor
None = Builder
"none"
showb Cursor
ContextMenu = Builder
"context-menu"
showb Cursor
Help = Builder
"help"
showb Cursor
Pointer = Builder
"pointer"
showb Cursor
Progress = Builder
"progress"
showb Cursor
Wait = Builder
"wait"
showb Cursor
Cell = Builder
"cell"
showb Cursor
Crosshair = Builder
"crosshair"
showb Cursor
Text = Builder
"text"
showb Cursor
VerticalText = Builder
"vertical-text"
showb Cursor
Alias = Builder
"alias"
showb Cursor
Copy = Builder
"copy"
showb Cursor
Move = Builder
"move"
showb Cursor
NoDrop = Builder
"no-drop"
showb Cursor
NotAllowed = Builder
"not-allowed"
showb Cursor
AllScroll = Builder
"all-scroll"
showb Cursor
ColResize = Builder
"col-resize"
showb Cursor
RowResize = Builder
"row-resize"
showb Cursor
NResize = Builder
"n-resize"
showb Cursor
EResize = Builder
"e-resize"
showb Cursor
SResize = Builder
"s-resize"
showb Cursor
WResize = Builder
"w-resize"
showb Cursor
NEResize = Builder
"ne-resize"
showb Cursor
NWResize = Builder
"nw-resize"
showb Cursor
SEResize = Builder
"se-resize"
showb Cursor
SWResize = Builder
"sw-resize"
showb Cursor
EWResize = Builder
"ew-resize"
showb Cursor
NSResize = Builder
"ns-resize"
showb Cursor
NESWResize = Builder
"nesw-resize"
showb Cursor
NWSEResize = Builder
"nwse-resize"
showb Cursor
ZoomIn = Builder
"zoom-in"
showb Cursor
ZoomOut = Builder
"zoom-out"
showb Cursor
Grab = Builder
"grab"
showb Cursor
Grabbing = Builder
"grabbing"
showb (URL Text
url' Cursor
cur) =
Builder
"url(" forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
jsLiteralBuilder (Text -> Builder
fromText Text
url') forall a. Semigroup a => a -> a -> a
<> Builder
"), " forall a. Semigroup a => a -> a -> a
<> forall a. TextShow a => a -> Builder
showb Cursor
cur
auto :: Cursor
auto :: Cursor
auto = Cursor
Auto
default_ :: Cursor
default_ :: Cursor
default_ = Cursor
Default
none :: Cursor
none :: Cursor
none = Cursor
None
contextMenu :: Cursor
= Cursor
ContextMenu
help :: Cursor
help :: Cursor
help = Cursor
Help
pointer :: Cursor
pointer :: Cursor
pointer = Cursor
Pointer
progress :: Cursor
progress :: Cursor
progress = Cursor
Progress
wait :: Cursor
wait :: Cursor
wait = Cursor
Wait
cell :: Cursor
cell :: Cursor
cell = Cursor
Cell
crosshair :: Cursor
crosshair :: Cursor
crosshair = Cursor
Crosshair
text :: Cursor
text :: Cursor
text = Cursor
Text
verticalText :: Cursor
verticalText :: Cursor
verticalText = Cursor
VerticalText
alias :: Cursor
alias :: Cursor
alias = Cursor
Alias
copy :: Cursor
copy :: Cursor
copy = Cursor
Copy
move :: Cursor
move :: Cursor
move = Cursor
Move
noDrop :: Cursor
noDrop :: Cursor
noDrop = Cursor
NoDrop
notAllowed :: Cursor
notAllowed :: Cursor
notAllowed = Cursor
NotAllowed
allScroll :: Cursor
allScroll :: Cursor
allScroll = Cursor
AllScroll
colResize :: Cursor
colResize :: Cursor
colResize = Cursor
ColResize
rowResize :: Cursor
rowResize :: Cursor
rowResize = Cursor
RowResize
nResize :: Cursor
nResize :: Cursor
nResize = Cursor
NResize
eResize :: Cursor
eResize :: Cursor
eResize = Cursor
EResize
sResize :: Cursor
sResize :: Cursor
sResize = Cursor
SResize
wResize :: Cursor
wResize :: Cursor
wResize = Cursor
WResize
neResize :: Cursor
neResize :: Cursor
neResize = Cursor
NEResize
nwResize :: Cursor
nwResize :: Cursor
nwResize = Cursor
NWResize
seResize :: Cursor
seResize :: Cursor
seResize = Cursor
SEResize
swResize :: Cursor
swResize :: Cursor
swResize = Cursor
SWResize
ewResize :: Cursor
ewResize :: Cursor
ewResize = Cursor
ewResize
nsResize :: Cursor
nsResize :: Cursor
nsResize = Cursor
NSResize
neswResize :: Cursor
neswResize :: Cursor
neswResize = Cursor
NESWResize
nwseResize :: Cursor
nwseResize :: Cursor
nwseResize = Cursor
NWSEResize
zoomIn :: Cursor
zoomIn :: Cursor
zoomIn = Cursor
ZoomIn
zoomOut :: Cursor
zoomOut :: Cursor
zoomOut = Cursor
ZoomOut
grab :: Cursor
grab :: Cursor
grab = Cursor
Grab
grabbing :: Cursor
grabbing :: Cursor
grabbing = Cursor
Grabbing
url :: TS.Text -> Cursor -> Cursor
url :: Text -> Cursor -> Cursor
url = Text -> Cursor -> Cursor
URL