    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE KindSignatures #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE MultiParamTypeClasses #-}

    module SDL.Hint (
      -- * Getting and setting hints
      Hint(..),
      setHintWithPriority,
      HintPriority(..),
      clearHints,

      -- * Hint Information
      -- ** 'HintAccelerometerAsJoystick'
      AccelerometerJoystickOptions(..),

      -- ** 'HintFramebufferAcceleration'
      FramebufferAccelerationOptions(..),

      -- ** 'HintMacCTRLClick'
      MacCTRLClickOptions(..),

      -- ** 'HintMouseRelativeModeWarp'
      MouseModeWarpOptions(..),

      -- ** 'HintRenderDriver'
      RenderDrivers(..),

      -- ** 'HintRenderOpenGLShaders'
      RenderOpenGLShaderOptions(..),

      -- ** 'HintRenderScaleQuality'
      RenderScaleQuality(..),

      -- ** 'HintRenderVSync'
      RenderVSyncOptions(..),

      -- ** 'HintVideoWinD3DCompiler'
      VideoWinD3DCompilerOptions(..)
      ) where

    import Control.Exception
    import Control.Monad (void)
    import Control.Monad.IO.Class (MonadIO, liftIO)
    import Data.Data (Data)
    import Data.Maybe (fromMaybe)
    import Data.StateVar
    import Data.Typeable
    import Foreign.C
    import GHC.Generics (Generic)
    import SDL.Exception
    import qualified SDL.Raw as Raw

    -- | A hint that specifies whether the Android\/iOS built-in accelerometer should
    -- be listed as a joystick device, rather than listing actual joysticks only.
    -- By default SDL will list real joysticks along with the accelerometer as if it
    -- were a 3 axis joystick.
    data AccelerometerJoystickOptions
      = AccelerometerNotJoystick
        -- ^ List only real joysticks and accept input from them
      | AccelerometerIsJoystick
        -- ^ List real joysticks along with the accelerometer as if it were a 3 axis
        -- joystick (the default)
      deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable)

    -- | A hint that specifies how 3D acceleration is used to accelerate the SDL
    -- screen surface. By default SDL tries to make a best guess whether to use
    -- acceleration or not on each platform.
    data FramebufferAccelerationOptions
      = Disable3D -- ^ Disable 3D acceleration
      | Enable3DDefault -- ^ Enable 3D acceleration, using the default renderer
      | Enable3DDirect3D -- ^ Enable 3D acceleration using Direct3D
      | Enable3DOpenGL -- ^ Enable 3D acceleration using OpenGL
      | Enable3DOpenGLES -- ^ Enable 3D acceleration using OpenGLES
      | Enable3DOpenGLES2 -- ^ Enable 3D acceleration using OpenGLES2
      | Enable3DSoftware -- ^ Enable 3D acceleration using software rendering
      deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable)

    -- | A hint that specifies whether ctrl+click should generate a right-click event
    -- on Mac. By default holding ctrl while left clicking will not generate a right
    -- click event when on Mac.
    data MacCTRLClickOptions
      = NoRightClick -- ^ Disable emulating right click
      | EmulateRightClick -- ^ Enable emulating right click
      deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable)

    -- | A hint that specifies whether relative mouse mode is implemented using mouse
    -- warping. By default SDL will use raw input for relative mouse mode
    data MouseModeWarpOptions
      = MouseRawInput -- ^ Relative mouse mode uses the raw input
      | MouseWarping -- ^ Relative mouse mode uses mouse warping
      deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable)

    -- | A hint that specifies which render driver to use. By default the first one
    -- in the list that is available on the current platform is chosen.
    data RenderDrivers
      = Direct3D
      | OpenGL
      | OpenGLES
      | OpenGLES2
      | Software
      deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable)

    -- | A hint that specifies whether the OpenGL render driver uses shaders.
    -- By default shaders are used if OpenGL supports them.
    data RenderOpenGLShaderOptions
      = DisableShaders -- ^ Disable shaders
      | EnableShaders -- ^ Enable shaders, if they are available
      deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable)

    -- | A hint that specifies scaling quality. By default nearest pixel sampling is
    -- used.
    data RenderScaleQuality
      = ScaleNearest -- ^ Nearest pixel sampling
      | ScaleLinear -- ^ linear filtering (supported by OpenGL and Direct3D)
      | ScaleBest -- ^ Anisotropic filtering (supported by Direct3D)
      deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable)

    -- | A hint that specifies whether sync to vertical refresh is enabled or
    -- disabled to avoid tearing. By default SDL uses the flag passed into calls
    -- to create renderers.
    data RenderVSyncOptions
      = DisableVSync
      | EnableVSync
      deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable)

    -- | A hint that specifies which shader compiler to preload when using the Chrome
    -- ANGLE binaries. By default @d3dcompiler_46.dll@ will be used.
    data VideoWinD3DCompilerOptions
      = D3DVistaOrLater -- ^ Use @d3dcompiler_46.dll@, best for Vista or later
      | D3DXPSupport -- ^ Use @d3dcompiler_43.dll@ for XP support
      | D3DNone -- ^ Do not load any library, useful if you compiled ANGLE from source and included the compiler in your binaries
      deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable)

    -- | The 'Hint' type exports a well-typed interface to SDL's concept of
    -- <https://wiki.libsdl.org/CategoryHints hints>. This type has instances for
    -- both 'HasGetter' and 'HasSetter', allowing you to get and set hints. Note that
    -- the 'HasSetter' interface is fairly relaxed - if a hint cannot be set, the
    -- failure will be silently discarded. For more feedback and control when setting
    -- hints, see 'setHintWithPriority'.
    data Hint :: * -> * where
      HintAccelerometerAsJoystick :: Hint AccelerometerJoystickOptions
      HintFramebufferAcceleration :: Hint FramebufferAccelerationOptions
      HintMacCTRLClick :: Hint MacCTRLClickOptions
      HintMouseRelativeModeWarp :: Hint MouseModeWarpOptions
      HintRenderDriver :: Hint RenderDrivers
      HintRenderOpenGLShaders :: Hint RenderOpenGLShaderOptions
      HintRenderScaleQuality :: Hint RenderScaleQuality
      HintRenderVSync :: Hint RenderVSyncOptions
      HintVideoWinD3DCompiler :: Hint VideoWinD3DCompilerOptions

    instance HasSetter (Hint v) v where
      hint $= v =
        _setHint (\name value ->
                    void (Raw.setHint name value))
                 hint
                 v

    -- | How to deal with setting hints when an existing override or environment
    -- variable is present.
    data HintPriority
      = DefaultPriority -- ^ Low priority, used for default values
      | NormalPriority -- ^ Medium priority
      | OverridePriority -- ^ High priority
      deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable)

    -- | Set the value of a hint, applying priority rules for when there is a
    -- conflict. Ordinarily, a hint will not be set if there is an existing override
    -- hint or environment variable that takes precedence.
    setHintWithPriority :: MonadIO m => HintPriority -> Hint v -> v -> m Bool
    setHintWithPriority prio =
      _setHint (\name value ->
                  Raw.setHintWithPriority
                    name
                    value
                    (case prio of
                       DefaultPriority -> Raw.SDL_HINT_DEFAULT
                       NormalPriority -> Raw.SDL_HINT_NORMAL
                       OverridePriority -> Raw.SDL_HINT_OVERRIDE))

    _setHint :: MonadIO m => (CString -> CString -> IO a) -> Hint v -> v -> m a
    _setHint f h@HintAccelerometerAsJoystick v = liftIO $
      withCString (hintToString h) $ \hint ->
        withCString
          (case v of
             AccelerometerNotJoystick -> "0"
             AccelerometerIsJoystick -> "1")
          (f hint)

    _setHint f h@HintFramebufferAcceleration v = liftIO $
      withCString (hintToString h) $ \hint ->
        withCString
          (case v of
             Disable3D -> "0"
             Enable3DDefault -> "1"
             Enable3DDirect3D -> "direct3d"
             Enable3DOpenGL -> "opengl"
             Enable3DOpenGLES -> "opengles"
             Enable3DOpenGLES2 -> "opengles2"
             Enable3DSoftware -> "software"
             )
          (f hint)

    _setHint f h@HintMacCTRLClick v = liftIO $
      withCString (hintToString h) $ \hint ->
        withCString
          (case v of
             NoRightClick -> "0"
             EmulateRightClick -> "1")
          (f hint)

    _setHint f h@HintMouseRelativeModeWarp v = liftIO $
      withCString (hintToString h) $ \hint ->
        withCString
          (case v of
             MouseRawInput -> "0"
             MouseWarping -> "1")
          (f hint)

    _setHint f h@HintRenderDriver v = liftIO $
      withCString (hintToString h) $ \hint ->
        withCString
          (case v of
             Direct3D -> "direct3d"
             OpenGL -> "opengl"
             OpenGLES -> "opengles"
             OpenGLES2 -> "opengles2"
             Software -> "software")
          (f hint)

    _setHint f h@HintRenderOpenGLShaders v = liftIO $
      withCString (hintToString h) $ \hint ->
        withCString
          (case v of
             DisableShaders -> "0"
             EnableShaders -> "1")
          (f hint)

    _setHint f h@HintRenderScaleQuality v = liftIO $
      withCString (hintToString h) $ \hint ->
        withCString
          (case v of
             ScaleNearest -> "0"
             ScaleLinear -> "1"
             ScaleBest -> "2")
          (f hint)

    _setHint f h@HintRenderVSync v = liftIO $
      withCString (hintToString h) $ \hint ->
        withCString
          (case v of
             DisableVSync -> "0"
             EnableVSync -> "1")
          (f hint)

    _setHint f h@HintVideoWinD3DCompiler v = liftIO $
      withCString (hintToString h) $ \hint ->
        withCString
          (case v of
             D3DVistaOrLater -> "d3dcompiler_46.dll"
             D3DXPSupport -> "d3dcompiler_43.dll"
             D3DNone ->  "none")
          (f hint)

    -- | Retrieve and map the current value associated with the given hint.
    mapHint :: MonadIO m => Hint v -> (String -> Maybe v) -> m v
    mapHint h f = liftIO $
      withCString (hintToString h) $ \hint -> do
        strResult <- peekCString =<< Raw.getHint hint
        return $! fromMaybe
            (throw (SDLUnknownHintValue (hintToString h) strResult))
            (f strResult)

    instance HasGetter (Hint v) v where
      get h@HintAccelerometerAsJoystick =
        mapHint h (\case
            "0" -> Just AccelerometerNotJoystick
            "1" -> Just AccelerometerIsJoystick
            _ -> Nothing)

      get h@HintFramebufferAcceleration =
        mapHint h (\case
             "0" -> Just Disable3D
             "1" -> Just Enable3DDefault
             "direct3d" -> Just Enable3DDirect3D
             "opengl" -> Just Enable3DOpenGL
             "opengles" -> Just Enable3DOpenGLES
             "opengles2" -> Just Enable3DOpenGLES2
             "software" -> Just Enable3DSoftware
             _ -> Nothing)

      get h@HintMacCTRLClick =
        mapHint h (\case
             "0" -> Just NoRightClick
             "1" -> Just EmulateRightClick
             _ -> Nothing)

      get h@HintMouseRelativeModeWarp =
        mapHint h (\case
             "0" -> Just MouseRawInput
             "1" -> Just MouseWarping
             _ -> Nothing)

      get h@HintRenderDriver =
        mapHint h (\case
             "direct3d" -> Just Direct3D
             "opengl" -> Just OpenGL
             "opengles" -> Just OpenGLES
             "opengles2" -> Just OpenGLES2
             "software" -> Just Software
             _ -> Nothing)

      get h@HintRenderOpenGLShaders =
        mapHint h (\case
             "0" -> Just DisableShaders
             "1" -> Just EnableShaders
             _ -> Nothing)

      get h@HintRenderScaleQuality =
        mapHint h (\case
             "0" -> Just ScaleNearest
             "1" -> Just ScaleLinear
             "2" -> Just ScaleBest
             _ -> Nothing)

      get h@HintRenderVSync =
        mapHint h (\case
             "0" -> Just DisableVSync
             "1" -> Just EnableVSync
             _ -> Nothing)

      get h@HintVideoWinD3DCompiler =
        mapHint h (\case
             "d3dcompiler_46.dll" -> Just D3DVistaOrLater
             "d3dcompiler_43.dll" -> Just D3DXPSupport
             "none" -> Just D3DNone
             _ -> Nothing)

    hintToString :: Hint v -> String
    hintToString HintAccelerometerAsJoystick = "SDL_ACCELEROMETER_AS_JOYSTICK"
    hintToString HintFramebufferAcceleration = "SDL_FRAMEBUFFER_ACCELERATION"
    hintToString HintMacCTRLClick            = "SDL_MAC_CTRL_CLICK_EMULATE_RIGHT_CLICK"
    hintToString HintMouseRelativeModeWarp   = "SDL_MOUSE_RELATIVE_MODE_WARP"
    hintToString HintRenderDriver            = "SDL_RENDER_DRIVER"
    hintToString HintRenderOpenGLShaders     = "SDL_RENDER_OPENGL_SHADERS"
    hintToString HintRenderScaleQuality      = "SDL_RENDER_SCALE_QUALITY"
    hintToString HintRenderVSync             = "SDL_RENDER_VSYNC"
    hintToString HintVideoWinD3DCompiler     = "SDL_VIDEO_WIN_D3DCOMPILER"

    clearHints :: MonadIO m => m ()
    clearHints = Raw.clearHints