{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Monomer.Dragboard.DragboardCfg
    ( -- * Re-exported modules
      module Monomer.Checkerboard.CheckerboardCfg
      -- * Configuration
    , DragboardCfg(..)
    , moveValidator
    , dragIdOffset
    , selectColor
    , disableClick
    , disableClick_
    , renderSource
    , renderSource_
    , checkerConfig
    ) where

import Control.Applicative ((<|>))
import Data.Default
import Monomer.Checkerboard.CheckerboardCfg
import Monomer.Widgets.Single

type Info a = ([[a]], Int, Int)

{-|
Configuration options for dragboard:

- 'moveValidator': function to check validity of a move.
- 'dragIdOffset': offset for drag and drop event messages.
- 'selectColor': color of selected square.
- 'disableClick': whether items can be moved only by dragging.
- 'renderSource': whether to render the source widget when dragging.
- 'duration': how long the animation lasts in ms.
- 'checkerConfig': config options for checkerboard container.
- 'onFocus': event to raise when focus is received.
- 'onFocusReq': 'WidgetRequest' to generate when focus is received.
- 'onBlur': event to raise when focus is lost.
- 'onBlurReq': 'WidgetRequest' to generate when focus is lost.
- 'onChange': event to raise when the board changes.
- 'onChangeReq': 'WidgetRequest' to generate when the board changes.
-}
data DragboardCfg s e a = DragboardCfg
    { forall s e a. DragboardCfg s e a -> Maybe (Info a -> Bool)
_dcValidator :: Maybe (Info a -> Bool)
    , forall s e a. DragboardCfg s e a -> Maybe Int
_dcOffset :: Maybe Int
    , forall s e a. DragboardCfg s e a -> Maybe Color
_dcSelectColor :: Maybe Color
    , forall s e a. DragboardCfg s e a -> Maybe Bool
_dcNoClick :: Maybe Bool
    , forall s e a. DragboardCfg s e a -> Maybe Bool
_dcRenderS :: Maybe Bool
    , forall s e a. DragboardCfg s e a -> Maybe Millisecond
_dcDuration :: Maybe Millisecond
    , forall s e a. DragboardCfg s e a -> [CheckerboardCfg]
_dcCheckerCfg :: [CheckerboardCfg]
    , forall s e a. DragboardCfg s e a -> [Path -> WidgetRequest s e]
_dcOnFocusReq :: [Path -> WidgetRequest s e]
    , forall s e a. DragboardCfg s e a -> [Path -> WidgetRequest s e]
_dcOnBlurReq :: [Path -> WidgetRequest s e]
    , forall s e a. DragboardCfg s e a -> [Info a -> WidgetRequest s e]
_dcOnChangeReq :: [Info a -> WidgetRequest s e]
    }

instance Default (DragboardCfg s e a) where
    def :: DragboardCfg s e a
def = DragboardCfg
        { _dcValidator :: Maybe (Info a -> Bool)
_dcValidator = forall a. Maybe a
Nothing
        , _dcOffset :: Maybe Int
_dcOffset = forall a. Maybe a
Nothing
        , _dcSelectColor :: Maybe Color
_dcSelectColor = forall a. Maybe a
Nothing
        , _dcNoClick :: Maybe Bool
_dcNoClick = forall a. Maybe a
Nothing
        , _dcRenderS :: Maybe Bool
_dcRenderS = forall a. Maybe a
Nothing
        , _dcDuration :: Maybe Millisecond
_dcDuration = forall a. Maybe a
Nothing
        , _dcCheckerCfg :: [CheckerboardCfg]
_dcCheckerCfg = []
        , _dcOnFocusReq :: [Path -> WidgetRequest s e]
_dcOnFocusReq = []
        , _dcOnBlurReq :: [Path -> WidgetRequest s e]
_dcOnBlurReq = []
        , _dcOnChangeReq :: [Info a -> WidgetRequest s e]
_dcOnChangeReq = []
        }

instance Semigroup (DragboardCfg s e a) where
    <> :: DragboardCfg s e a -> DragboardCfg s e a -> DragboardCfg s e a
(<>) DragboardCfg s e a
a1 DragboardCfg s e a
a2 = forall a. Default a => a
def
        { _dcValidator :: Maybe (Info a -> Bool)
_dcValidator = forall s e a. DragboardCfg s e a -> Maybe (Info a -> Bool)
_dcValidator DragboardCfg s e a
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DragboardCfg s e a -> Maybe (Info a -> Bool)
_dcValidator DragboardCfg s e a
a1
        , _dcOffset :: Maybe Int
_dcOffset = forall s e a. DragboardCfg s e a -> Maybe Int
_dcOffset DragboardCfg s e a
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DragboardCfg s e a -> Maybe Int
_dcOffset DragboardCfg s e a
a1
        , _dcSelectColor :: Maybe Color
_dcSelectColor = forall s e a. DragboardCfg s e a -> Maybe Color
_dcSelectColor DragboardCfg s e a
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DragboardCfg s e a -> Maybe Color
_dcSelectColor DragboardCfg s e a
a1
        , _dcNoClick :: Maybe Bool
_dcNoClick = forall s e a. DragboardCfg s e a -> Maybe Bool
_dcNoClick DragboardCfg s e a
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DragboardCfg s e a -> Maybe Bool
_dcNoClick DragboardCfg s e a
a1
        , _dcRenderS :: Maybe Bool
_dcRenderS = forall s e a. DragboardCfg s e a -> Maybe Bool
_dcRenderS DragboardCfg s e a
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DragboardCfg s e a -> Maybe Bool
_dcRenderS DragboardCfg s e a
a1
        , _dcDuration :: Maybe Millisecond
_dcDuration = forall s e a. DragboardCfg s e a -> Maybe Millisecond
_dcDuration DragboardCfg s e a
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DragboardCfg s e a -> Maybe Millisecond
_dcDuration DragboardCfg s e a
a1
        , _dcCheckerCfg :: [CheckerboardCfg]
_dcCheckerCfg = forall s e a. DragboardCfg s e a -> [CheckerboardCfg]
_dcCheckerCfg DragboardCfg s e a
a1 forall a. Semigroup a => a -> a -> a
<> forall s e a. DragboardCfg s e a -> [CheckerboardCfg]
_dcCheckerCfg DragboardCfg s e a
a2
        , _dcOnFocusReq :: [Path -> WidgetRequest s e]
_dcOnFocusReq = forall s e a. DragboardCfg s e a -> [Path -> WidgetRequest s e]
_dcOnFocusReq DragboardCfg s e a
a1 forall a. Semigroup a => a -> a -> a
<> forall s e a. DragboardCfg s e a -> [Path -> WidgetRequest s e]
_dcOnFocusReq DragboardCfg s e a
a2
        , _dcOnBlurReq :: [Path -> WidgetRequest s e]
_dcOnBlurReq = forall s e a. DragboardCfg s e a -> [Path -> WidgetRequest s e]
_dcOnBlurReq DragboardCfg s e a
a1 forall a. Semigroup a => a -> a -> a
<> forall s e a. DragboardCfg s e a -> [Path -> WidgetRequest s e]
_dcOnBlurReq DragboardCfg s e a
a2
        , _dcOnChangeReq :: [Info a -> WidgetRequest s e]
_dcOnChangeReq = forall s e a. DragboardCfg s e a -> [Info a -> WidgetRequest s e]
_dcOnChangeReq DragboardCfg s e a
a1 forall a. Semigroup a => a -> a -> a
<> forall s e a. DragboardCfg s e a -> [Info a -> WidgetRequest s e]
_dcOnChangeReq DragboardCfg s e a
a2
        }

instance Monoid (DragboardCfg s e a) where
    mempty :: DragboardCfg s e a
mempty = forall a. Default a => a
def

instance CmbDuration (DragboardCfg s e a) Millisecond where
    duration :: Millisecond -> DragboardCfg s e a
duration Millisecond
dur = forall a. Default a => a
def
        { _dcDuration :: Maybe Millisecond
_dcDuration = forall a. a -> Maybe a
Just Millisecond
dur
        }

instance WidgetEvent e =>
    CmbOnFocus (DragboardCfg s e a) e Path where
        onFocus :: (Path -> e) -> DragboardCfg s e a
onFocus Path -> e
fn = forall a. Default a => a
def
            { _dcOnFocusReq :: [Path -> WidgetRequest s e]
_dcOnFocusReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
fn]
            }

