blob: 1f4d74bf3a64ecb9ba2bd451dddf0e9c64bcde68 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
{- DBpedia.hs -- requesting ages from DBpedia
Copyright (C) 2012 Benjamin Barenblat <benjamin@barenblat.name>
This module is a part of ageOf.
ageOf is free software: you can redistribute it and/or modify it under the
terms of the GNU General Public License as published by the Free Software
Foundation, either version 3 of the License, or (at your option) any later
version.
ageOf is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE. See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with
ageOf. If not, see <http://www.gnu.org/licenses/>. -}
module DBpedia (dbpedia) where
import Control.Monad (void)
import Database.HSparql.Connection
import Database.HSparql.QueryGenerator
import qualified Data.Time as Time (Day, parseTime)
import qualified Data.RDF as RDF (Node(..), LValue(..))
import qualified Data.Text as Text (unpack)
import System.CurrentLocale (currentLocale)
import System.Locale (TimeLocale)
import RequestMethod (RequestMethod(BirthDateFunction))
-- The DBpedia plugin, defined by the single function 'getBirthDate'.
dbpedia :: RequestMethod
dbpedia = BirthDateFunction getBirthDate
getBirthDate :: String -> IO (Maybe Time.Day)
getBirthDate name = do
locale <- currentLocale
response <- askDBpedia $ selectBirthDate name
return $ case response of
Nothing -> Nothing
Just Unbound -> Nothing
Just (Bound node) -> parseAsDate locale node
{- Generates a DBpedia SELECT query for a person's birth date. You can see the
generated query by running 'putStrLn $ createSelectQuery simpleSelect'. -}
selectBirthDate :: String -> Query SelectQuery
selectBirthDate name = do
-- Variables
page <- var
birthDate <- var
-- Prefixes
dbpprop <- prefix "dbprop" $ iriRef "http://dbpedia.org/property/"
rdfs <- prefix "rdfs" $ iriRef "http://www.w3.org/2000/01/rdf-schema#"
-- Okay, here we go.
let query = SelectQuery [birthDate]
void $ triple page (rdfs .:. "label") (name, "en")
void $ triple page (dbpprop .:. "birthDate") birthDate
return query
{- Runs a SELECT query for a single variable on DBpedia, returning the first
possible match. -}
askDBpedia :: Query SelectQuery -> IO (Maybe BindingValue)
askDBpedia q = do
result <- selectQuery "http://dbpedia.org/sparql" q
return $ case result of
Just ([x]:_) -> Just x
Just ((_:_):_) -> error "got more than one bound variable"
_ -> Nothing
-- Parses an RDF literal as a date.
parseAsDate :: TimeLocale -> RDF.Node -> Maybe Time.Day
parseAsDate locale (RDF.LNode node) =
let value =
case node of
RDF.PlainL v -> v
RDF.PlainLL v _lang -> v
RDF.TypedL v _type -> v
in parseXMLSchemaDate locale $ Text.unpack value
parseAsDate _ _ = Nothing
{- Parses a date somewhat as described in the XML Schema
<http://www.w3.org/TR/xmlschema-2/#date>. TODO: Handle large (>12-hour) time
zone offsets correctly. TODO: Handle BCE (negative) years correctly. -}
parseXMLSchemaDate :: TimeLocale -> String -> Maybe Time.Day
parseXMLSchemaDate locale dateString =
let expectedFormat =
if length dateString > length "YYYY-MM-DD"
then "%F%z" -- There's a time zone.
else "%F"
in Time.parseTime locale expectedFormat dateString
|
