module N3Unify where
import "Observe"
import "TripleData"
import "Utils"
import "UnifIn"
import "TripleApi"
import "Subgraphs"

-- Author: G.Naudts. Mail: naudts_vannoten@yahoo.com.


-- data Triple = Triple (Subject, Predicate, Object) | Rule Rule | TripleNil
--   deriving (Show, Eq)

-- type Subject = Resource
-- type Predicate = Resource
-- type Object = Resource

-- data Resource = URI String | Literal String | TripleSet TripleSet |
--                Var Vare | ResNil 
--                deriving (Show,Eq)

-- type TripleSet = [Triple]

-- data Vare = UVar String | EVar String | GVar String | GEVar String
--           deriving (Show,Eq)

-- type DB = [TripleSet]
-- type Query = [TripleSet]
 
-- rules are numbered. This is done for the anti-looping mechanism . 
-- type Rule= (Antecedents, Consequent, Int)
-- type Antecedents = TripleSet
-- type Consequent = TripleSet

-- type Substitution = (Vare, Resource)
-- type SubstitutionList = [Substitution]
-- type Solution = [SubstitutionList]

-- type Alternatives = [(TripleSet, SubstitutionList)]

applySubstitutionListToDB :: [Substitution] -> DB -> DB
applySubstitutionListToDB sl db = (map
                             (applySubstitutionListToTripleSet sl) db)

applySubstitutionToTriple :: Substitution -> Triple -> Triple 
applySubstitutionToTriple subst (Triple (subject, predicate, object)) = 
     Triple (applySubstitutionToResource subst subject,
             applySubstitutionToResource subst predicate,
             applySubstitutionToResource subst object)
applySubstitutionToTriple subst (Rule(antecedents, consequent, i)) =
                    Rule (applySubstitutionToTripleSet subst antecedents,
                          applySubstitutionToTripleSet subst consequent, i)
applySubstitutionToTriple subst TripleNil = TripleNil

applySubstitutionListToTriple :: [Substitution] -> Triple -> Triple
applySubstitutionListToTriple sl t = foldl
                      (flip applySubstitutionToTriple) t sl

applySubstitutionToTripleSet :: Substitution -> TripleSet -> TripleSet
applySubstitutionToTripleSet subst ts = map
                    (applySubstitutionToTriple subst) ts

applySubstitutionListToTripleSet :: [Substitution] -> TripleSet -> TripleSet
applySubstitutionListToTripleSet sl ts = map
                    (applySubstitutionListToTriple sl) ts

applySubstitutionToResource :: Substitution -> Resource -> Resource
applySubstitutionToResource subst (TripleSet tripleset) =
          TripleSet (applySubstitutionToTripleSet subst tripleset)
applySubstitutionToResource (t1, t2) (Var v) 
        | v == t1 = t2
        | otherwise = Var v
applySubstitutionToResource s t = t

unifyTripleSets :: TripleSet -> TripleSet -> (Bool, Alternatives)
unifyTripleSets [] _ = (False, [])
unifyTripleSets ts1 ts2 
    -- all triples from the first set must match so alts1 and
    -- alts2 may not be empty.

    -- two rules do not match
    |bv1 && bv2 = (False, [])
    -- rules are treated separately
    |bv2 && bv3 = (True, alt)
    |bv1 && bv4 = (True, alts1)
    |bv1 || bv2 = (False, [])
    -- unify two triplesets that are not rules
    |bool = (True, alts)
    |otherwise = (False, [])
    where alts = unifyNoRule ts1 ts2
          bool = (not (alts == []))
          bv1 = checkRule ts1
          bv2 = checkRule ts2
          checkRule [] = False
          checkRule (x:xs)
             |testRule x = True
             |otherwise = False
          testRule (Rule r) = True
          testRule t = False
          (bv3,alt) = (unifyTripleSetWithRule (ts1, ts2))
          (bv4,alts1) = unifyRuleWithTripleSet (ts1, ts2)