instance CmbOnFocusReq (DragboardCfg s e a) s e Path where
    onFocusReq :: (Path -> WidgetRequest s e) -> DragboardCfg s e a
onFocusReq Path -> WidgetRequest s e
req = forall a. Default a => a
def
        { _dcOnFocusReq :: [Path -> WidgetRequest s e]
_dcOnFocusReq = [Path -> WidgetRequest s e
req]
        }

instance WidgetEvent e =>
    CmbOnBlur (DragboardCfg s e a) e Path where
        onBlur :: (Path -> e) -> DragboardCfg s e a
onBlur Path -> e
fn = forall a. Default a => a
def
            { _dcOnBlurReq :: [Path -> WidgetRequest s e]
_dcOnBlurReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
fn]
            }

instance CmbOnBlurReq (DragboardCfg s e a) s e Path where
    onBlurReq :: (Path -> WidgetRequest s e) -> DragboardCfg s e a
onBlurReq Path -> WidgetRequest s e
req = forall a. Default a => a
def
        { _dcOnBlurReq :: [Path -> WidgetRequest s e]
_dcOnBlurReq = [Path -> WidgetRequest s e
req]
        }

instance WidgetEvent e =>
    CmbOnChange (DragboardCfg s e a) (Info a) e where
        onChange :: (Info a -> e) -> DragboardCfg s e a
