1 files changed, 90 insertions, 0 deletions
diff --git a/DBpedia.hs b/DBpedia.hs
new file mode 100644
index 0000000..1f4d74b
--- /dev/null
+++ b/DBpedia.hs
@@ -0,0 +1,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