-- unify two triplesets where none contains a rule
unifyNoRule :: TripleSet -> TripleSet -> Alternatives
unifyNoRule [] _ = []
unifyNoRule _ [] = []
unifyNoRule ts1 ts2
   = alts
   where alts = [((applySubstitutionListToTripleSet a ts1)
                                 ,a)|a <- sll]
         sll = solve ts1 ts2 [] []
         solve []     ts2 stack substList
            = (substList:backtrack ts2 stack)
         solve (t:ts) ts2 stack substList
            |alts == [] = choose [] ts ts2 stack substList
            |otherwise = choose sll (ts) ts2 stack substList
            where triple = applySubstitutionListToTriple substList t
                  res = unifyTripleWithTripleSet triple ts2
                  sll = [sls|(_, sls) <- alts]
                  (bool,alts) = res
         choose []  ts ts2 stack substList = backtrack ts2 stack 
         choose (sl:sll) [] ts2 stack substList
            = solve [] ts2 stack1 substList1
            where substList1 = substList ++ sl
                  stack1 = ([], sll, substList):stack
         choose (sl:sll) ts ts2 stack substList
            = solve ts ts2 stack1 substList1
            where substList1 = substList ++ sl
                  stack1 = (ts, sll, substList):stack

         backtrack ts2 [] = [] 
         backtrack ts2 ((ts,sll, sl):st) 
            = choose sll ts ts2 st sl



-- unify two triplesets where the second are consequents
-- here not all triples from the first tripleset must match
unifyWithRule :: TripleSet -> TripleSet -> Alternatives
unifyWithRule [] _ = []
unifyWithRule _ [] = []
unifyWithRule ts1 ts2
   |sll == [] = []
   |otherwise =  alts
   where alts = [((applySubstitutionListToTripleSet a ts2)
                                 ,a)|a <- sll]
         sll = (eliminateEmptiesL(solve ts1 ts2 [] []))
         solve []     ts2 stack substList
            = (substList:backtrack ts2 stack)
         solve (t:ts) ts2 stack substList
            -- only following rule is different with unifyNoRule
            |alts == [] = solve ts ts2 stack substList  
            |otherwise = choose sll (ts) ts2 stack substList
            where triple = applySubstitutionListToTriple substList t
                  res = unifyTripleWithTripleSet triple ts2
                  sll = [sls|(_, sls) <- alts]
                  (bool,alts) = res
         choose []  ts ts2 stack substList = backtrack ts2 stack 
         choose (sl:sll) [] ts2 stack substList
            = solve [] ts2 stack1 substList1
            where substList1 = substList ++ sl
                  stack1 = ([], sll, substList):stack
         choose (sl:sll) ts ts2 stack substList
            = solve ts ts2 stack1 substList1
            where substList1 = substList ++ sl
                  stack1 = (ts, sll, substList):stack

         backtrack ts2 [] = [] 
         backtrack ts2 ((ts,sll, sl):st) 
            = choose sll ts ts2 st sl


type Alternative = (TripleSet, SubstitutionList)

unifyTripleSetWithRule :: (TripleSet, TripleSet) ->
                          (Bool, Alternatives)
unifyTripleSetWithRule (ts1, (x:xs))
   |bv1 = (False,[])
   |otherwise = (not bv1, new1)
   where Rule (ants, con, _) = x
         -- divide into connected subgraphs
         db2 = (subgraphDB [con] (-1) )
--         db1 = (subgraphDB [ts1] (-1))
         -- cross match the subgraphs
         unif = [(ts3,unifyWithRule ts1 ts2)| ts2 <- db2]
         -- select the subgraphs that did not match
         rest = (concat [ts| (ts, alts) <- unif, alts == []])
         -- select those that did match 
         new = [ (ts,alts2)| (ts, alts2) <-  unif, alts2 /= []]
         -- put the antecedents as alternatives; take the rest of the
         -- tripleset as alternative
         new1 = concat [genRuleAlts ts4 alts1 |(ts4,alts1) <- new]
         bv1 = new == []
        -- the alternatives generated by a rule are the antecedents of the rule.
         -- the triples that did not match with the rule must be returned too.
         genRuleAlts ts [] = []
         genRuleAlts ts (x:xs) 
            = [(ts2 ++ rest ,[]),(ants, sl)] ++ genRuleAlts ts xs 
            where (ts1,sl) = x
                  ts2 = (getComplement ts ts1)