onChange Info a -> e
fn = forall a. Default a => a
def
            { _dcOnChangeReq :: [Info a -> WidgetRequest s e]
_dcOnChangeReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Info a -> e
fn]
            }

instance CmbOnChangeReq (DragboardCfg s e a) s e (Info a) where
    onChangeReq :: (Info a -> WidgetRequest s e) -> DragboardCfg s e a
onChangeReq Info a -> WidgetRequest s e
req = forall a. Default a => a
def
        { _dcOnChangeReq :: [Info a -> WidgetRequest s e]
_dcOnChangeReq = [Info a -> WidgetRequest s e
req]
        }

{-|
Receives previous board, index of a square where item has been
dragged to and index of a square where item has been dragged from
and returns whether this move is valid or not. If move is not valid
then the board state will not change.
-}
moveValidator :: (Info a -> Bool) -> DragboardCfg s e a
moveValidator :: forall a s e. (Info a -> Bool) -> DragboardCfg s e a
moveValidator Info a -> Bool
validateMove = forall a. Default a => a
def
    { _dcValidator :: Maybe (Info a -> Bool)
_dcValidator = forall a. a -> Maybe a
Just Info a -> Bool
validateMove
    }

{-|
When there are multiple dragboards, it is possible to drag an item
from one dragboard to another. In order to ignore drop events caused
by foreign items or to process them properly, the dragboards should
use different offsets (for example, if each dragboard has less than
1000 squares, then multiples of 1000 can be used as offsets):

@
vgrid
    [ dragboard 3 3 boardState f
    , dragboard_ 3 3 anotherBoardState f [dragIdOffset 1000]
    , dragboard_ 3 3 yetAnotherBoardState f [dragIdOffset 2000]
    ]
@
-}
dragIdOffset :: Int -> DragboardCfg s e a
dragIdOffset :: forall s e a. Int -> DragboardCfg s e a
dragIdOffset Int
offset = forall a. Default a => a
def
    { _dcOffset :: Maybe Int
_dcOffset = forall a. a -> Maybe a
Just Int
offset
    }

{-|
Color of selected square which is yellow by default.
-}
selectColor :: Color -> DragboardCfg s e a
selectColor :: forall s e a. Color -> DragboardCfg s e a
selectColor Color
color = forall a. Default a => a
def
    { _dcSelectColor :: Maybe Color
_dcSelectColor = forall a. a -> Maybe a
Just Color
color
    }

{-|
Allows items to be moved only by dragging.
-}
disableClick :: DragboardCfg s e a
disableClick :: forall s e a. DragboardCfg s e a
disableClick = forall s e a. Bool -> DragboardCfg s e a
disableClick_ Bool
True

{-|
Whether items can be moved only by dragging.
-}
disableClick_ :: Bool -> DragboardCfg s e a
disableClick_ :: forall s e a. Bool -> DragboardCfg s e a
disableClick_ Bool
v = forall a. Default a => a
def
    { _dcNoClick :: Maybe Bool
_dcNoClick = forall a. a -> Maybe a
Just Bool
v
    }

{-|
Renders the source widget when dragging.
-}
renderSource :: DragboardCfg s e a
renderSource :: forall s e a. DragboardCfg s e a
renderSource = forall s e a. Bool -> DragboardCfg s e a
renderSource_ Bool
True

{-|
Whether to render the source widget when dragging.
-}
renderSource_ :: Bool -> DragboardCfg s e a
renderSource_ :: forall s e a. Bool -> DragboardCfg s e a
renderSource_ Bool
v = forall a. Default a => a
def
    { _dcRenderS :: Maybe Bool
_dcRenderS = forall a. a -> Maybe a
Just Bool
v
    }

{-|
Config options for checkerboard container which is used by
dragboard.
-}
checkerConfig :: [CheckerboardCfg] -> DragboardCfg s e a
checkerConfig :: forall s e a. [CheckerboardCfg] -> DragboardCfg s e a
checkerConfig [CheckerboardCfg]
config = forall a. Default a => a
def
    { _dcCheckerCfg :: [CheckerboardCfg]
_dcCheckerCfg = [CheckerboardCfg]
config
    }