{-|
Module      : Monomer.Main.Types
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Basic types for Main module.
-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Strict #-}

module Monomer.Main.Types where

import Control.Applicative ((<|>))
import Control.Concurrent.Async
import Control.Concurrent.STM.TChan
import Control.Monad.Catch
import Control.Monad.State
import Data.Default
import Data.Map (Map)
import Data.Text (Text)
import Data.Typeable (Typeable)
import Data.Sequence (Seq)
import GHC.Generics

import qualified SDL
import qualified SDL.Raw.Types as SDLR

import Monomer.Common
import Monomer.Core.StyleTypes
import Monomer.Core.ThemeTypes
import Monomer.Core.WidgetTypes
import Monomer.Event.Types
import Monomer.Graphics.Types
import Data.ByteString (ByteString)

-- | Main Monomer monad.
type MonomerM s e m = (Eq s, MonadState (MonomerCtx s e) m, MonadCatch m, MonadIO m)

-- | Messages received by the rendering thread.
data RenderMsg s e
  = MsgInit (WidgetEnv s e) (WidgetNode s e)
  | MsgRender (WidgetEnv s e) (WidgetNode s e)
  | MsgResize Size
  | MsgRemoveImage Text
  | forall i . MsgRunInRender (TChan i) (IO i)

-- | Result from attempting to set up the secondary rendering thread.
data RenderSetupResult
  = RenderSetupSingle
  | RenderSetupMulti
  | RenderSetupMakeCurrentFailed String
  deriving (Eq, Show)

{-|
Requirements for periodic rendering by a widget. Start time is stored to
calculate next frame based on the step ms. A maximum number of repetitions may
be provided.
-}
data RenderSchedule = RenderSchedule {
  _rsWidgetId :: WidgetId,
  _rsStart :: Millisecond,
  _rsMs :: Millisecond,
  _rsRepeat :: Maybe Int
} deriving (Eq, Show, Generic)

-- | Drag action started by "WidgetId", with an associated message.
data DragAction = DragAction {
  _dgaWidgetId :: WidgetId,
  _dgaDragData :: WidgetDragMsg
} deriving (Eq, Show)

{-|
Asynchronous widget task. Results must be provided as user defined, Typeable,
types. Error handling should be done inside the task and reporting handled as
part of the user type.
-}
data WidgetTask
  -- | Task generating a single result (for example, an HTTP request).
  = forall i . Typeable i => WidgetTask WidgetId (Async i)
  -- | Task generating a multiple result (for example, a Socket).
  | forall i . Typeable i => WidgetProducer WidgetId (TChan i) (Async ())

-- | Current state of the Monomer runtime.
data MonomerCtx s e = MonomerCtx {
  -- | Main application model.
  _mcMainModel :: s,
  -- | Active window.
  _mcWindow :: ~SDL.Window,
  -- | Main window size.
  _mcWindowSize :: Size,
  -- | Device pixel rate.
  _mcDpr :: Double,
  -- | Event pixel rate.
  _mcEpr :: Double,
  -- | Renderer instance or communication channel with the render thread.
  _mcRenderMethod :: Either Renderer (TChan (RenderMsg s e)),
  -- | Input status (mouse and keyboard).
  _mcInputStatus :: InputStatus,
  -- | Cursor icons (a stack is used because of parent -> child relationship).
  _mcCursorStack :: [(WidgetId, CursorIcon)],
  -- | WidgetId of focused widget.
  _mcFocusedWidgetId :: WidgetId,
  -- | WidgetId of hovered widget, if any.
  _mcHoveredWidgetId :: Maybe WidgetId,
  -- | WidgetId of overlay widget, if any.
  _mcOverlayWidgetId :: Maybe WidgetId,
  -- | Active drag action, if any.
  _mcDragAction :: Maybe DragAction,
  -- | Start point and target of latest main button press, if any.
  _mcMainBtnPress :: Maybe (Path, Point),
  -- | Active widget tasks.
  _mcWidgetTasks :: Seq WidgetTask,
  {-|
  Associations of WidgetId to updated paths. Only WidgetIds whose initial path
  changed are included.
  -}
  _mcWidgetPaths :: Map WidgetId Path,
  -- | Association of Monomer CursorIcon to SDL Cursors.
  _mcCursorIcons :: Map CursorIcon SDLR.Cursor,
  {-|
  Hacky flag to avoid resizing when transitioning hover. Needed because sizes
  may change and new target of hover should not change.
  -}
  _mcLeaveEnterPair :: Bool,
  -- | Widgets with pending resize requests.
  _mcResizeRequests :: Seq WidgetId,
  -- | Flag indicating render was requested in this cycle.
  _mcRenderRequested :: Bool,
  -- | Active periodic rendering requests.
  _mcRenderSchedule :: Map WidgetId RenderSchedule,
  -- | Whether there was a request to exit the application.
  _mcExitApplication :: Bool
}

-- | Requests for main window size.
data MainWindowState
  -- | Normal window with a given size.
  = MainWindowNormal (Int, Int)
  -- | Maximized window.
  | MainWindowMaximized
  -- | Full screen window.
  | MainWindowFullScreen
  deriving (Eq, Show)

-- | Main application config.
data AppConfig s e = AppConfig {
  -- | Initial size of the main window.
  _apcWindowState :: Maybe MainWindowState,
  -- | Title of the main window.
  _apcWindowTitle :: Maybe Text,
  -- | Whether the main window is resizable.
  _apcWindowResizable :: Maybe Bool,
  -- | Whether the main window has a border.
  _apcWindowBorder :: Maybe Bool,
  -- | Path to an icon file in BMP format.
  _apcWindowIcon :: Maybe Text,
  -- | Whether a separate render thread should be used. Defaults to True.
  _apcUseRenderThread :: Maybe Bool,
  {-|
  Max number of FPS the application will run at. It does not necessarily mean
  rendering will happen every frame, but events and schedules will be checked at
  this rate.
  -}
  _apcMaxFps :: Maybe Int,
  {-|
  Scale factor to apply. This factor only affects the content, not the size of
  the window. It is applied in addition to the detected display scaling.
  -}
  _apcScaleFactor :: Maybe Double,
  {-|
  Whether display scaling detection should not be attempted. If set to True, the
  display scale will be set to 1. This works together with 'appScaleFactor'.
  -}
  _apcDisableAutoScale :: Maybe Bool,
  {-|
  Available fonts to the application. An empty list will make it impossible to
  render text.
  -}
  _apcFonts :: [FontDef],
  -- | Initial theme.
  _apcTheme :: Maybe Theme,
  -- | Initial event, useful for loading resources.
  _apcInitEvent :: [e],
  -- | Dispose event, useful for closing resources.
  _apcDisposeEvent :: [e],
  -- | Exit event, useful for cancelling an application close event.
  _apcExitEvent :: [e],
  -- | Resize event handler.
  _apcResizeEvent :: [Rect -> e],
  -- | Defines which mouse button is considered main.
  _apcMainButton :: Maybe Button,
  -- | Defines which mouse button is considered secondary or context button.
  _apcContextButton :: Maybe Button,
  -- | Whether wheel/trackpad horizontal movement should be inverted.
  _apcInvertWheelX :: Maybe Bool,
  -- | Whether wheel/trackpad vertical movement should be inverted.
  _apcInvertWheelY :: Maybe Bool,
  -- | Whether compositing should be disabled. Defaults to False.
  _apcDisableCompositing :: Maybe Bool,
  -- | Whether the screensaver should be disabled. Defaults to False.
  _apcDisableScreensaver :: Maybe Bool,
  -- | Extracts a String based fingerprint from the application's model.
  --   See 'appFingerprint' for more details.
  _apcModelFingerprintFn :: Maybe (s -> String)
}

instance Default (AppConfig s e) where
  def = AppConfig {
    _apcWindowState = Nothing,
    _apcWindowTitle = Nothing,
    _apcWindowResizable = Nothing,
    _apcWindowBorder = Nothing,
    _apcWindowIcon = Nothing,
    _apcUseRenderThread = Nothing,
    _apcMaxFps = Nothing,
    _apcScaleFactor = Nothing,
    _apcDisableAutoScale = Nothing,
    _apcFonts = [],
    _apcTheme = Nothing,
    _apcInitEvent = [],
    _apcDisposeEvent = [],
    _apcExitEvent = [],
    _apcResizeEvent = [],
    _apcMainButton = Nothing,
    _apcContextButton = Nothing,
    _apcInvertWheelX = Nothing,
    _apcInvertWheelY = Nothing,
    _apcDisableCompositing = Nothing,
    _apcDisableScreensaver = Nothing,
    _apcModelFingerprintFn = Nothing
  }

instance Semigroup (AppConfig s e) where
  (<>) a1 a2 = AppConfig {
    _apcWindowState = _apcWindowState a2 <|> _apcWindowState a1,
    _apcWindowTitle = _apcWindowTitle a2 <|> _apcWindowTitle a1,
    _apcWindowResizable = _apcWindowResizable a2 <|> _apcWindowResizable a1,
    _apcWindowBorder = _apcWindowBorder a2 <|> _apcWindowBorder a1,
    _apcWindowIcon = _apcWindowIcon a2 <|> _apcWindowIcon a1,
    _apcUseRenderThread = _apcUseRenderThread a2 <|> _apcUseRenderThread a1,
    _apcMaxFps = _apcMaxFps a2 <|> _apcMaxFps a1,
    _apcScaleFactor = _apcScaleFactor a2 <|> _apcScaleFactor a1,
    _apcDisableAutoScale = _apcDisableAutoScale a2 <|> _apcDisableAutoScale a1,
    _apcFonts = _apcFonts a1 ++ _apcFonts a2,
    _apcTheme = _apcTheme a2 <|> _apcTheme a1,
    _apcInitEvent = _apcInitEvent a1 ++ _apcInitEvent a2,
    _apcDisposeEvent = _apcDisposeEvent a1 ++ _apcDisposeEvent a2,
    _apcExitEvent = _apcExitEvent a1 ++ _apcExitEvent a2,
    _apcResizeEvent = _apcResizeEvent a1 ++ _apcResizeEvent a2,
    _apcMainButton = _apcMainButton a2 <|> _apcMainButton a1,
    _apcContextButton = _apcContextButton a2 <|> _apcContextButton a1,
    _apcInvertWheelX = _apcInvertWheelX a2 <|> _apcInvertWheelX a1,
    _apcInvertWheelY = _apcInvertWheelY a2 <|> _apcInvertWheelY a1,
    _apcDisableCompositing = _apcDisableCompositing a2 <|> _apcDisableCompositing a1,
    _apcDisableScreensaver = _apcDisableScreensaver a2 <|> _apcDisableScreensaver a1,
    _apcModelFingerprintFn = _apcModelFingerprintFn a2 <|> _apcModelFingerprintFn a1
  }

instance Monoid (AppConfig s e) where
  mempty = def

-- | Initial size of the main window.
appWindowState :: MainWindowState -> AppConfig s e
appWindowState title = def {
  _apcWindowState = Just title
}

-- | Title of the main window.
appWindowTitle :: Text -> AppConfig s e
appWindowTitle title = def {
  _apcWindowTitle = Just title
}

-- | Whether the main window is resizable.
appWindowResizable :: Bool -> AppConfig s e
appWindowResizable resizable = def {
  _apcWindowResizable = Just resizable
}

-- | Whether the main window has a border.
appWindowBorder :: Bool -> AppConfig s e
appWindowBorder border = def {
  _apcWindowBorder = Just border
}

-- | Path to an icon file in BMP format.
appWindowIcon :: Text -> AppConfig s e
appWindowIcon path = def {
  _apcWindowIcon = Just path
}

{-|
Performs rendering on the main thread. On macOS and Windows this also disables
continuous rendering on window resize, but in some Linux configurations it still
works.

This configuration option was originally available to handle:

  - OpenGL driver issues which prevented normal startup showing the "Unable to
    make GL context current" error.
  - Single threaded applications (without -threaded) which cannot use forkOS.

This flag is no longer necessary for those cases, since the library will:

  - Attempt to fall back to rendering on the main thread if setting up a
    secondary rendering thread fails.
  - Will not attempt to set up a secondary rendering thread if the runtime does
    not support bound threads (i.e. compiled without the -threaded flag).
-}
{-# DEPRECATED appRenderOnMainThread
  "Should no longer be needed. Check appRenderOnMainThread's Haddock page." #-}
appRenderOnMainThread :: AppConfig s e
appRenderOnMainThread = def {
  _apcUseRenderThread = Just False
}

{-|
Max number of FPS the application will run on. It does not necessarily mean
rendering will happen every frame, but events and schedules will be checked at
this rate and may cause it.
-}
appMaxFps :: Int -> AppConfig s e
appMaxFps fps = def {
  _apcMaxFps = Just fps
}

{-|
Scale factor to apply to the viewport. This factor only affects the content, not
the size of the window. It is applied in addition to the detected display scale
factor, and can be useful if the detected value is not the desired.
-}
appScaleFactor :: Double -> AppConfig s e
appScaleFactor factor = def {
  _apcScaleFactor = Just factor
}

{-|
Whether display scaling detection should not be attempted. If set to True, the
display scale will be set to 1. This flag does not cause an effect on macOS.

Disabling auto scaling also affects window size on Linux and Windows in the
cases where the library would have applied scaling. This happens because window
and viewport size are the same in those operating systems. Window size can be
adjusted with 'appWindowState'.

The logic for detecting display scaling varies depending on the platform:

__macOS__

Scaling can be detected based on the window size and viewport size; the ratio
between these two give the scaling factor.

Using window and viewport size for detecting DPI only works on macOS; both
Windows and Linux return the same value for window and viewport size.

__Windows__

SDL_GetDisplayDPI returns the DPI of the screen, and dividing by 96 gives the
scaling factor. This factor is used to scale the window size and the content.

__Linux__

The situation is more complex, since SDL_GetDisplayDPI does not always return
valid information. There is not a practical DPI/scale detection solution that
works for all combinations of Linux display servers and window managers. Even
when using the most popular window managers, the scaling factor may be handled
differently by the distribution (GNOME in Ubuntu). For a reference of some of
the existing options for DPI scaling detection, check here:
https://wiki.archlinux.org/title/HiDPI.

Considering the above, when SDL_GetDisplayDPI fails, the library assumes that a
screen width larger than 1920 belongs to an HiDPI display and uses a scale
factor of 2. This factor is used to scale the window size and the content.
-}
appDisableAutoScale :: Bool -> AppConfig s e
appDisableAutoScale disable = def {
  _apcDisableAutoScale = Just disable
}

{-|
Available fonts to the application, loaded from the specified path.
Specifying no fonts will make it impossible to render text.
-}
appFontDef :: Text -> Text -> AppConfig s e
appFontDef name path = def {
  _apcFonts = [ FontDefFile name path ]
}

{-|
Available fonts to the application, loaded from the bytes in memory.
Specifying no fonts will make it impossible to render text.

One use case for this function is to embed fonts in the application, without the need to distribute the font files.
The [file-embed](https://hackage.haskell.org/package/file-embed-0.0.15.0/docs/Data-FileEmbed.html) library can be used for this.
@
appFontDefMemory "memoryFont" $(embedFile "dirName/fileName")
@
-}
appFontDefMem :: Text -> ByteString -> AppConfig s e
appFontDefMem name bytes = def {
  _apcFonts = [ FontDefMem name bytes ]
}

-- | Initial theme.
appTheme :: Theme -> AppConfig s e
appTheme t = def {
  _apcTheme = Just t
}

-- | Initial event, useful for loading resources.
appInitEvent :: e -> AppConfig s e
appInitEvent evt = def {
  _apcInitEvent = [evt]
}

-- | Dispose event, useful for closing resources.
appDisposeEvent :: e -> AppConfig s e
appDisposeEvent evt = def {
  _apcDisposeEvent = [evt]
}

-- | Exit event, useful for cancelling an application close event.
appExitEvent :: e -> AppConfig s e
appExitEvent evt = def {
  _apcExitEvent = [evt]
}

-- | Resize event handler.
appResizeEvent :: (Rect -> e) -> AppConfig s e
appResizeEvent evt = def {
  _apcResizeEvent = [evt]
}

-- | Defines which mouse button is considered main.
appMainButton :: Button -> AppConfig s e
appMainButton btn = def {
  _apcMainButton = Just btn
}

-- | Defines which mouse button is considered secondary or context button.
appContextButton :: Button -> AppConfig s e
appContextButton btn = def {
  _apcContextButton = Just btn
}

{-|
Whether the horizontal wheel/trackpad movement should be inverted. In general
platform detection should do the right thing.
-}
appInvertWheelX :: Bool -> AppConfig s e
appInvertWheelX invert = def {
  _apcInvertWheelX = Just invert
}

{-|
Whether the vertical wheel/trackpad movement should be inverted. In general
platform detection should do the right thing.
-}
appInvertWheelY :: Bool -> AppConfig s e
appInvertWheelY invert = def {
  _apcInvertWheelY = Just invert
}

{-|
Whether compositing should be disabled. Linux only, ignored in other platforms.
Defaults to False.

Desktop applications should leave compositing as is since disabling it may
cause visual glitches in other programs. When creating games or full-screen
applications, disabling compositing may improve performance.
-}
appDisableCompositing :: Bool -> AppConfig s e
appDisableCompositing disable = def {
  _apcDisableCompositing = Just disable
}

{-|
Whether the screensaver should be disabled. Defaults to False.

Desktop applications should leave the screensaver as is since disabling it also
affects power saving features, including turning off the screen. When creating
games or full-screen applications, disabling the screensaver may make sense.
-}
appDisableScreensaver :: Bool -> AppConfig s e
appDisableScreensaver disable = def {
  _apcDisableScreensaver = Just disable
}

{-|
Generates a fingerprint from the application's model. This is used to identify
whether the application should attempt to reuse the model between reloads when
running in interpreted mode. Since Monomer uses the model to build the UI,
reusing the old model allows for quicker iteration as the application will be
restored to its previous state before being reloaded. By default, unless a
fingerprint function is provided, the model will not be reused and the
application will start from scratch.

The fingerprint function is applied to the user provided model on application's
startup only, not on subsequent updates during the application's lifetime. When
a reload occurs, the original fingerprint of the model is compared against the
fingerprint of the newly provided version of the model; if they match, it is
assumed that the latest version of the original model can be reused. If the
fingerprint changed because its data or data type changed, the new model will be
used. The rationale is that, since the model is provided by the developer at
startup, if the fingerprints match then only changes to business logic/UI have
been made.

A fingerprint function is used because trying to compare two different versions
of a data type using its 'Eq' instance will result in ghci crashing. Creating a
string based fingerprint as soon as the instance is available is a workaround
for this issue. Ideally, the fingerprint would incorporate enough information to
detect type and data changes.

A simple approach is using the 'show' function to generate the fingerprint,
although in some cases it may not be possible, maybe because the type does not
implement it or it does not include enough information.

An alternative to 'show' is <https://hackage.haskell.org/package/recover-rtti
recover-rtti>'s __anythingToString__. This function returns a string
representation of the data, although it does not include the name of record
fields. In general this is not an issue, but changing a field's type from 'Int'
to 'Long' will go undetected and cause a crash.

Ideally, we could use "GHC.Fingerprint.Fingerprint" to detect changes in the
model's type, but unfortunately this is not reliable since this fingerprint is
based on the type's name only.

GHC issue with more details: https://gitlab.haskell.org/ghc/ghc/-/issues/7897.
Related Hint issue: https://github.com/haskell-hint/hint/issues/31.
-}
appModelFingerprint :: (s -> String) -> AppConfig s e
appModelFingerprint fn = def {
  _apcModelFingerprintFn = Just fn
}