-- subtract the second tripleset from the first
getComplement :: TripleSet -> TripleSet -> TripleSet
getComplement [] ts2 = []
getComplement ts1 [] = ts1
getComplement ts1 ts2
   | bv1 = [TripleNil]
   | bv2 = [TripleNil]
   | otherwise = ts3
   where bv1 = length ts2 >= length ts1
         ts3 = [t|t <-ts1, not (t `inVars` ts2)]
         bv2 = ts3 == []
         inVars t [] = False
         inVars t (x:xs)
            | bv1 = True
            | otherwise = inVars t xs
            where (bv1,_) = unifyTriples t x

unifyRuleWithTripleSet :: (TripleSet, TripleSet) ->
                          (Bool, Alternatives)
unifyRuleWithTripleSet ( _, []) = (False, [])
unifyRuleWithTripleSet ( [], _) = (False, [])
unifyRuleWithTripleSet ((x:xs), ts)
   = (bv1, alts2)
   where alts1 = unifyNoRule con ts
         bv1 = alts1 == []
         alts2 = [(ants,sl)|(ts1,sl) <- alts1]
         Rule (ants, con, _) = x


unifyTripleWithTripleSet :: Triple -> TripleSet -> (Bool, Alternatives)
unifyTripleWithTripleSet t [] = (True, [])
unifyTripleWithTripleSet t ts
    |bool1 && bool2 = (True, alts1)
    |bool1 = (False,[])
    |bool = (True, alts)
    |otherwise = (False, [])
    where results = [unifyTriples t x|x <- ts]
          bool = any (== True) [x|(x, _) <- results]
          alts = concat [x|(y, x) <- results, y == True]
          (bool1, (bool2,alts1)) = tripleApi t

-- type Alternatives = [(TripleSet, SubstitutionList)]

unifyTriples :: Triple -> Triple -> (Bool, Alternatives)
unifyTriples (Triple t1) (Triple t2)
        | bool1 && bool2 && bool3 = (True,[([t4], subst1 ++ subst2 ++ subst3)])
        | otherwise = (False, [([t4], [])])
        where (bool1, subst1) = unifyResources subject1 subject2
              (bool2, subst2) = unifyResources predicate1 predicate2
              (bool3, subst3) = unifyResources object1a object2 
              Triple(subject1, predicate1, object1) = t3
              Triple(subject2, predicate2, object2) = t4
              (t3, t4) = unifIn (Triple t1, Triple t2)
              object1a = appSubst object1 subst1
              appSubst object1 [] = object1
              appSubst object1 (su:sus) = applySubstitutionToResource su object1
unifyTriples  triple (Rule rule)
                = unifyTripleSetWithRule ([triple], [Rule rule])
unifyTriples (Rule rule) triple
                = unifyRuleWithTripleSet ([triple], [Rule rule])
unifyTriples t1 t2 = (False, [([triple2], [])])

-- type Alternatives = [(TripleSet, SubstitutionList)]

unifyResources :: Resource -> Resource -> (Bool, SubstitutionList)
unifyResources (Var v1) (Var v2)
    |v1 == v2  = (True, [])
    |otherwise = (True, [(v1, Var v2)])
    where checkAnon (EVar s) = containsString "$$$" s
          checkAnon s = False
unifyResources (Var v1) r
    |varCheck (Var v1) r = (False, [(v1, r)])
    |otherwise = (True, [(v1, r)])
unifyResources r (Var v1) 
    |varCheck (Var v1) r = (False, [(v1, r)])
    |otherwise = (True, [(v1, r)])
unifyResources (TripleSet t1) (TripleSet t2) =
                         unifyTerms t1 t2
unifyResources resource1 resource2 
    |compareResources resource1 resource2 = (True, [])
    |otherwise = (False, [])

compareResources (URI s1) (URI s2) = -- error (show r1 ++ show r2)
   (r1 == r2)
   where (bool1, _, r1) = parseUntil ' ' s1
         (bool2, _, r2) = parseUntil ' ' s2
compareResources r1 r2 = r1 == r2

varCheck :: Resource -> Resource -> Bool
varCheck (Var v) (TripleSet []) = False
varCheck (Var v) (TripleSet (Triple(s, p, o):xs))
    |(Var v) == s || (Var v) == p || (Var v) == o = True  
    |otherwise = varCheck (Var v) (TripleSet xs)
varCheck (Var v) (TripleSet (Rule (ants,con, _):xs))
    = (varCheck (Var v) (TripleSet ants)) ||
                            (varCheck (Var v) (TripleSet con))
