{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- [TODO] Remove when the missing NFData instance is added to Alga.

module Data.RDF.Graph.AlgebraicGraph
  ( AlgebraicGraph,
  )
where

import qualified Algebra.Graph.Labelled as G
import Control.DeepSeq (NFData (..))
import Data.Binary
import Data.HashSet (HashSet)
import qualified Data.HashSet as HS
import Data.RDF.Namespace
import Data.RDF.Query
import Data.RDF.Types (BaseUrl, Node, NodeSelector, Object, Predicate, RDF, Rdf (..), Subject, Triple (..), Triples)
#if MIN_VERSION_base(4,9,0)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#else
#endif
#else
#endif
import GHC.Generics

data AlgebraicGraph deriving (Generic)

instance Binary AlgebraicGraph

instance NFData AlgebraicGraph

data instance RDF AlgebraicGraph
  = AlgebraicGraph
      { _graph :: G.Graph (HashSet Node) Node,
        _baseUrl :: Maybe BaseUrl,
        _prefixMappings :: PrefixMappings
      }
  deriving (Generic, NFData)

instance Rdf AlgebraicGraph where
  baseUrl = _baseUrl
  prefixMappings = _prefixMappings
  addPrefixMappings = addPrefixMappings'
  empty = empty'
  mkRdf = mkRdf'
  addTriple = addTriple'
  removeTriple = removeTriple'
  triplesOf = triplesOf'
  uniqTriplesOf = triplesOf'
  select = select'
  query = query'
  showGraph = showGraph'

toEdge :: Triple -> (HashSet Predicate, Subject, Object)
toEdge (Triple s p o) = (HS.singleton p, s, o)

toTriples :: (HashSet Predicate, Subject, Object) -> Triples
toTriples (ps, s, o) = [Triple s p o | p <- HS.toList ps]

showGraph' :: RDF AlgebraicGraph -> String
showGraph' r = concatMap (\t -> show t ++ "\n") (expandTriples r)

addPrefixMappings' :: RDF AlgebraicGraph -> PrefixMappings -> Bool -> RDF AlgebraicGraph
addPrefixMappings' (AlgebraicGraph g baseURL pms) pms' replace =
  let merge = if replace then flip (<>) else (<>)
   in AlgebraicGraph g baseURL (merge pms pms')

empty' :: RDF AlgebraicGraph
empty' = AlgebraicGraph G.empty mempty (PrefixMappings mempty)

mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF AlgebraicGraph
mkRdf' ts baseURL pms =
  let g = G.edges . fmap toEdge $ ts
   in AlgebraicGraph g baseURL pms

addTriple' :: RDF AlgebraicGraph -> Triple -> RDF AlgebraicGraph
addTriple' (AlgebraicGraph g baseURL pms) (Triple s p o) =
  let g' = G.edge (HS.singleton p) s o
   in AlgebraicGraph (G.overlay g g') baseURL pms

removeTriple' :: RDF AlgebraicGraph -> Triple -> RDF AlgebraicGraph
removeTriple' (AlgebraicGraph g baseURL pms) (Triple s p o) =
  let ps = G.edgeLabel s o g
      g'
        | HS.null ps = g
        | elem p ps = G.replaceEdge (HS.delete p ps) s o g
        | otherwise = g
   in AlgebraicGraph g' baseURL pms

triplesOf' :: RDF AlgebraicGraph -> Triples
triplesOf' (AlgebraicGraph g _ _) = mconcat $ toTriples <$> G.edgeList g

select' :: RDF AlgebraicGraph -> NodeSelector -> NodeSelector -> NodeSelector -> Triples
select' r Nothing Nothing Nothing = triplesOf r
select' (AlgebraicGraph g _ _) s p o = let (res, _, _) = G.foldg e v c g in res
  where
    e = (mempty, mempty, mempty)
    v x = (mempty, s ?? x, o ?? x)
    (??) f x' = let xs = HS.singleton x' in maybe xs (`HS.filter` xs) f
    c ps (ts1, ss1, os1) (ts2, ss2, os2) = (ts3, ss3, os3)
      where
        ss3 = ss1 <> ss2
        os3 = os1 <> os2
        ts3
          | HS.null ps' = ts1 <> ts2
          | otherwise = ts1 <> ts2 <> [Triple s' p' o' | s' <- HS.toList ss3, p' <- HS.toList ps', o' <- HS.toList os3]
        ps' = maybe ps (`HS.filter` ps) p

query' :: RDF AlgebraicGraph -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples
query' r Nothing Nothing Nothing = triplesOf r
query' r s p o = select r ((==) <$> s) ((==) <$> p) ((==) <$> o)