{-# LANGUAGE ExistentialQuantification #-}

module RESTng.System.Component where

import Prelude hiding(span, div)
import Data.Maybe (catMaybes)
import Text.CxML
import Text.YuiGrid
import RESTng.RESTngMonad (RESTng)

import RESTng.RqHandlers (RequestContext, addHierarchicalCollToResAddr, setCollectionFromRootAddr)
import RESTng.System.Resource (Resource, Proxy, proxyOf, resourceType, key)
import RESTng.System.Association (AssocOneToMany, findReferringTo, findReferredBy, referringQuery, isAssociatedToType)
import RESTng.System.WebResource (InGridResource, listView, showShortURLHtml)
import RESTng.System.Annotation


childComponent:: (AssocOneToMany a b, Resource b, InGridResource b) => Proxy b -> Annotation a
childComponent pChild
         = defaultAnnotation {
                              annotationName = resourceType pChild,
                              whenShowingElement = showChildElements pChild,
                              whenEditingElement = showChildElements pChild,
                              whenListingElement = showChildElements pChild
                             }

showChildElements :: (AssocOneToMany a b, Resource b, InGridResource b) => Proxy b -> a -> RESTng (CxML RequestContext)
showChildElements pChild res
               = do childElems <- findReferringTo res pChild
                    return ( div /- [t $ resourceType pChild ++ "s:"] +++
                             inChildContext ( (concatCxML . map fromGridNode . listView . withoutAnnotations) childElems)
                           )
                 where
                    inChildContext = modCx (addHierarchicalCollToResAddr (resourceType pChild) restQuery)
                    restQuery = referringQuery (proxyOf res) pChild (key res)

                    withoutAnnotations :: [a] -> [(a,[b])]
                    withoutAnnotations = map (\r->(r,[]))


referredThroughJoinComponent :: (AssocOneToMany a b, AssocOneToMany c b, Resource b, InGridResource c) =>
                                Proxy c -> Proxy b -> Annotation a
referredThroughJoinComponent pReferred pJoin
         = defaultAnnotation {
                              annotationName = resourceType pReferred,
                              whenShowingElement = showReferredThroughJoinElements pReferred pJoin,
                              whenEditingElement = showReferredThroughJoinElements pReferred pJoin,
                              whenListingElement = showReferredThroughJoinElements pReferred pJoin
                             }

showReferredThroughJoinElements :: (AssocOneToMany a b, AssocOneToMany c b, Resource b, InGridResource c) =>
                                   Proxy c -> Proxy b -> a -> RESTng (CxML RequestContext)
showReferredThroughJoinElements pReferred pJoin res
               = do joinElems <- findReferringTo res pJoin
                    referredElems <- (sequence $ map (`findReferredBy` pReferred) joinElems) >>= return . catMaybes
                    return ( span /- [t $ resourceType pReferred ++ "s:"] +++
                             inReferredContext ((concatCxML . map fromGridNode . listView . withoutAnnotations ) referredElems)
                           )
                 where
                    inReferredContext = modCx (setCollectionFromRootAddr $ resourceType pReferred)

                    withoutAnnotations :: [a] -> [(a,[b])]
                    withoutAnnotations = map (\r->(r,[]))

--FIXME: remove duplicates with nub? would add an Eq contraint over c




parentComponent:: (AssocOneToMany a b, InGridResource a) => Proxy a -> Annotation b
parentComponent pParent
         = setInFstSibling $ defaultAnnotation {
                              annotationName = resourceType pParent,
                              whenShowingElement = showParent pParent,
                              whenEditingElement = showParent pParent,
                              whenListingElement = showParent pParent
                             }

showParent :: (AssocOneToMany a b, InGridResource a) => Proxy a -> b -> RESTng (CxML RequestContext)
showParent pParent res
               = do maybeParent <- findReferredBy res pParent
                    return ( (span /- [t $ resourceType pParent ++ ":"]) +++
                             (span /- [parentCxML maybeParent]) +++ br
                           )
                 where
                    parentCxML maybeParent =
                             case maybeParent of
                               Nothing -> t ""
                               Just parentRes -> showShortURLHtml parentRes


data ParentBox b = forall a . (AssocOneToMany a b, InGridResource a) => ParentBox (Proxy a)

parentListComponent:: [ParentBox b] -> Annotation b
parentListComponent pParentList
         = setInFstSibling $ defaultAnnotation {
                              annotationName = "Parent",
                              whenShowingElement = showParentFromList pParentList,
                              whenEditingElement = showParentFromList pParentList,
                              whenListingElement = showParentFromList pParentList
                             }

showParentFromList :: [ParentBox b] -> b -> RESTng (CxML RequestContext)
showParentFromList [] res = return $ t ""
showParentFromList (ParentBox pParent: pParentList) res
              = if res `isAssociatedToType` pParent
                   then showParent pParent res
                   else showParentFromList pParentList res