varCheck (Var v) r = False

unifyTerms :: TripleSet -> TripleSet -> (Bool, SubstitutionList)
unifyTerms [] t = (False, [])
unifyTerms t [] = (False, [])
unifyTerms t1 t2 = (bool, getSubstList alts)
        where (bool, alts) = unifyTripleSets t1 t2

getSubstList :: Alternatives -> SubstitutionList
getSubstList [] = []
getSubstList (x:xs) = substL ++ getSubstList xs
    where (_, substL) = x

checkGrounded :: [TripleSet] -> [TripleSet]
checkGrounded [] = []
checkGrounded (x:xs)
   |x == [] = checkGrounded xs
   |ts == [] = checkGrounded xs
   |otherwise = ts:checkGrounded xs
   where ts = checkTripleSet x

checkTripleSet [] = []
checkTripleSet (x:xs)
   |bv1 = checkTripleSet xs
   |otherwise = x:checkTripleSet xs
   where bv1 = (checkTriple x) == TripleNil

checkTriple t@(Triple(subject, predicate, object))
   |bv1 && bv2 && bv3 = TripleNil
   |otherwise = Triple(subject1, predicate1, object1)
   where bv1 = checkAtom subject
         bv2 = checkAtom predicate
         bv3 = checkAtom object
         checkAtom (URI s) = True
         checkAtom (Literal s) = True
         checkAtom ResNil = True
         checkAtom (TripleSet ts) = (checkTripleSet ts ) == []
         checkAtom (Var (EVar s))
            |containsString "T$$$" s = True
            |otherwise = False
         checkAtom any = False
         subject1 = checkSet subject
         predicate1 = checkSet predicate1
         object1 = checkSet object1
         checkSet (TripleSet ts) = TripleSet (checkTripleSet ts)
         checkSet r = r
checkTriple t = t

-- compare two trees; strip the level indication of the vars
-- compareTreesVars :: TripleSet -> TripleSet -> Bool
compareTreesVars ts1 ts2
   |not bv1 = False
   |otherwise = compareTreesVarsH ts1 ts2
   where bv1 = (length ts1 == length ts2)
         compareTreesVarsH [] _ = True
         compareTreesVarsH (x:xs) ts2 =
            compareTreeVars x ts2 && compareTreesVarsH xs ts2
           where compareTreeVars _ [] = False
                 compareTreeVars TripleNil _ = False
                 compareTreeVars t (y:ys) = compareTriplesVars t y ||
                                   compareTreeVars t ys

compareTriplesVars :: Triple -> Triple -> Bool
compareTriplesVars (Rule (ants1, con1, _)) (Rule (ants2, con2, _)) =
    compareTreesVars ants1 ants2 && compareTreesVars con1 con2
compareTriplesVars (Rule (ants, con, _)) t@(Triple (s1, p1, o1)) =
    compareTripleVars ants t
compareTriplesVars t@(Triple (s1, p1, o1)) (Rule (ants, con, _)) =
    compareTripleVars ants t
compareTriplesVars (Triple (s1, p1, o1)) (Triple (s2, p2, o2)) =
    compareResourcesVars s1 s2 && compareResourcesVars p1 p2
       && compareResourcesVars o1 o2
compareTriplesVars t1 t2 = False

compareTripleVars [] t = False
compareTripleVars (x:xs) t
    |compareTriplesVars x t = True
    |otherwise = compareTripleVars xs t

compareResourcesVars (Var v1) (Var v2)
    | bv1 && bv2 = True
    | s1 == s2 = True
    | otherwise = False
    where testAnon (Var (EVar s))
            | containsString "T$$$" s = True
            | otherwise = False
          testAnon (Var v) = False
          bv1 = testAnon (Var v1)
          bv2 = testAnon (Var v2)
          getStringPart (UVar s) = third (parseUntilString s "$_$")
          getStringPart (EVar s) = third (parseUntilString s "$_$")
          getStringPart (GVar s) = third (parseUntilString s "$_$")
          getStringPart (GEVar s) = third (parseUntilString s "$_$")
          third (_, _, x) = x
          s1 = (getStringPart v1)
          s2 = (getStringPart v2)
compareResourcesVars r1 r2 = r1 == r2