module RESTng.System.Annotation where

import Control.Monad (liftM2)

import Text.CxML (CxML, (+++), t, noElem)
import Text.YuiGrid (GridElement, boxInMain, HasLayoutHints, modLayoutHints)

import Network.HTTP.RedHandler (RequestContext)
import RESTng.RESTngMonad (RESTng)
import RESTng.System.Resource(Resource, Proxy)

data Annotation a = Annotation {
                                annotationName :: String,

                                whenShowingElement :: a -> RESTng (CxML RequestContext),
                                whenShowingElementLayout :: CxML RequestContext -> GridElement RequestContext,

                                whenEditingElement :: a -> RESTng (CxML RequestContext),
                                whenEditingElementLayout :: CxML RequestContext -> GridElement RequestContext,

                                whenCreatingElement :: Proxy a -> RESTng (CxML RequestContext),
                                whenCreatingElementLayout :: CxML RequestContext -> GridElement RequestContext,

                                whenListingElement :: a -> RESTng (CxML RequestContext),
                                whenListingElementLayout :: CxML RequestContext -> GridElement RequestContext
                               }

whenShowingElementAnn :: Annotation a -> a -> RESTng (String, GridElement RequestContext)
whenShowingElementAnn ann res = whenShowingElement ann res >>= \cxml -> return (annotationName ann, whenShowingElementLayout ann cxml)

whenEditingElementAnn :: Annotation a -> a -> RESTng (String, GridElement RequestContext)
whenEditingElementAnn ann res = whenEditingElement ann res >>= \cxml -> return (annotationName ann, whenEditingElementLayout ann cxml)

whenCreatingElementAnn :: Annotation a -> Proxy a -> RESTng (String, GridElement RequestContext)
whenCreatingElementAnn ann pres = whenCreatingElement ann pres >>= \cxml -> return (annotationName ann, whenCreatingElementLayout ann cxml)

whenListingElementAnn :: Annotation a -> a -> RESTng (String, GridElement RequestContext)
whenListingElementAnn ann res = whenListingElement ann res >>= \cxml -> return (annotationName ann, whenListingElementLayout ann cxml)


defaultAnnotation = Annotation {
                                annotationName = "",

                                whenShowingElement = blankAnnFunction,
                                whenShowingElementLayout = boxInMain,

                                whenEditingElement = blankAnnFunction,
                                whenEditingElementLayout = boxInMain,

                                whenCreatingElement = blankAnnFunction,
                                whenCreatingElementLayout = boxInMain,

                                whenListingElement = blankAnnFunction,
                                whenListingElementLayout = boxInMain
                               }

blankAnnFunction :: b -> RESTng (CxML RequestContext)
blankAnnFunction _ = return noElem

dummyStringAnnotation str
          = defaultAnnotation { 
                               whenShowingElement = dummyStringAnnFunction str,
                               whenEditingElement = dummyStringAnnFunction str,
                               whenCreatingElement = dummyStringAnnFunction str,
                               whenListingElement = dummyStringAnnFunction str
                              }

dummyStringAnnFunction str _ = return $ t str

absorveAnn :: Annotation a -> Annotation a -> Annotation a
ann1 `absorveAnn` ann2 = ann1 { 
                               whenShowingElement = \res -> liftM2 (+++) (whenShowingElement ann1 res) (whenShowingElement ann2 res),
                               whenEditingElement = \res -> liftM2 (+++) (whenEditingElement ann1 res) (whenEditingElement ann2 res),
                               whenCreatingElement = \res -> liftM2 (+++) (whenCreatingElement ann1 res) (whenCreatingElement ann2 res),
                               whenListingElement = \res -> liftM2 (+++) (whenListingElement ann1 res) (whenListingElement ann2 res)
                              }

class Resource a => AnnotatedResource a where
   annotations :: [Annotation a]
   annotations = []

instance HasLayoutHints (Annotation a) where
  --modLayoutHints :: (LayoutHints -> LayoutHints) -> Annotation a -> Annotation a
  modLayoutHints f ann = ann {
                               whenShowingElementLayout  = f' . whenShowingElementLayout ann,
                               whenEditingElementLayout  = f' . whenEditingElementLayout ann,
                               whenCreatingElementLayout = f' . whenCreatingElementLayout ann,
                               whenListingElementLayout  = f' . whenListingElementLayout ann
                             }
                         where f' = modLayoutHints f