{-# 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

-- | A data type that can represent a browser cursor.
class CanvasCursor a where
    -- | Convert a value into a JavaScript string representing a cursor value.
    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

-- | Specified the mouse cursor's appearance in a web browser.
--
-- Images by the Mozilla Developer Network are licensed under
-- <http://creativecommons.org/licenses/by-sa/2.5/ CC-BY-SA 2.5>.
data Cursor = Auto         -- ^ The browser determines the cursor to display based on the
                           --   current context.
            | Default      -- ^ <<https://developer.mozilla.org/@api/deki/files/3438/=default.gif>>
            | None         -- ^ No cursor is rendered.
            | ContextMenu  -- ^ <<https://developer.mozilla.org/@api/deki/files/3461/=context-menu.png>>
            | Help         -- ^ <<https://developer.mozilla.org/@api/deki/files/3442/=help.gif>>
            | Pointer      -- ^ <<https://developer.mozilla.org/@api/deki/files/3449/=pointer.gif>>
            | Progress     -- ^ <<https://developer.mozilla.org/@api/deki/files/3450/=progress.gif>>
            | Wait         -- ^ <<https://developer.mozilla.org/@api/deki/files/3457/=wait.gif>>
            | Cell         -- ^ <<https://developer.mozilla.org/@api/deki/files/3434/=cell.gif>>
            | Crosshair    -- ^ <<https://developer.mozilla.org/@api/deki/files/3437/=crosshair.gif>>
            | Text         -- ^ <<https://developer.mozilla.org/files/3809/text.gif>>
            | VerticalText -- ^ <<https://developer.mozilla.org/@api/deki/files/3456/=vertical-text.gif>>
            | Alias        -- ^ <<https://developer.mozilla.org/@api/deki/files/3432/=alias.gif>>
            | Copy         -- ^ <<https://developer.mozilla.org/@api/deki/files/3436/=copy.gif>>
            | Move         -- ^ <<https://developer.mozilla.org/@api/deki/files/3443/=move.gif>>
            | NoDrop       -- ^ <<https://developer.mozilla.org/@api/deki/files/3445/=no-drop.gif>>
            | NotAllowed   -- ^ <<https://developer.mozilla.org/@api/deki/files/3446/=not-allowed.gif>>
            | AllScroll    -- ^ <<https://developer.mozilla.org/@api/deki/files/3433/=all-scroll.gif>>
            | ColResize    -- ^ <<https://developer.mozilla.org/@api/deki/files/3435/=col-resize.gif>>
            | RowResize    -- ^ <<https://developer.mozilla.org/@api/deki/files/3451/=row-resize.gif>>
            | NResize      -- ^ <<https://developer.mozilla.org/files/4083/n-resize.gif>>
            | EResize      -- ^ <<https://developer.mozilla.org/files/4085/e-resize.gif>>
            | SResize      -- ^ <<https://developer.mozilla.org/files/4087/s-resize.gif>>
            | WResize      -- ^ <<https://developer.mozilla.org/files/4089/w-resize.gif>>
            | NEResize     -- ^ <<https://developer.mozilla.org/files/4091/ne-resize.gif>>
            | NWResize     -- ^ <<https://developer.mozilla.org/files/4093/nw-resize.gif>>
            | SEResize     -- ^ <<https://developer.mozilla.org/files/4097/se-resize.gif>>
            | SWResize     -- ^ <<https://developer.mozilla.org/files/4095/sw-resize.gif>>
            | EWResize     -- ^ <<https://developer.mozilla.org/files/3806/3-resize.gif>>
            | NSResize     -- ^ <<https://developer.mozilla.org/files/3808/6-resize.gif>>
            | NESWResize   -- ^ <<https://developer.mozilla.org/files/3805/1-resize.gif>>
            | NWSEResize   -- ^ <<https://developer.mozilla.org/files/3807/4-resize.gif>>
            | ZoomIn       -- ^ <<https://developer.mozilla.org/@api/deki/files/3459/=zoom-in.gif>>
            | ZoomOut      -- ^ <<https://developer.mozilla.org/@api/deki/files/3460/=zoom-out.gif>>
            | Grab         -- ^ <<https://developer.mozilla.org/@api/deki/files/3440/=grab.gif>>
            | Grabbing     -- ^ <<https://developer.mozilla.org/@api/deki/files/3441/=grabbing.gif>>
            | URL TS.Text Cursor
              -- ^ An image from a URL. Must be followed by another '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

-- | Shorthand for 'Auto'.
auto :: Cursor
auto :: Cursor
auto = Cursor
Auto

-- | Shorthand for 'Default', with an underscore to distinguish it from the
-- Haskell keyword @default@.
default_ :: Cursor
default_ :: Cursor
default_ = Cursor
Default

-- | Shorthand for 'None'.
none :: Cursor
none :: Cursor
none = Cursor
None

-- | Shorthand for 'ContextMenu'.
contextMenu :: Cursor
contextMenu :: Cursor
contextMenu = Cursor
ContextMenu

-- | Shorthand for 'Help'.
help :: Cursor
help :: Cursor
help = Cursor
Help

-- | Shorthand for 'Pointer'.
pointer :: Cursor
pointer :: Cursor
pointer = Cursor
Pointer

-- | Shorthand for 'Progress'.
progress :: Cursor
progress :: Cursor
progress = Cursor
Progress

-- | Shorthand for 'Wait'.
wait :: Cursor
wait :: Cursor
wait = Cursor
Wait

-- | Shorthand for 'Cell'.
cell :: Cursor
cell :: Cursor
cell = Cursor
Cell

-- | Shorthand for 'Crosshair'.
crosshair :: Cursor
crosshair :: Cursor
crosshair = Cursor
Crosshair

-- | Shorthand for 'Text'.
text :: Cursor
text :: Cursor
text = Cursor
Text

-- | Shorthand for 'VerticalText'.
verticalText :: Cursor
verticalText :: Cursor
verticalText = Cursor
VerticalText

-- | Shorthand for 'Alias'.
alias :: Cursor
alias :: Cursor
alias = Cursor
Alias

-- | Shorthand for 'Copy'.
copy :: Cursor
copy :: Cursor
copy = Cursor
Copy

-- | Shorthand for 'Move'.
move :: Cursor
move :: Cursor
move = Cursor
Move

-- | Shorthand for 'NoDrop'.
noDrop :: Cursor
noDrop :: Cursor
noDrop = Cursor
NoDrop

-- | Shorthand for 'NotAllowed'.
notAllowed :: Cursor
notAllowed :: Cursor
notAllowed = Cursor
NotAllowed

-- | Shorthand for 'AllScroll'.
allScroll :: Cursor
allScroll :: Cursor
allScroll = Cursor
AllScroll

-- | Shorthand for 'ColResize'.
colResize :: Cursor
colResize :: Cursor
colResize = Cursor
ColResize

-- | Shorthand for 'RowResize'.
rowResize :: Cursor
rowResize :: Cursor
rowResize = Cursor
RowResize

-- | Shorthand for 'NResize'.
nResize :: Cursor
nResize :: Cursor
nResize = Cursor
NResize

-- | Shorthand for 'EResize'.
eResize :: Cursor
eResize :: Cursor
eResize = Cursor
EResize

-- | Shorthand for 'SResize'.
sResize :: Cursor
sResize :: Cursor
sResize = Cursor
SResize

-- | Shorthand for 'WResize'.
wResize :: Cursor
wResize :: Cursor
wResize = Cursor
WResize

-- | Shorthand for 'NEResize'.
neResize :: Cursor
neResize :: Cursor
neResize = Cursor
NEResize

-- | Shorthand for 'NWResize'.
nwResize :: Cursor
nwResize :: Cursor
nwResize = Cursor
NWResize

-- | Shorthand for 'SEResize'.
seResize :: Cursor
seResize :: Cursor
seResize = Cursor
SEResize

-- | Shorthand for 'SWResize'.
swResize :: Cursor
swResize :: Cursor
swResize = Cursor
SWResize

-- | Shorthand for 'EWResize'.
ewResize :: Cursor
ewResize :: Cursor
ewResize = Cursor
ewResize

-- | Shorthand for 'NSResize'.
nsResize :: Cursor
nsResize :: Cursor
nsResize = Cursor
NSResize

-- | Shorthand for 'NESWResize'.
neswResize :: Cursor
neswResize :: Cursor
neswResize = Cursor
NESWResize

-- | Shorthand for 'NWSEResize'.
nwseResize :: Cursor
nwseResize :: Cursor
nwseResize = Cursor
NWSEResize

-- | Shorthand for 'ZoomIn'.
zoomIn :: Cursor
zoomIn :: Cursor
zoomIn = Cursor
ZoomIn

-- | Shorthand for 'ZoomOut'.
zoomOut :: Cursor
zoomOut :: Cursor
zoomOut = Cursor
ZoomOut

-- | Shorthand for 'Grab'.
grab :: Cursor
grab :: Cursor
grab = Cursor
Grab

-- | Shorthand for 'Grabbing'.
grabbing :: Cursor
grabbing :: Cursor
grabbing = Cursor
Grabbing

-- | Shorthand for 'URL'.
url :: TS.Text -> Cursor -> Cursor
url :: Text -> Cursor -> Cursor
url = Text -> Cursor -> Cursor
URL