------------------------------------------------------------------------------
--- This module provides a transformation on ERD terms that eliminates
--- the original relationships by introducing new entities for complex
--- relationships and inserting foreign keys for simple relationships.
------------------------------------------------------------------------------

{-# OPTIONS_CYMAKE -Wno-incomplete-patterns #-}

module Database.ERD.Transformation ( transform )
 where

import Database.ERD 
import Database.ERD.Goodies

---------------------------------------------------
-- The main transformation which adds
-- - artificial keys of type Int for all entities (not null)
--   user defined keys -> unique
-- - foreign keys for 1:1 and 1:n relationships
-- - new entities and relationships for n:m relationships (delete old relationship) 

transform :: ERD -> ERD
transform (ERD name entities relationships) = 
  let (es,rs) = transformRel (map addKey entities,[]) relationships 
  in ERD name es rs
   
-- Adds a new artificial primary key to an entity
addKey :: Entity -> Entity  
addKey (Entity en attrs) =
  Entity en ((Attribute ("Key") (IntDom Nothing) PKey False) 
             : (map deleteKey attrs))
 where
  -- set user-defined primary keys to "Unique"
  deleteKey :: Attribute -> Attribute
  deleteKey a@(Attribute an d k null)
    | k == PKey = Attribute an d Unique null
    | otherwise = a


transformRel :: ([Entity], [Relationship]) -> [Relationship]
             -> ([Entity], [Relationship])
transformRel (ens,rels) [] = (ens,rels)
transformRel (ens,rels) (r@(Relationship _ [(REnd e1 _ c1), (REnd e2 _ c2)]) : rs) = case c1 of
  (Exactly i1)         -> case c2 of 
    (Exactly _)           -> error "2 minima" --error in XML2ERD
    (Between _ Infinite)  -> transformRel (eRN i1 e1 e2 (ens, rels) r) rs
    (Between i2 (Max i3)) -> transformRel (eRJ i1 i2 i3 e1 e2 (ens, rels) r) rs
    
  (Between i1 Infinite)   -> case c2 of 
    (Exactly i2)          -> transformRel (eRN i2 e2 e1 (ens, rels) r) rs
    (Between _ Infinite)  -> transformRel (rNRN ens rels r) rs
    (Between i2 (Max i3)) -> transformRel (rNRJ i1 i2 i3 e1 e2 ens rels r) rs

  (Between i1 (Max i2)) -> case c2 of 
    (Exactly i3)          -> transformRel (eRJ i3 i1 i2 e2 e1 (ens, rels) r) rs 
    (Between i3 Infinite) -> transformRel (rNRJ i3 i1 i2 e1 e2 ens rels r) rs
    (Between i3 (Max i4)) -> transformRel (rJRJ i1 i2 i3 i4 e1 e2 ens rels r) rs


eRN :: Int -> String -> String -> ([Entity],[Relationship]) -> Relationship 
    -> ([Entity],[Relationship])
eRN i1 e1 e2 (ens,rels) r@(Relationship rname _) 
  | i1==1 = (addFKey e1 e2 rname False False ens ens, (r:rels)) --(1,1):(0,n)
  | otherwise = let (r1,e,r2) = addExtraEntity r ens            --(i,i):(0,n)
                in 
                (e:ens, r1:r2:rels)

eRJ :: Int -> Int -> Int -> String -> String -> ([Entity],[Relationship]) -> Relationship 
    -> ([Entity],[Relationship])
eRJ i1 _ i3 e1 e2 (ens, rels) r@(Relationship rname _)
  | i1==1 = (addFKey e1 e2 rname False (i3==1) ens ens, (r:rels))       --(1,1):(0,j)
  | otherwise = if i3==1   
                then (addFKey e2 e1 rname True False ens ens, (r:rels)) --(i,i):(0,1) 
                else let (r1,e,r2) = addExtraEntity r ens               --(i,i):(0,j)
                     in 
                     (e:ens, r1:r2:rels)                                       

rNRN :: [Entity] -> [Relationship] -> Relationship -> ([Entity],[Relationship])
rNRN ens rels r =
  let (r1,e,r2) = addExtraEntity r ens
  in
  (e:ens, r1:r2:rels)

rNRJ :: a -> Int -> Int -> String -> String -> [Entity]
     -> [Relationship] -> Relationship -> ([Entity], [Relationship])
rNRJ _ i2 i3 e1 e2 ens rels r@(Relationship rname _)  
  | i2==0 && i3==1 = (addFKey e1 e2 rname True False ens ens, (r:rels)) --(_,n):(0,1)
  | otherwise = let (r1,e,r2) = addExtraEntity r ens                    --(_,n):(_,i)
                in 
                (e:ens, r1:r2:rels) 

rJRJ :: Int -> Int -> a -> Int -> String -> String -> [Entity]
     -> [Relationship] -> Relationship -> ([Entity], [Relationship])
rJRJ i1 i2 _ i4 e1 e2 ens rels r@(Relationship rname _) 
  | i1==0 && i2==1 = (addFKey e1 e2 rname True (i4==1) ens ens, (r:rels)) --(0,1):(0,1)/(0,1):(_,j)
  | otherwise = let (r1,e,r2) = addExtraEntity r ens                      --(_,i):(_,j)
                in 
                (e:ens, r1:r2:rels) 


addFKey :: String -> String -> String -> Bool -> Bool -> [Entity] -> [Entity]
        -> [Entity]
addFKey _ _ _ _ _ [] ens = ens
addFKey e1 e2 rname null unique (e@(Entity n (a:attrs)) : ens) ens'
  | e2 == n = 
     let aname = attributeName (getKeyAttribute e1 ens')   
     in 
     (Entity n
             (a:attrs++[Attribute (fKeyName e1 rname aname) (KeyDom e1) 
                                  (if unique then Unique else NoKey) null]))
      : ens 
  | otherwise = e : addFKey e1 e2 rname null unique ens ens' 


--foreign key for extra entity
addFKey' :: String -> String -> Bool -> Entity -> [Entity] -> Entity
addFKey' ename rname null (Entity n attrs) es = ensureUniqueAttributeNames $
 Entity n 
        ((Attribute (fKeyName ename rname
                              (attributeName (getKeyAttribute ename es))) 
                    (KeyDom ename) PKey null) : attrs)

getKeyAttribute :: String -> [Entity] -> Attribute
getKeyAttribute ename ((Entity n attrs) : ens) 
  | ename == n = getKey attrs
  | otherwise = getKeyAttribute ename ens
getKey :: [Attribute] -> Attribute
getKey (a@(Attribute _ _ k _):attrs)
  | PKey == k = a
  | otherwise = getKey attrs  

-- e1   -   e2
-- e1 - R - e2
addExtraEntity :: Relationship -> [Entity]
                  -> (Relationship, Entity, Relationship)
addExtraEntity (Relationship r [(REnd e1 r1 c1), (REnd e2 r2 c2)]) es =
  (Relationship "" [(REnd e1 "" (Exactly 1)), (REnd r r2 c2)],
   addFKey' e1 r False (addFKey' e2 r False (Entity r []) es) es,
   Relationship "" [(REnd e2 "" (Exactly 1)), (REnd r r1 c1)])

-- create a name for a foreign key for a given entity, relationship,
-- and key attribute name.
fKeyName :: String -> String -> String -> String
fKeyName ename rname kname = combineIds [ename,rname,kname]

-- add an index to the name of an attribute if it occurs twice
-- (possible in case of generated entities)
ensureUniqueAttributeNames :: Entity -> Entity
ensureUniqueAttributeNames (Entity ename attrs) =
  Entity ename (uniqueNames [] attrs)

uniqueNames :: [Attribute] -> [Attribute] -> [Attribute]
uniqueNames oldattrs [] = reverse oldattrs
uniqueNames oldattrs (attr@(Attribute aname dom key nll) : attrs) =
  if aname `elem` names
  then uniqueNames (Attribute (makeUnique 1 aname) dom key nll : oldattrs) attrs
  else uniqueNames (attr:oldattrs) attrs
 where
  names = map attributeName (oldattrs++attrs)

  makeUnique i name = let newname = name++show i in
    if newname `elem` names then makeUnique (i+1) name else newname