{-# LANGUAGE ExistentialQuantification, OverloadedLists #-}
module Database.HSparql.QueryGenerator
(
createSelectQuery
, createConstructQuery
, createAskQuery
, createUpdateQuery
, createDescribeQuery
, prefix
, var
, Database.HSparql.QueryGenerator.triple, triple_
, mkPredicateObject
, constructTriple, constructTriple_
, askTriple, askTriple_
, updateTriple, updateTriple_
, describeIRI, describeIRI_
, optional, optional_
, union, union_
, exists, notExists
, filterExpr, filterExpr_
, bind, bind_
, subQuery, subQuery_
, select
, selectVars
, as
, distinct, distinct_
, reduced, reduced_
, limit, limit_
, groupBy, groupBy_
, orderNext
, orderNextAsc
, orderNextDesc
, (.:.)
, iriRef
, (.+.), (.-.), (.*.), (./.), (.&&.), (.||.)
, (.==.), (.!=.), (.<.), (.>.), (.<=.), (.>=.)
, notExpr
, count
, sum_
, min_
, max_
, avg
, groupConcat
, str
, lang
, langMatches
, datatype
, bound
, sameTerm
, isIRI
, isURI
, isBlank
, isLiteral
, regex, regexOpts
, strlen
, substr
, ucase, lcase
, strstarts, strends
, contains
, strbefore, strafter
, abs_
, round_
, ceil
, floor_
, concat_
, replace
, rand
, qshow
, Query
, Prefix
, Variable
, VarOrNode(..)
, BlankNodePattern
, Pattern
, SelectQuery(..)
, SelectExpr(..)
, ConstructQuery(..)
, AskQuery(..)
, UpdateQuery(..)
, DescribeQuery(..)
, TermLike (..)
, SubjectTermLike
, PredicateTermLike
, ObjectTermLike
)
where
import Control.Monad.State
import Data.List (intercalate, intersperse)
import qualified Data.List as L
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Data.RDF as RDF
type Query a = State QueryData a
execQuery :: QueryData -> Query a -> (QueryData -> b) -> b
execQuery qd q f = f $ execState q qd
execQuery0 :: Query a -> (QueryData -> b) -> b
execQuery0 = execQuery queryData
createSelectQuery :: Query SelectQuery -> String
createSelectQuery q = execQuery0 (specifyVars q) qshow
specifyVars :: Query SelectQuery -> Query ()
specifyVars q = do
query <- q
modify $ \s -> s { vars = queryExpr query, queryType = SelectType }
createConstructQuery :: Query ConstructQuery -> String
createConstructQuery q = execQuery0 specifyType qshow
where specifyType :: Query ()
specifyType = do
query <- q
modify $ \s -> s { constructTriples = queryConstructs query, queryType = ConstructType }
createAskQuery :: Query AskQuery -> String
createAskQuery q = execQuery0 specifyType qshow
where specifyType :: Query ()
specifyType = do
query <- q
modify $ \s -> s { askTriples = queryAsk query, queryType = AskType }
createUpdateQuery :: Query UpdateQuery -> String
createUpdateQuery q = execQuery0 specifyType qshow
where specifyType :: Query ()
specifyType = do
query <- q
modify $ \s -> s { updateTriples = queryUpdate query, queryType = UpdateType }
createDescribeQuery :: Query DescribeQuery -> String
createDescribeQuery q = execQuery0 specifyType qshow
where specifyType :: Query ()
specifyType = do
query <- q
modify $ \s -> s { describeURI = Just (queryDescribe query), queryType = DescribeType }
prefix :: T.Text -> IRIRef -> Query Prefix
prefix pre (AbsoluteIRI node) = do
let p = Prefix pre node
modify $ \s -> s { prefixes = p : prefixes s }
return p
prefix _ _ = error "prefix requires an absolute IRI"
var :: Query Variable
var = do qis <- gets (NE.init . subQueryIdx)
n <- gets varsIdx
let sqis = NE.fromList (qis ++ [n])
modify $ \s -> s { varsIdx = n + 1 }
return $ Variable sqis
triple :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query Pattern
triple a b c = do
let t = QTriple (varOrTerm a) (varOrTerm b) (varOrTerm c)
modify $ \s -> s { pattern = appendPattern t (pattern s) }
return t
triple_ :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query ()
triple_ a b c = void $ triple a b c
constructTriple :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query Pattern
constructTriple a b c = do
let t = QTriple (varOrTerm a) (varOrTerm b) (varOrTerm c)
modify $ \s -> s { constructTriples = appendTriple t (constructTriples s) }
return t
constructTriple_ :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query ()
constructTriple_ a b c = void $ constructTriple a b c
askTriple :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query Pattern
askTriple a b c = do
let t = QTriple (varOrTerm a) (varOrTerm b) (varOrTerm c)
modify $ \s -> s { askTriples = appendTriple t (askTriples s) }
return t
askTriple_ :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query ()
askTriple_ a b c = void $ askTriple a b c
updateTriple :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query Pattern
updateTriple a b c = do
let t = QTriple (varOrTerm a) (varOrTerm b) (varOrTerm c)
modify $ \s -> s { updateTriples = appendTriple t (updateTriples s) }
return t
updateTriple_ :: (SubjectTermLike a, PredicateTermLike b, ObjectTermLike c) => a -> b -> c -> Query ()
updateTriple_ a b c = void $ updateTriple a b c
describeIRI :: IRIRef -> Query IRIRef
describeIRI newIri = do
modify $ \s -> s { describeURI = Just newIri }
return newIri
describeIRI_ :: IRIRef -> Query ()
describeIRI_ = void . describeIRI
selectVars :: [Variable] -> Query SelectQuery
selectVars vs = return SelectQuery { queryExpr = fmap SelectVar vs }
select :: [SelectExpr] -> Query SelectQuery
select es = return SelectQuery { queryExpr = es }
optional :: Query a -> Query Pattern
optional q = do
let option = execQuery0 q $ OptionalGraphPattern . pattern
modify $ \s -> s { pattern = appendPattern option (pattern s) }
return option
optional_ :: Query a -> Query ()
optional_ = void . optional
union :: Query a -> Query b -> Query Pattern
union q1 q2 = do
let p1 = execQuery0 q1 pattern
p2 = execQuery0 q2 pattern
union' = UnionGraphPattern p1 p2
modify $ \s -> s { pattern = appendPattern union' (pattern s) }
return union'
union_ :: Query a -> Query b -> Query ()
union_ a b = void $ union a b
exists :: Query a -> Query Pattern
exists q = do
let p = execQuery0 q pattern
exists' = ExistsPattern p
return exists'
notExists :: Query a -> Query Pattern
notExists q = do
let p = execQuery0 q pattern
notExists' = NotExistsPattern p
return notExists'
filterExpr :: (TermLike a) => a -> Query Pattern
filterExpr e = do
let f = Filter (expr e)
modify $ \s -> s { pattern = appendPattern f (pattern s) }
return f
filterExpr_ :: (TermLike a) => a -> Query ()
filterExpr_ = void . filterExpr
bind :: Expr -> Variable -> Query Pattern
bind e v = do
let b = Bind (expr e) v
modify $ \s -> s { pattern = appendPattern b (pattern s) }
return b
bind_ :: Expr -> Variable -> Query ()
bind_ a b = void $ bind a b
subQuery :: Query SelectQuery -> Query Pattern
subQuery q = do
qis <- gets subQueryIdx
let sqis = qis |> 0
qis' = NE.fromList $ NE.init qis ++ [NE.last qis + 1]
let subQueryData0 = queryData { subQueryIdx = sqis }
subQueryData = execQuery subQueryData0 (specifyVars q) id
prefixesParentQuery <- gets prefixes
let prefixesSubQuery = prefixes subQueryData
newPrefixes = prefixesParentQuery `L.union` prefixesSubQuery
let sq = SubQuery $ subQueryData { prefixes = [] }
modify $ \s -> s { pattern = appendPattern sq (pattern s)
, subQueryIdx = qis'
, prefixes = newPrefixes }
return sq
subQuery_ :: Query SelectQuery -> Query ()
subQuery_ = void . subQuery
(.:.) :: Prefix -> T.Text -> IRIRef
(.:.) = PrefixedName
distinct :: Query Duplicates
distinct = do modify $ \s -> s { duplicates = Distinct }
gets duplicates
distinct_ :: Query ()
distinct_ = void distinct
reduced :: Query Duplicates
reduced = do modify $ \s -> s { duplicates = Reduced }
gets duplicates
reduced_ :: Query ()
reduced_ = void reduced
limit :: Int -> Query Limit
limit n = do modify $ \s -> s { limits = Limit n }
gets limits
limit_ :: Int -> Query ()
limit_ = void . limit
groupBy :: (TermLike a) => a -> Query [GroupBy]
groupBy e = do
modify $ \s -> s { groups = groups s ++ [GroupBy . expr $ e] }
gets groups
groupBy_ :: (TermLike a) => a -> Query ()
groupBy_ = void . groupBy
orderNext :: (TermLike a) => a -> Query ()
orderNext = orderNextAsc
orderNextAsc :: (TermLike a) => a -> Query ()
orderNextAsc x = modify $ \s -> s { ordering = ordering s ++ [Asc $ expr x] }
orderNextDesc :: (TermLike a) => a -> Query ()
orderNextDesc x = modify $ \s -> s { ordering = ordering s ++ [Desc $ expr x] }
class TermLike a where
varOrTerm :: a -> VarOrTerm
expr :: a -> Expr
expr = VarOrTermExpr . varOrTerm
instance TermLike Variable where
varOrTerm = Var
instance TermLike IRIRef where
varOrTerm = Term . IRIRefTerm
instance TermLike BlankNodePattern where
varOrTerm [] = Term (BNode Nothing)
varOrTerm xs = BlankNodePattern' xs
expr [] = error "FIXME: blank node expression"
expr _ = error "cannot use a blank node pattern as an expression"
instance TermLike Expr where
varOrTerm = error "cannot use an expression as a term"
expr = id
instance TermLike Integer where
varOrTerm = Term . NumericLiteralTerm
expr = NumericExpr . NumericLiteralExpr
instance TermLike T.Text where
varOrTerm = Term . RDFLiteralTerm . RDF.plainL
instance TermLike (T.Text, T.Text) where
varOrTerm (s, lang') = Term . RDFLiteralTerm $ RDF.plainLL s lang'
instance TermLike (T.Text, IRIRef) where
varOrTerm (s, ref) = Term . RDFLiteralTerm $ RDF.typedL s (getFQN ref)
instance TermLike Bool where
varOrTerm = Term . BooleanLiteralTerm
instance TermLike RDF.Node where
varOrTerm n@(RDF.UNode _) = Term . IRIRefTerm . AbsoluteIRI $ n
varOrTerm (RDF.LNode lv) = Term . RDFLiteralTerm $ lv
varOrTerm (RDF.BNode i) = Term . BNode . Just $ i
varOrTerm (RDF.BNodeGen i) = Term . BNode . Just . T.pack . mconcat $ ["genid", show i]
instance TermLike VarOrNode where
varOrTerm (Var' v) = Var v
varOrTerm (RDFNode n) = varOrTerm n
class (TermLike a) => SubjectTermLike a
instance SubjectTermLike IRIRef
instance SubjectTermLike Variable
instance SubjectTermLike BlankNodePattern
class (TermLike a) => PredicateTermLike a
instance PredicateTermLike IRIRef
instance PredicateTermLike Variable
class (TermLike a) => ObjectTermLike a
instance ObjectTermLike IRIRef
instance ObjectTermLike Variable
instance ObjectTermLike BlankNodePattern
instance ObjectTermLike Expr
instance ObjectTermLike Integer
instance ObjectTermLike T.Text
instance ObjectTermLike (T.Text, T.Text)
instance ObjectTermLike (T.Text, IRIRef)
instance ObjectTermLike Bool
instance ObjectTermLike VarOrNode
instance ObjectTermLike RDF.Node
operation :: (TermLike a, TermLike b) => Operation -> a -> b -> Expr
operation op x y = NumericExpr $ OperationExpr op (expr x) (expr y)
(.+.) :: (TermLike a, TermLike b) => a -> b -> Expr
(.+.) = operation Add
(.-.) :: (TermLike a, TermLike b) => a -> b -> Expr
(.-.) = operation Subtract
(.*.) :: (TermLike a, TermLike b) => a -> b -> Expr
(.*.) = operation Multiply
(./.) :: (TermLike a, TermLike b) => a -> b -> Expr
(./.) = operation Divide
(.&&.) :: (TermLike a, TermLike b) => a -> b -> Expr
(.&&.) = operation And
(.||.) :: (TermLike a, TermLike b) => a -> b -> Expr
(.||.) = operation Or
infixr 2 .||.
infixr 3 .&&.
infixl 7 .*.
infixl 7 ./.
infixl 6 .+.
infixl 6 .-.
relation :: (TermLike a, TermLike b) => Relation -> a -> b -> Expr
relation rel x y = RelationalExpr rel (expr x) (expr y)
(.==.) :: (TermLike a, TermLike b) => a -> b -> Expr
(.==.) = relation Equal
(.!=.) :: (TermLike a, TermLike b) => a -> b -> Expr
(.!=.) = relation NotEqual
(.<.) :: (TermLike a, TermLike b) => a -> b -> Expr
(.<.) = relation LessThan
(.>.) :: (TermLike a, TermLike b) => a -> b -> Expr
(.>.) = relation GreaterThan
(.<=.) :: (TermLike a, TermLike b) => a -> b -> Expr
(.<=.) = relation LessThanOrEqual
(.>=.) :: (TermLike a, TermLike b) => a -> b -> Expr
(.>=.) = relation GreaterThanOrEqual
infix 4 .==., .!=., .<., .<=., .>., .>=.
notExpr :: (TermLike a) => a -> Expr
notExpr = NegatedExpr . expr
type BuiltinFunc0 = Expr
builtinFunc0 :: Function -> BuiltinFunc0
builtinFunc0 f = BuiltinCall f []
type BuiltinFunc1 = forall a . (TermLike a) => a -> Expr
builtinFunc1 :: Function -> BuiltinFunc1
builtinFunc1 f x = BuiltinCall f [expr x]
type BuiltinFunc2 = forall a b . (TermLike a, TermLike b) => a -> b -> Expr
builtinFunc2 :: Function -> BuiltinFunc2
builtinFunc2 f x y = BuiltinCall f [expr x, expr y]
type BuiltinFunc3 = forall a b c . (TermLike a, TermLike b, TermLike c) => a -> b -> c -> Expr
builtinFunc3 :: Function -> BuiltinFunc3
builtinFunc3 f x y z = BuiltinCall f [expr x, expr y, expr z]
count :: BuiltinFunc1
count = builtinFunc1 CountFunc
sum_ :: BuiltinFunc1
sum_ = builtinFunc1 SumFunc
min_ :: BuiltinFunc1
min_ = builtinFunc1 MinFunc
max_ :: BuiltinFunc1
max_ = builtinFunc1 MaxFunc
avg :: BuiltinFunc1
avg = builtinFunc1 AvgFunc
str :: BuiltinFunc1
str = builtinFunc1 StrFunc
lang :: BuiltinFunc1
lang = builtinFunc1 LangFunc
strlen :: BuiltinFunc1
strlen = builtinFunc1 StrLenFunc
substr :: BuiltinFunc1
substr = builtinFunc1 SubStrFunc
ucase :: BuiltinFunc1
ucase = builtinFunc1 UcaseFunc
lcase :: BuiltinFunc1
lcase = builtinFunc1 LcaseFunc
strstarts :: BuiltinFunc2
strstarts = builtinFunc2 StrStartsFunc
strends :: BuiltinFunc2
strends = builtinFunc2 StrEndsFunc
contains :: BuiltinFunc2
contains = builtinFunc2 ContainsFunc
strbefore :: BuiltinFunc2
strbefore = builtinFunc2 StrBeforeFunc
strafter :: BuiltinFunc2
strafter = builtinFunc2 StrAfterFunc
concat_ :: BuiltinFunc2
concat_ = builtinFunc2 ConcatFunc
replace :: BuiltinFunc3
replace = builtinFunc3 ReplaceFunc
abs_ :: BuiltinFunc1
abs_ = builtinFunc1 AbsFunc
round_ :: BuiltinFunc1
round_ = builtinFunc1 RoundFunc
ceil :: BuiltinFunc1
ceil = builtinFunc1 CeilFunc
floor_ :: BuiltinFunc1
floor_ = builtinFunc1 FloorFunc
rand :: BuiltinFunc0
rand = builtinFunc0 RandFunc
groupConcat :: (TermLike a) => a -> String -> Expr
groupConcat x sep = ParameterizedCall GroupConcat [expr x] [("separator", "\"" ++ sep ++ "\"")]
langMatches :: BuiltinFunc2
langMatches = builtinFunc2 LangMatchesFunc
datatype :: BuiltinFunc1
datatype = builtinFunc1 DataTypeFunc
bound :: Variable -> Expr
bound x = BuiltinCall BoundFunc [expr x]
sameTerm :: BuiltinFunc2
sameTerm = builtinFunc2 SameTermFunc
isIRI :: BuiltinFunc1
isIRI = builtinFunc1 IsIRIFunc
isURI :: BuiltinFunc1
isURI = builtinFunc1 IsURIFunc
isBlank :: BuiltinFunc1
isBlank = builtinFunc1 IsBlankFunc
isLiteral :: BuiltinFunc1
isLiteral = builtinFunc1 IsLiteralFunc
regex :: BuiltinFunc2
regex = builtinFunc2 RegexFunc
regexOpts :: BuiltinFunc3
regexOpts = builtinFunc3 RegexFunc
queryData :: QueryData
queryData = QueryData
{ prefixes = []
, varsIdx = 0
, vars = []
, queryType = TypeNotSet
, subQueryIdx = [0]
, pattern = GroupGraphPattern []
, constructTriples = []
, askTriples = []
, updateTriples = []
, describeURI = Nothing
, duplicates = NoLimits
, groups = []
, ordering = []
, limits = NoLimit
}
class QueryShow a where
qshow :: a -> String
data Duplicates = NoLimits | Distinct | Reduced
deriving (Show)
data Limit = NoLimit | Limit Int
deriving (Show)
data Prefix = Prefix T.Text RDF.Node
deriving (Show, Eq)
data Variable = Variable (NonEmpty Int)
deriving (Show)
data DynamicPredicate = forall a. (PredicateTermLike a, QueryShow a, Show a) => DynamicPredicate a
data DynamicObject = forall a. (ObjectTermLike a, QueryShow a, Show a) => DynamicObject a
type DynamicPredicateObject = (DynamicPredicate, DynamicObject)
type BlankNodePattern = [DynamicPredicateObject]
instance Show DynamicPredicate where
show (DynamicPredicate a) = show a
instance Show DynamicObject where
show (DynamicObject a) = show a
mkPredicateObject :: (PredicateTermLike a, ObjectTermLike b, QueryShow a, QueryShow b, Show a, Show b) => a -> b -> DynamicPredicateObject
mkPredicateObject p o = (DynamicPredicate p, DynamicObject o)
data IRIRef = AbsoluteIRI RDF.Node
| PrefixedName Prefix T.Text
deriving (Show)
iriRef :: T.Text -> IRIRef
iriRef uri = AbsoluteIRI $ RDF.unode uri
getFQN :: IRIRef -> T.Text
getFQN (AbsoluteIRI (RDF.UNode n)) = n
getFQN (PrefixedName (Prefix _ (RDF.UNode n)) s) = T.append n s
getFQN _ = error "getFQN: input not supported"
data GraphTerm = IRIRefTerm IRIRef
| RDFLiteralTerm RDF.LValue
| NumericLiteralTerm Integer
| BooleanLiteralTerm Bool
| BNode (Maybe T.Text)
deriving (Show)
data VarOrTerm = Var Variable
| Term GraphTerm
| BlankNodePattern' BlankNodePattern
deriving (Show)
data VarOrNode = Var' Variable
| RDFNode RDF.Node
deriving (Show)
data Operation = Add | Subtract | Multiply | Divide | And | Or
deriving (Show)
data NumericExpr = NumericLiteralExpr Integer
| OperationExpr Operation Expr Expr
deriving (Show)
data Relation = Equal | NotEqual | LessThan | GreaterThan | LessThanOrEqual | GreaterThanOrEqual
deriving (Show)
data Function = CountFunc | SumFunc | MinFunc | MaxFunc | AvgFunc
| StrFunc | LangFunc | LangMatchesFunc
| DataTypeFunc | BoundFunc | SameTermFunc
| IsIRIFunc | IsURIFunc | IsBlankFunc | IsLiteralFunc
| RegexFunc
| StrLenFunc | SubStrFunc | UcaseFunc | LcaseFunc
| StrStartsFunc | StrEndsFunc | ContainsFunc | StrBeforeFunc
| StrAfterFunc | ConcatFunc | ReplaceFunc
| AbsFunc | RoundFunc | CeilFunc | FloorFunc | RandFunc
deriving (Show)
data ParameterizedFunction = GroupConcat deriving (Show)
data Expr = OrExpr [Expr]
| AndExpr [Expr]
| NegatedExpr Expr
| RelationalExpr Relation Expr Expr
| NumericExpr NumericExpr
| BuiltinCall Function [Expr]
| VarOrTermExpr VarOrTerm
| ParameterizedCall ParameterizedFunction [Expr] [(String, String)]
deriving (Show)
data SelectExpr = SelectExpr Expr Variable
| SelectVar Variable
deriving (Show)
as :: Expr -> Variable -> SelectExpr
e `as` v = SelectExpr e v
data Pattern = QTriple VarOrTerm VarOrTerm VarOrTerm
| Filter Expr
| Bind Expr Variable
| OptionalGraphPattern GroupGraphPattern
| UnionGraphPattern GroupGraphPattern GroupGraphPattern
| SubQuery QueryData
| ExistsPattern GroupGraphPattern
| NotExistsPattern GroupGraphPattern
data GroupGraphPattern = GroupGraphPattern [Pattern]
newtype GroupBy = GroupBy Expr
data OrderBy = Asc Expr
| Desc Expr
appendPattern :: Pattern -> GroupGraphPattern -> GroupGraphPattern
appendPattern p (GroupGraphPattern ps) = GroupGraphPattern (ps ++ [p])
appendTriple :: a -> [a] -> [a]
appendTriple t ts = t : ts
data QueryData = QueryData
{ prefixes :: [Prefix]
, varsIdx :: Int
, vars :: [SelectExpr]
, queryType :: QueryType
, subQueryIdx :: NonEmpty Int
, pattern :: GroupGraphPattern
, constructTriples :: [Pattern]
, askTriples :: [Pattern]
, updateTriples :: [Pattern]
, describeURI :: Maybe IRIRef
, duplicates :: Duplicates
, groups :: [GroupBy]
, ordering :: [OrderBy]
, limits :: Limit
}
data QueryType = SelectType | ConstructType | AskType | UpdateType | DescribeType | TypeNotSet
data ConstructQuery = ConstructQuery
{ queryConstructs :: [Pattern] }
data AskQuery = AskQuery
{ queryAsk :: [Pattern] }
data UpdateQuery = UpdateQuery
{ queryUpdate :: [Pattern] }
data SelectQuery = SelectQuery
{ queryExpr :: [SelectExpr] }
data DescribeQuery = DescribeQuery
{ queryDescribe :: IRIRef }
instance QueryShow BlankNodePattern where
qshow [] = "[]"
qshow xs = intercalate ", " $ fmap qshow xs
instance QueryShow DynamicPredicateObject where
qshow (DynamicPredicate p, DynamicObject o) = mconcat ["[", qshow p, " ", qshow o, "]"]
instance QueryShow Duplicates where
qshow NoLimits = ""
qshow Distinct = "DISTINCT"
qshow Reduced = "REDUCED"
instance QueryShow Limit where
qshow NoLimit = ""
qshow (Limit n) = "Limit " ++ show n
instance QueryShow RDF.Node where
qshow (RDF.UNode n) = "<" ++ T.unpack n ++ ">"
qshow (RDF.BNode n) = "_:" ++ T.unpack n
qshow (RDF.BNodeGen i) = "_:genid" ++ show i
qshow (RDF.LNode n) = qshow n
instance QueryShow RDF.LValue where
qshow (RDF.PlainL lit) = T.unpack . T.concat $ ["\"", escapeSpecialChar lit, "\""]
qshow (RDF.PlainLL lit lang_) = T.unpack . T.concat $ ["\"", escapeSpecialChar lit, "\"@", lang_]
qshow (RDF.TypedL lit dtype) = T.unpack . T.concat $ ["\"", escapeSpecialChar lit, "\"^^<", dtype, ">"]
instance QueryShow Prefix where
qshow (Prefix pre ref) = "PREFIX " ++ (T.unpack pre) ++ ": " ++ qshow ref
instance QueryShow [Prefix] where
qshow = unwords . fmap qshow
instance QueryShow Variable where
qshow (Variable vs) = "?x" ++ indexes
where indexes = mconcat . intersperse "_" . fmap show . NE.toList $ vs
instance QueryShow [Variable] where
qshow = unwords . fmap qshow
instance QueryShow IRIRef where
qshow (AbsoluteIRI n) = qshow n
qshow (PrefixedName (Prefix pre _) s) = (T.unpack pre) ++ ":" ++ (T.unpack s)
instance QueryShow (Maybe IRIRef) where
qshow (Just r) = qshow r
qshow Nothing = ""
instance QueryShow GraphTerm where
qshow (IRIRefTerm ref) = qshow ref
qshow (RDFLiteralTerm s) = qshow s
qshow (BooleanLiteralTerm True) = show ("true" :: String)
qshow (BooleanLiteralTerm False) = show ("false" :: String)
qshow (NumericLiteralTerm i) = show i
qshow (BNode Nothing) = "[]"
qshow (BNode (Just i)) = "_:" ++ T.unpack i
instance QueryShow VarOrTerm where
qshow (Var v) = qshow v
qshow (Term t) = qshow t
qshow (BlankNodePattern' bn) = qshow bn
instance QueryShow [VarOrTerm] where
qshow = unwords . fmap qshow
instance QueryShow Operation where
qshow Add = "+"
qshow Subtract = "-"
qshow Multiply = "*"
qshow Divide = "/"
qshow And = "&&"
qshow Or = "||"
instance QueryShow NumericExpr where
qshow (NumericLiteralExpr n) = show n
qshow (OperationExpr op x y) = qshow x ++ qshow op ++ qshow y
instance QueryShow Relation where
qshow Equal = "="
qshow NotEqual = "!="
qshow LessThan = "<"
qshow GreaterThan = ">"
qshow LessThanOrEqual = "<="
qshow GreaterThanOrEqual = ">="
instance QueryShow Function where
qshow CountFunc = "COUNT"
qshow SumFunc = "SUM"
qshow MinFunc = "MIN"
qshow MaxFunc = "MAX"
qshow AvgFunc = "AVG"
qshow StrFunc = "STR"
qshow LangFunc = "LANG"
qshow LangMatchesFunc = "LANGMATCHES"
qshow DataTypeFunc = "DATATYPE"
qshow BoundFunc = "BOUND"
qshow SameTermFunc = "sameTerm"
qshow IsIRIFunc = "isIRI"
qshow IsURIFunc = "isURI"
qshow IsBlankFunc = "isBlank"
qshow IsLiteralFunc = "isLiteral"
qshow RegexFunc = "REGEX"
qshow StrLenFunc = "STRLEN"
qshow SubStrFunc = "SUBSTR"
qshow UcaseFunc = "UCASE"
qshow LcaseFunc = "LCASE"
qshow StrStartsFunc = "STRSTARTS"
qshow StrEndsFunc = "STARTENDS"
qshow ContainsFunc = "CONTAINS"
qshow StrBeforeFunc = "STRBEFORE"
qshow StrAfterFunc = "STRAFTER"
qshow ConcatFunc = "CONCAT"
qshow ReplaceFunc = "REPLACE"
qshow AbsFunc = "ABS"
qshow RoundFunc = "ROUND"
qshow CeilFunc = "CEIL"
qshow FloorFunc = "FLOOR"
qshow RandFunc = "RAND"
instance QueryShow ParameterizedFunction where
qshow GroupConcat = "GROUP_CONCAT"
instance QueryShow Expr where
qshow = qshow'
where qshow' (VarOrTermExpr vt) = qshow vt
qshow' (OrExpr es) = wrap $ intercalate " || " $ map qshow es
qshow' (AndExpr es) = wrap $ intercalate " && " $ map qshow es
qshow' (NegatedExpr e') = wrap $ '!' : qshow e'
qshow' (RelationalExpr rel e1 e2) = wrap $ qshow e1 ++ qshow rel ++ qshow e2
qshow' (NumericExpr e') = wrap $ qshow e'
qshow' (BuiltinCall f es) = wrap $ qshow f ++ "(" ++ intercalate ", " (map qshow es) ++ ")"
qshow' (ParameterizedCall f es kwargs) = wrap $ qshow f ++ "(" ++ intercalate ", " (map qshow es) ++ " ; " ++ (intercalate "," $ map pair kwargs) ++ ")"
wrap e = "(" ++ e ++ ")"
pair (k, v) = k ++ "=" ++ v
instance QueryShow SelectExpr where
qshow (SelectVar v) = qshow v
qshow (SelectExpr e v) = mconcat ["(", qshow e, " AS ", qshow v, ")"]
instance QueryShow [SelectExpr] where
qshow = intercalate " " . fmap qshow
instance QueryShow Pattern where
qshow (QTriple a b c) = intercalate " " [qshow a, qshow b, qshow c, "."]
qshow (Filter e) = "FILTER " ++ qshow e ++ " ."
qshow (Bind e v) = "BIND(" ++ qshow e ++ " AS " ++ qshow v ++ ")"
qshow (OptionalGraphPattern p) = "OPTIONAL " ++ qshow p
qshow (UnionGraphPattern p1 p2) = qshow p1 ++ " UNION " ++ qshow p2
qshow (ExistsPattern p) = "EXISTS" ++ qshow p
qshow (NotExistsPattern p) = "NOT EXISTS" ++ qshow p
qshow (SubQuery qd) = intercalate " " ["{", qshow qd, "}"]
instance QueryShow [Pattern] where
qshow = unwords . fmap qshow
instance QueryShow GroupGraphPattern where
qshow (GroupGraphPattern ps) = "{" ++ qshow ps ++ "}"
instance QueryShow GroupBy where
qshow (GroupBy e) = qshow e
instance QueryShow [GroupBy] where
qshow [] = ""
qshow gs = unwords $ "GROUP BY" : fmap qshow gs
instance QueryShow OrderBy where
qshow (Asc e) = "ASC(" ++ qshow e ++ ")"
qshow (Desc e) = "DESC(" ++ qshow e ++ ")"
instance QueryShow [OrderBy] where
qshow [] = ""
qshow os = unwords $ "ORDER BY" : fmap qshow os
instance QueryShow QueryData where
qshow qd = query
where prefixDecl = qshow (prefixes qd)
whereClause = unwords ["WHERE", qshow (pattern qd)]
groupClause = qshow . groups $ qd
orderClause = qshow . ordering $ qd
limitOffsetClauses = qshow (limits qd)
solutionModifier = unwords' [groupClause, orderClause, limitOffsetClauses]
query = case queryType qd of
SelectType ->
unwords' [ prefixDecl
, "SELECT"
, qshow (duplicates qd)
, qshow (vars qd)
, whereClause
, solutionModifier
]
ConstructType ->
unwords [ prefixDecl
, "CONSTRUCT {"
, qshow (constructTriples qd)
, "}"
, whereClause
]
DescribeType ->
unwords [ prefixDecl
, "DESCRIBE"
, qshow (describeURI qd)
, whereClause
]
AskType ->
unwords [ prefixDecl
, "ASK {"
, qshow (askTriples qd)
, "}"
]
UpdateType ->
unwords [ prefixDecl
, "INSERT DATA {"
, qshow (updateTriples qd)
, "}"
]
TypeNotSet ->
error "instance QueryShow QueryData: TypeNotSet not supported."
escapeSpecialChar :: T.Text -> T.Text
escapeSpecialChar = T.concatMap handleChar
where handleChar '\n' = "\n"
handleChar '\t' = "\t"
handleChar '\r' = "\r"
handleChar '"' = "\\\""
handleChar '\\' = "\\\\"
handleChar c = T.singleton c
{-# NOINLINE [1] unwords' #-}
unwords' :: [String] -> String
unwords' [] = ""
unwords' ("":ws) = unwords' ws
unwords' (w:ws) = w ++ go ws
where
go [] = ""
go ("":vs) = go vs
go (v:vs) = ' ' : (v ++ go vs)
(|>) :: NonEmpty a -> a -> NonEmpty a
xs |> x = NE.fromList $ NE.toList xs ++ [x]