{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-# OPTIONS -fallow-undecidable-instances #-}

module RESTng.System.Association where

import Database.HDBC (toSql)
import RESTng.RESTngMonad (RESTng, liftHDBC_0)
import RESTng.Database.SQL (restrictAttr)
import RESTng.Database.Record

import RESTng.System.Resource
import RESTng.System.RelationalResource
import RESTng.System.PersistableResource

class Resource a => AssocOneToMany a b where
  polyDiscriminatorName :: Proxy a -> Proxy b -> String
  polyDiscriminatorName _ _ = ""
  polyDiscriminator :: b -> Proxy a -> String
  --FIXME: this looks like depending only on the children type (not the parent)
  -- for instance, comments associated with different resources types. polyDiscriminator = resource_type

  -- if this String == "" means that it is not a polymorphic association
  findReferredBy :: b -> Proxy a -> RESTng (Maybe a)     -- b has the foreing key in one to many
  findReferringTo :: a -> Proxy b -> RESTng [b]
  referringQuery :: Proxy a -> Proxy b -> Integer -> [(String,String)] -- TODO: document this

  oneToManyFunctions ::   (
                           b -> Proxy a -> RESTng (Maybe a),    -- findReferredBy
                           a -> Proxy b -> RESTng [b],          -- findReferringTo
                           Proxy a -> Proxy b -> Integer -> [(String,String)]
                          )

  oneToManyFunctions = (findReferredBy, findReferringTo, referringQuery)
  findReferredBy =  fst3 oneToManyFunctions
  findReferringTo = snd3 oneToManyFunctions
  referringQuery = trd3 oneToManyFunctions

isPolimorphicAssociation :: AssocOneToMany a b => Proxy a -> Proxy b -> Bool
isPolimorphicAssociation pa pb = (not . null) $ polyDiscriminatorName pa pb

isAssociatedToType :: (Resource a, AssocOneToMany a b) => b -> Proxy a -> Bool
isAssociatedToType b pa = not (isPolimorphicAssociation pa pb) || (polyDiscriminator b pa == resourceType pa)
                          where pb = proxyOf b


----------------------------------------------------------------
-- helpers to create associations from RelationalOneToMany -----
----------------------------------------------------------------

oneToManyFromRelational ::  (AssocOneToMany a b, RelationalOneToMany a b, RelationalResource b) =>
                          (
                           b -> Proxy a -> RESTng (Maybe a),    -- findReferredBy
                           a -> Proxy b -> RESTng [b],          -- findReferringTo
                           Proxy a -> Proxy b -> Integer -> [(String,String)]
                          )

oneToManyFromRelational = (r_findReferredBy, r_findReferringTo, r_referringQuery)

r_findReferredBy :: (AssocOneToMany a b, RelationalOneToMany a b) => b -> Proxy a -> RESTng (Maybe a)     -- b has the foreing key in one to many
r_findReferredBy b pa = if (isAssociatedToType b pa)
                           then liftHDBC_0 $ dbSelectOne k pa
                           else return Nothing -- not of the correct type of children
                        where
                              k = (fkValue pa b)

r_findReferringTo :: (AssocOneToMany a b, RelationalOneToMany a b, RelationalResource b) => a -> Proxy b -> RESTng [b]
r_findReferringTo a pb = liftHDBC_0 $ runQueryN sqlRecordParser sqlCmd
                        where
                              sqlCmd = if (isPolimorphicAssociation pa pb)
                                         then restrictAttr (polyDiscriminatorName pa pb) (toSql (resourceType pa)) $ cmdSelectByFK
                                         else cmdSelectByFK

                              cmdSelectByFK = sqlSelectByFK a pb
                              pa = proxyOf a


r_referringQuery :: (AssocOneToMany a b, RelationalOneToMany a b, RelationalResource b) => Proxy a -> Proxy b -> Integer -> [(String,String)]
r_referringQuery pa pb ix = if (isPolimorphicAssociation pa pb)
                                                    then [(polyDiscriminatorName pa pb, resourceType pa), (fkName pa pb, show ix)]
                                                    else [(fkName pa pb, show ix)]

----------------------------------------------------------------
-- utility functions
----------------------------------------------------------------

fst3 (x,y,z) = x
snd3 (x,y,z) = y
trd3 (x,y,z) = z


{-
--------------------------------------------------------
-- associated predicate (for any two resources) --------
-- has to be tested on proxies -------------------------
--------------------------------------------------------

class AssocOneToManyP a b where
   isAssociated :: Proxy a -> Proxy b -> Bool
   isAssociated _ _ = True

instance AssocOneToManyP a b where isAssociated _ _ = False
--instance AssocOneToMany a b => AssocOneToManyP (Proxy a) (Proxy b) where isAssociated _ _ = True
-}