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

-- 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 = Triple

-- 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,
                          applySubstitutionToTriple 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 && (not bv3) = (False, [])
    |bv2 && (not bv4) = (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 (False, 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


type Alternative = (TripleSet, SubstitutionList)

unifyTripleSetWithRule :: (TripleSet, TripleSet, Alternatives) ->
                          (Bool, Alternatives)
unifyTripleSetWithRule ( ts1, ts2, alts)
   = (bool1, alts1)
   where (bool1, _, _, alts1, _) = 
                 unifyTripleSetWithRule1 (False, ts1, ts2, alts, [])
         unifyTripleSetWithRule1 (bool, [], _, alts, _)
                        = (bool, [], [], alts, [])
         unifyTripleSetWithRule1 (bool, (x:xs), (y:yx), alts, rest)
            |bv1 && bv2 = unifyTripleSetWithRule1
                    (True, xs, (y:yx),([TripleNil], []):(ants, sl):alts,x:rest)
            |bv1 =  unifyTripleSetWithRule1
                    (True, xs, (y:yx),(rest ++ xs, []):(ants, sl):alts,x:rest)
            |otherwise = unifyTripleSetWithRule1
                      (bool, xs, (y:yx), alts, x:rest)
            where (bv1, alts1) = unifyTriples x y
                  (a:as) = alts1
                  (ts, sl) = a
                  Rule (ants, con, _) = y
                  bv2 = (rest ++ xs) == []

-- call this function with bool = False
unifyRuleWithTripleSet :: (Bool, TripleSet, TripleSet, Alternatives) ->
                          (Bool, TripleSet, TripleSet, Alternatives)
unifyRuleWithTripleSet (bool, _, [], alts) = (bool, [], [], alts)
unifyRuleWithTripleSet (bool, [], _, alts) = (bool, [], [], alts)
unifyRuleWithTripleSet (bool, (x:xs), (y:yx), alts)
   |bv1 = unifyRuleWithTripleSet (True, (x:xs), (yx), (ants,sl):alts)
   |otherwise = unifyRuleWithTripleSet (bool, (x:xs), yx, alts)
   where (bv1, alts1) = unifyTriples x y
         (a:as) = alts1
         (ts, sl) = a
         Rule (ants, con, _) = x

unifyTripleWithTripleSet :: Triple -> TripleSet -> (Bool, Alternatives)
unifyTripleWithTripleSet t [] = (True, [])
unifyTripleWithTripleSet t ts 
    |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]

-- 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)
                = unifyTripleWithRule triple rule
unifyTriples (Rule rule) triple
                = unifyTripleWithRule triple rule
unifyTriples t1 t2 = (False, [([triple2], [])])

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

unifyTripleWithRule :: Triple -> Rule -> (Bool, Alternatives)
unifyTripleWithRule triple r@(antecedents, consequent, _)
    | bool = (True, [([Rule r], getSubstList alts)])
    | otherwise = (False, [([triple], [])]) 
    where (bool, alts) = (unifyTriples triple consequent)

unifyResources :: Resource -> Resource -> (Bool, SubstitutionList)
unifyResources (Var v1) (Var v2)
    |v1 == v2  = (True, [])
    |otherwise = (True, [(v1, Var v2)])
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 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 && compareTriplesVars 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) =
    getStringPart v1 == getStringPart v2
    where 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
compareResourcesVars r1 r2 = r1 == r2