module Data.RDF.GraphTestUtils where

import Data.RDF.Types
import Data.RDF.Query
import Data.RDF.Namespace
import Text.RDF.RDF4H.NTriplesSerializer
import qualified Data.Text as T
import Test.QuickCheck
import Data.List
import qualified Data.Set as Set
import qualified Data.Map as Map
import Control.Monad
import System.Directory (removeFile)
import System.IO.Unsafe(unsafePerformIO)
import System.IO

import Test.Tasty
import Test.Tasty.QuickCheck
import Test.QuickCheck.Monadic (assert, monadicIO,run)

----------------------------------------------------
--  property based quick check test cases         --
----------------------------------------------------

graphTests :: forall rdf. (Arbitrary rdf, RDF rdf, Show rdf)
           => TestName -> (rdf -> Triples) -> (rdf -> Triples) -> rdf -> (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> TestTree
graphTests testGroupName _triplesOf _uniqTriplesOf _empty _mkRdf = testGroup testGroupName
            [
              testProperty "empty"                      (p_empty _triplesOf _empty)
            , testProperty "mkRdf_triplesOf"            (p_mkRdf_triplesOf _triplesOf _mkRdf)
            , testProperty "mkRdf_no_dupes"             (p_mkRdf_no_dupes _uniqTriplesOf _mkRdf)
            , testProperty "query_match_none"           (p_query_match_none _mkRdf)
            , testProperty "query_matched_spo"          (p_query_matched_spo _triplesOf)
            -- see comment above p_query_matched_spo_no_dupes for why this is disabled
            -- , testProperty "query_matched_spo_no_dupes" (p_query_matched_spo_no_dupes _triplesOf _mkRdf)
            , testProperty "query_unmatched_spo"        (p_query_unmatched_spo _triplesOf)
            , testProperty "query_match_s"              (p_query_match_s _triplesOf)
            , testProperty "query_match_p"              (p_query_match_p _triplesOf)
            , testProperty "query_match_o"              (p_query_match_o _triplesOf)
            , testProperty "query_match_sp"             (p_query_match_sp _triplesOf)
            , testProperty "query_match_so"             (p_query_match_so _triplesOf)
            , testProperty "query_match_po"             (p_query_match_po _triplesOf)
            , testProperty "select_match_none"          (p_select_match_none _triplesOf)
            , testProperty "select_match_s"             (p_select_match_s _triplesOf)
            , testProperty "select_match_p"             (p_select_match_p _triplesOf)
            , testProperty "select_match_o"             (p_select_match_o _triplesOf)
            , testProperty "select_match_sp"            (p_select_match_sp _triplesOf)
            , testProperty "select_match_so"            (p_select_match_so _triplesOf)
            , testProperty "select_match_po"            (p_select_match_po _triplesOf)
            , testProperty "select_match_spo"           (p_select_match_spo _triplesOf)
            , testProperty "reversed RDF handle write"  (p_reverseRdfTest _mkRdf)
            ]


instance Arbitrary BaseUrl where
  arbitrary = oneof $ map (return . BaseUrl . T.pack) ["http://example.com/a","http://asdf.org/b","http://asdf.org/c"]
  --coarbitrary = undefined

instance Arbitrary PrefixMappings where
  arbitrary = oneof [return $ PrefixMappings Map.empty, return $ PrefixMappings $
                          Map.fromAscList [(T.pack "eg1", T.pack "http://example.com/1"),
                                           (T.pack "eg2", T.pack "http://example.com/2"),
                                           (T.pack "eg3", T.pack "http://example.com/3")]]
  --coarbitrary = undefined

-- Test stubs, which just require the appropriate RDF impl function
-- passed in to determine the implementation to be tested.

-- empty RDF should have no triples
p_empty :: RDF rdf => (rdf -> Triples) -> rdf -> Bool
p_empty _triplesOf _empty = _triplesOf _empty == []

-- triplesOf any RDF should return unique triples used to create it
p_mkRdf_triplesOf :: RDF rdf => (rdf -> Triples) -> (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> Triples -> Maybe BaseUrl -> PrefixMappings -> Bool
p_mkRdf_triplesOf _triplesOf _mkRdf ts bUrl pms =
  uordered (_triplesOf (_mkRdf ts bUrl pms)) == uordered ts

-- duplicate input triples should not be returned when
-- uniqTriplesof is used
p_mkRdf_no_dupes :: RDF rdf => (rdf -> Triples) -> (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> Triples -> Maybe BaseUrl -> PrefixMappings -> Bool
p_mkRdf_no_dupes _uniqtriplesOf _mkRdf ts bUrl pms =
  null ts || (sort result == uordered ts)
   where
    tsWithDupe = head ts : ts
    result = _uniqtriplesOf $ _mkRdf tsWithDupe bUrl pms

-- Note: in TriplesGraph and PatriciaTreeGraph `query` expands triples
--       but `ts` here is not  necessarily expanded. What is the correct
--       property this test should check?
--
-- query with all 3 wildcards should yield all triples in RDF
p_query_match_none :: RDF rdf => (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> Triples -> Maybe BaseUrl -> PrefixMappings -> Bool
p_query_match_none  _mkRdf ts bUrl pms = uordered ts == uordered result
  where
    result = query (_mkRdf ts bUrl pms) Nothing Nothing Nothing

-- query with no wildcard and a triple in the RDF should yield
-- a singleton list with just the triple.
p_query_matched_spo :: RDF rdf => (rdf -> Triples) -> rdf -> Property
p_query_matched_spo _triplesOf rdf =
  classify (null ts) "trivial" $
    forAll (tripleFromGen _triplesOf rdf) f
  where
    ts = _triplesOf rdf
    f t = case t of
            Nothing   ->  True
            (Just t') ->  [t'] == queryT rdf t'

{- disabled:
-- removing duplicates from `query` (and `select`) is deprecated, see
--  https://github.com/cordawyn/rdf4h/commit/9dd4729908db8d2f80088706592adac81a0f3016
--
-- query as in p_query_matched_spo after duplicating a triple in the
-- RDF, so that we can verify that the results just have 1, even
-- if the RDF itself doesn't ensure that there are no dupes internally.
p_query_matched_spo_no_dupes :: RDF rdf => (rdf -> Triples) -> (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> rdf -> Property
p_query_matched_spo_no_dupes _triplesOf _mkRdf rdf =
  classify (null ts) "trivial" $
    forAll (tripleFromGen _triplesOf rdf) f
  where
    ts = _triplesOf rdf
    f t = case t of
            Nothing   -> True
            Just t'   -> [t'] == queryT (mkRdfWithDupe _triplesOf _mkRdf rdf t') t'
-}

-- query with no wildcard and a triple no in the RDF should yield []
p_query_unmatched_spo :: RDF rdf => (rdf -> Triples) -> rdf -> Triple -> Property
p_query_unmatched_spo _triplesOf rdf t =
  classify (t `elem` ts) "ignored" $
    notElem t ts ==> [] == queryT rdf t
  where
    ts = _triplesOf rdf

-- query with fixed subject and wildcards for pred and obj should yield
-- a list with all triples having subject, and RDF minus result triples
-- should yield all triple with unequal subjects.
p_query_match_s :: RDF rdf => (rdf -> Triples) -> rdf -> Property
p_query_match_s = mk_query_match_fn sameSubj f
  where f t = (Just (subjectOf t), Nothing, Nothing)

-- query w/ fixed predicate and wildcards for subj and obj should yield
-- a list with all triples having predicate, and RDFgraph minus result triples
-- should yield all triple with unequal predicates.
p_query_match_p :: RDF rdf => (rdf -> Triples) -> rdf -> Property
p_query_match_p = mk_query_match_fn samePred f
  where f t = (Nothing, Just (predicateOf t), Nothing)

-- likewise for fixed subject and predicate with object wildcard
p_query_match_o :: RDF rdf => (rdf -> Triples) -> rdf -> Property
p_query_match_o = mk_query_match_fn sameObj f
  where f t = (Nothing, Nothing, Just (objectOf t))

-- verify likewise for fixed subject and predicate with wildcard object
p_query_match_sp :: RDF rdf => (rdf -> Triples) -> rdf -> Property
p_query_match_sp = mk_query_match_fn same f
  where same t1 t2 = sameSubj t1 t2 && samePred t1 t2
        f t = (Just $ subjectOf t, Just $ predicateOf t, Nothing)

-- fixed subject and object with wildcard predicate
p_query_match_so :: RDF rdf => (rdf -> Triples) -> rdf -> Property
p_query_match_so = mk_query_match_fn same f
  where same t1 t2 = sameSubj t1 t2 && sameObj t1 t2
        f t = (Just $ subjectOf t, Nothing, Just $ objectOf t)

-- fixed predicate and object with wildcard subject
p_query_match_po :: RDF rdf => (rdf -> Triples) -> rdf -> Property
p_query_match_po = mk_query_match_fn same f
  where same t1 t2 = samePred t1 t2 && sameObj t1 t2
        f t = (Nothing, Just $ predicateOf t, Just $ objectOf t)

mk_query_match_fn :: RDF rdf => (Triple -> Triple -> Bool)
  -> (Triple -> (Maybe Node, Maybe Node, Maybe Node))
  -> (rdf -> Triples) -> rdf -> Property
mk_query_match_fn tripleCompareFn  mkPatternFn _triplesOf rdf =
  forAll (tripleFromGen _triplesOf rdf) f
  where
    f :: Maybe Triple -> Bool
    f Nothing   = True
    f (Just t)  =
      let
        all_ts = _triplesOf rdf
        all_ts_sorted = uordered all_ts
        results = uordered $ queryC rdf (mkPatternFn t)
        notResults = ldiff all_ts_sorted results
      in
        all (tripleCompareFn t) results &&
        all (not . tripleCompareFn t) notResults

p_select_match_none :: RDF rdf => (rdf -> Triples) -> rdf -> Bool
p_select_match_none _triplesOf_not_used rdf = sort ts1 == sort ts2
    where
      ts1 = select rdf Nothing Nothing Nothing
      -- ts2 = (nub . triplesOf) rdf

      -- may have duplicates, see comments in
      --   https://github.com/cordawyn/rdf4h/commit/9dd4729908db8d2f80088706592adac81a0f3016
      ts2 = triplesOf rdf

p_select_match_s :: RDF rdf => (rdf -> Triples) -> rdf -> Property
p_select_match_s =
  p_select_match_fn same mkPattern
  where
    same = equivNode (==) subjectOf
    mkPattern t = (Just (\n -> n == subjectOf t), Nothing, Nothing)

p_select_match_p :: RDF rdf => (rdf -> Triples) -> rdf -> Property
p_select_match_p =
  p_select_match_fn same mkPattern
  where
    same = equivNode equiv predicateOf
    equiv (UNode u1) (UNode u2) = T.last u1 == T.last u2
    equiv _          _          = error "GraphTestUtils.p_select_match_p.equiv"
    mkPattern t = (Nothing, Just (\n -> lastChar n == lastChar (predicateOf t)) , Nothing)
    lastChar (UNode uri) = T.last uri
    lastChar _           = error "GraphTestUtils.p_select_match_p.lastChar"


p_select_match_o :: RDF rdf => (rdf -> Triples) -> rdf -> Property
p_select_match_o =
  p_select_match_fn same mkPattern
  where
    same = equivNode (/=) objectOf
    mkPattern t = (Nothing, Nothing, Just (\n -> n /= objectOf t))

p_select_match_sp :: RDF rdf => (rdf -> Triples) -> rdf -> Property
p_select_match_sp =
  p_select_match_fn same mkPattern
  where
    same t1 t2 = subjectOf t1 == subjectOf t2 && predicateOf t1 /= predicateOf t2
    mkPattern t = (Just (\n -> n == subjectOf t), Just (\n -> n /= predicateOf t), Nothing)

p_select_match_so :: RDF rdf => (rdf -> Triples) -> rdf -> Property
p_select_match_so =
  p_select_match_fn same mkPattern
  where
    same t1 t2 = subjectOf t1 /= subjectOf t2 && objectOf t1 == objectOf t2
    mkPattern t = (Just (\n -> n /= subjectOf t), Nothing, Just (\n -> n == objectOf t))

p_select_match_po :: RDF rdf => (rdf -> Triples) -> rdf -> Property
p_select_match_po =
  p_select_match_fn same mkPattern
  where
    same t1 t2 = predicateOf t1 == predicateOf t2 && objectOf t1 == objectOf t2
    mkPattern t = (Nothing, Just (\n -> n == predicateOf t), Just (\n -> n == objectOf t))

p_select_match_spo :: RDF rdf => (rdf -> Triples) -> rdf -> Property
p_select_match_spo =
  p_select_match_fn same mkPattern
  where
    same t1 t2 = subjectOf t1 == subjectOf t2 && predicateOf t1 == predicateOf t2 &&
                 objectOf t1 /= objectOf t2
    mkPattern t = (Just (\n -> n == subjectOf t),
                   Just (\n -> n == predicateOf t),
                   Just (\n -> n /= objectOf t))

equivNode :: (Node -> Node -> Bool) -> (Triple -> Node) -> Triple -> Triple -> Bool
equivNode eqFn exFn t1 t2 = exFn t1 `eqFn` exFn t2

p_select_match_fn :: RDF rdf => (Triple -> Triple -> Bool)
  -> (Triple -> (NodeSelector, NodeSelector, NodeSelector))
  -> (rdf -> Triples) -> rdf -> Property
p_select_match_fn tripleCompareFn mkPatternFn _triplesOf rdf =
  forAll (tripleFromGen _triplesOf rdf) f
  where
    f :: Maybe Triple -> Bool
    f Nothing = True
    f (Just t) =
      let
        all_ts = triplesOf rdf
        all_ts_sorted = uordered all_ts
        results = uordered $ selectC rdf (mkPatternFn t)
        notResults = ldiff all_ts_sorted results
      in
        all (tripleCompareFn t) results &&
        all (not . tripleCompareFn t) notResults

mkRdfWithDupe :: RDF rdf => (rdf -> Triples) -> (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> rdf -> Triple -> rdf
mkRdfWithDupe _triplesOf _mkRdf rdf t = _mkRdf ts (baseUrl rdf) (prefixMappings rdf)
  where ts = t : _triplesOf rdf


-- Utility functions and test data ... --

-- a curried version of query that delegates to the actual query after unpacking
-- curried maybe node pattern.
queryC :: RDF rdf => rdf -> (Maybe Node, Maybe Node, Maybe Node) -> Triples
queryC rdf (s, p, o) = query rdf s p o

selectC :: RDF rdf => rdf -> (NodeSelector, NodeSelector, NodeSelector) -> Triples
selectC rdf (s, p, o) = select rdf s p o

uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 fn (x, y, z) = fn x y z

curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
curry3 fn x y z = fn (x, y, z)

debug :: String -> Triples -> Bool
debug msg ts =
  unsafePerformIO $
    putStrLn msg >> mapM print ts >> return True

ldiff :: Triples -> Triples -> Triples
ldiff l1 l2 = Set.toList $(Set.fromList l1) `Set.difference` Set.fromList l2

sameSubj :: Triple -> Triple -> Bool
sameSubj t1 t2 = subjectOf t1 == subjectOf t2

samePred :: Triple -> Triple -> Bool
samePred t1 t2 = predicateOf t1 == predicateOf t2

sameObj :: Triple -> Triple -> Bool
sameObj  t1 t2 = objectOf t1 == objectOf t2

-- Convert a list of triples into a sorted list of unique triples.
uordered :: Triples -> Triples
uordered  =  sort . nub

tripleFromGen :: RDF rdf => (rdf -> Triples) -> rdf -> Gen (Maybe Triple)
tripleFromGen _triplesOf rdf =
  if null ts
  then return Nothing
  else oneof $ map (return . Just) ts
   where ts = _triplesOf rdf

queryT :: RDF rdf => rdf -> Triple -> Triples
queryT rdf t = query rdf (Just $ subjectOf t) (Just $ predicateOf t) (Just $ objectOf t)

languages :: [T.Text]
languages = [T.pack "fr", T.pack "en"]

datatypes :: [T.Text]
datatypes = map (mkUri xsd . T.pack) ["string", "int", "token"]

uris :: [T.Text]
uris = map (mkUri ex) [T.pack n `T.append` T.pack (show (i::Int)) | n <- ["foo", "bar", "quz", "zak"], i <- [0..9]]

plainliterals :: [LValue]
plainliterals = [plainLL lit lang | lit <- litvalues, lang <- languages]

typedliterals :: [LValue]
typedliterals = [typedL lit dtype | lit <- litvalues, dtype <- datatypes]

litvalues :: [T.Text]
litvalues = map T.pack ["hello", "world", "peace", "earth", "", "haskell"]

unodes :: [Node]
unodes = map UNode uris

bnodes :: [ Node]
bnodes = map (BNode . \i -> T.pack ":_genid" `T.append` T.pack (show (i::Int))) [1..5]

lnodes :: [Node]
lnodes = [LNode lit | lit <- plainliterals ++ typedliterals]

test_triples :: [Triple]
test_triples = [triple s p o | s <- unodes ++ bnodes, p <- unodes, o <- unodes ++ bnodes ++ lnodes]

maxN :: Int
maxN = min 100 (length test_triples - 1)

instance Arbitrary Triple where
  arbitrary = liftM3 triple arbitraryS arbitraryP arbitraryO
  --coarbitrary = undefined

instance Arbitrary Node where
  arbitrary = oneof $ map return unodes
  --coarbitrary = undefined

arbitraryTNum :: Gen Int
arbitraryTNum = choose (0, maxN - 1)

arbitraryTs :: Gen Triples
arbitraryTs = do
  n <- sized (\_ -> choose (0, maxN))
  sequence [arbitrary | _ <- [1..n]]

arbitraryT :: Gen Triple
arbitraryT = elements test_triples

arbitraryN :: Gen Int
arbitraryN = choose (0, maxN - 1)

arbitraryS, arbitraryP, arbitraryO :: Gen Node
arbitraryS = oneof $ map return $ unodes ++ bnodes
arbitraryP = oneof $ map return unodes
arbitraryO = oneof $ map return $ unodes ++ bnodes ++ lnodes

----------------------------------------------------
--  Unit test cases                               --
----------------------------------------------------

-- Reported by Daniel Bergey:
--   https://github.com/robstewart57/rdf4h/issues/4

p_reverseRdfTest :: RDF rdf => (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> Property
p_reverseRdfTest _mkRdf = monadicIO $ do
    fileContents <- Test.QuickCheck.Monadic.run $ do
      (pathFile,hFile) <- openTempFile "." "tmp."
      hWriteRdf NTriplesSerializer hFile rdfGraph
      hClose hFile
      contents <- readFile pathFile
      removeFile pathFile
      return contents
    let expected = "<file:///this/is/not/a/palindrome> <file:///this/is/not/a/palindrome> \"literal string\" .\n"
    assert $ expected == fileContents

  where
    rdfGraph = _mkRdf ts (Just $ BaseUrl "file://") (ns_mappings [])

    ts :: [Triple]
    ts = [Triple
           (unode "file:///this/is/not/a/palindrome")
           (unode "file:///this/is/not/a/palindrome")
           (LNode . PlainL . T.pack $ "literal string")]
