{-# LANGUAGE ExistentialQuantification, FlexibleContexts, FlexibleInstances, FunctionalDependencies
  , MultiParamTypeClasses, RankNTypes, TypeSynonymInstances #-}
{-# OPTIONS -Wall #-}

-- |Module to ease composing zero-to-many widgets to a larger
-- composite widget.
module Graphics.UI.WxGeneric.Composite
    ( -- * Composite type
      Composite, pickPanel, pickSuper, pickUser
    , compose, singleComposite
    -- * Mapping attributes
    , mapFromPanel, forAllChildren
    , mapFromSuper
    , mapFromUser
    -- * Mapping events
    , mapEventF, mapEventSuper, mapEventPanel
    -- * Other
    , ValuedWidget, widgetValue
    , updateSuper, updateUser
    )
where

import Graphics.UI.WX
import Graphics.UI.WXCore hiding (Event)
import Graphics.UI.XTC

-- What about Styled, Dockable, and Pictured classes?

-- |Data type which contains a composite widget
data Composite super user = forall w. 
    Composite { pickPanel :: Window w
              , pickSuper :: super
              , pickUser  :: user
              }

{- |Composes zero-to-many widgets to a larger composite widget

The composite will automatically implement the following classes:

* Widget

* Able

* Bordered

* Child

* Dimensions

* Identity

* Literate

* Visible

* Reactive (event class)

if the supertype implements one of the following classes, so will the
Composite:

* Items

* Observable

* Selection

* Selections

* Textual

* Commanding (event class)

* Selecting (event class)

* ValuedWidget

if the composite needs to implement more classes it should be done as
follows:

@
type MyComposite = Composite super user
 
instance Foo MyComposite where
   ...
@

-}

compose :: (Panel () -> IO (Layout, super, user))
        -> Window w -> [Prop (Composite super user)] -> IO (Composite super user)
compose f w props =
    do p <- panel w []
       (lay, super, user) <- f p
       set p [ layout := lay ]
       let composite = Composite p super user
       set composite props
       return composite

-- |Encapsulate a single 'Window w' in the composite type
singleComposite :: Window w -> super -> user -> Composite super user
singleComposite w = Composite w

-- |Used when an attribute should apply to the panel
mapFromPanel :: (forall w. Attr (Window w) attr) -> Attr (Composite super user) attr
mapFromPanel attr = newAttr (attrName attr) getter setter
    where getter (Composite wid _ _)   = get wid attr
          setter (Composite wid _ _) x = set wid [ attr := x ]

-- |Used when an attribute should apply to the panel and all of its
-- children
forAllChildren :: Attr (Window ()) attr -> (forall w. Attr (Window w) attr)
               -> Attr (Composite super user) attr
forAllChildren childAttr panelAttr = newAttr (attrName panelAttr) getter setter
    where getter (Composite wid _ _)     = get wid panelAttr
          setter (Composite wid _ _) val =
              do set wid [ panelAttr := val ]
                 xs <- get wid children
                 mapM_ (\x -> set x [ childAttr := val ]) xs


-- |Used when an attribute should apply to the "supertype"
mapFromSuper :: Attr super attr -> Attr (Composite super user) attr
mapFromSuper = mapAttrW pickSuper

-- |Used when an attribute should apply to the "usertype"
mapFromUser :: Attr user attr -> Attr (Composite super user) attr
mapFromUser = mapAttrW pickUser

-- *** Inherit from Panel ()
instance Widget (Composite super user) where
    widget (Composite w _ _) = widget w

instance Able (Composite super user) where
    enabled = mapFromPanel enabled

instance Bordered (Composite super user) where
    border = mapFromPanel border

instance Child (Composite super user) where
    parent = mapFromPanel parent

instance Colored (Composite super user) where
    bgcolor = forAllChildren bgcolor bgcolor
    color   = forAllChildren color color

-- Does this instance declaration make sense?
instance Dimensions (Composite super user) where
    outerSize   = mapFromPanel outerSize
    position    = mapFromPanel position
    area        = mapFromPanel area
    bestSize    = mapFromPanel bestSize
    clientSize  = mapFromPanel clientSize
    virtualSize = mapFromPanel virtualSize

instance Identity (Composite super user) where
    identity = mapFromPanel identity

instance Literate (Composite super user) where
    font          = forAllChildren font font
    fontSize      = forAllChildren fontSize fontSize
    fontWeight    = forAllChildren fontWeight fontWeight
    fontFamily    = forAllChildren fontFamily fontFamily
    fontShape     = forAllChildren fontShape fontShape
    fontFace      = forAllChildren fontFace fontFace
    fontUnderline = forAllChildren fontUnderline fontUnderline
    textColor     = forAllChildren textColor textColor
    textBgcolor   = forAllChildren textBgcolor textBgcolor

instance Visible (Composite super user) where
    visible = mapFromPanel visible
    refresh (Composite w _ _) = refresh w
    fullRepaintOnResize = mapFromPanel fullRepaintOnResize
    -- fullRepaintOnResize unfortunately do not make any sense,
    -- it must be set at creation time, but the panel has no
    -- attributes set at creation time :(

-- *** Inherit from super

instance Checkable super => Checkable (Composite super user) where
    checkable = mapFromSuper checkable
    checked   = mapFromSuper checked

instance Help super => Help (Composite super user) where
    help = mapFromSuper help

instance Observable super => Observable (Composite super user) where
    change = mapEventSuper change

instance Tipped super => Tipped (Composite super user) where
    tooltip = mapFromSuper tooltip

-- if we change String into just "a", then we also need the flag
-- -fallow-undecidable-instances, which we do not want to do.
instance Items super String => Items (Composite super user) String where
    itemCount      = mapFromSuper itemCount
    items          = mapFromSuper items
    item x         = mapFromSuper (item x)
    itemDelete w x = itemDelete  (pickSuper w) x
    itemsDelete w  = itemsDelete (pickSuper w)
    itemAppend w x = itemAppend  (pickSuper w) x

instance Selection super => Selection (Composite super user) where
    selection = mapFromSuper selection

instance Selections super => Selections (Composite super user) where
    selections = mapFromSuper selections

instance Textual super => Textual (Composite super user) where
    text = mapFromSuper text

-- We need to use (super a) to make this instance decidable
instance ValuedWidget a (super a) => ValuedWidget a (Composite (super a) user) where
    widgetValue = mapFromSuper widgetValue

-- *** Events

-- | Mapping events from supertype
mapEventSuper :: Event super event -> Event (Composite super user) event
mapEventSuper event = mapEventF pickSuper event

-- | Mapping events from the Panel ()
mapEventPanel :: (forall w. Event (Window w) event) -> Event (Composite super user) event
mapEventPanel event = newEvent "" getter setter where
    getter (Composite w _ _)     = get w (on event)
    setter (Composite w _ _) val = set w [ on event := val ]

-- | Mapping events using a mapper function
mapEventF :: (to -> from) -> Event from event -> Event to event
mapEventF f event = newEvent "" getter setter where
    getter w     = get (f w) (on event)
    setter w val = set (f w) [ on event := val ]
           

instance Selecting super => Selecting (Composite super user) where
    select = mapEventSuper select

instance Commanding super => Commanding (Composite super user) where
    command = mapEventSuper command

instance Reactive (Composite super user) where
    mouse    = mapEventPanel mouse
    keyboard = mapEventPanel keyboard
    closing  = mapEventPanel closing
    idle     = mapEventPanel idle
    resize   = mapEventPanel resize
    focus    = mapEventPanel focus
    activate = mapEventPanel activate

-- We should also do Paint

-- Should properly rename ValuedWidget to Valued, but there is already
-- a type class called Valued in WxHaskell. However, WxHaskell's
-- definition do not really work for widgets. It only seems to work
-- for Var-s.
class ValuedWidget x w | w -> x where
    widgetValue :: Attr w x


-- GHC error message: 
-- Record update for the non-Haskell-98 data type `Composite' is not (yet) supported
-- Use pattern-matching instead
--
-- Thus we avoid pattern matching here.
updateSuper :: (super -> super') -> Composite super user -> Composite super' user
updateSuper f (Composite panel' super user) = Composite panel' (f super) user

-- GHC error message: 
-- Record update for the non-Haskell-98 data type `Composite' is not (yet) supported
-- Use pattern-matching instead
--
-- Thus we avoid pattern matching here.
updateUser :: (user -> user') -> Composite super user -> Composite super user'
updateUser f (Composite panel' super user) = Composite panel' super (f user)