Merge pull request #115 from pniedzielski/rdfs-comment-to-haddock

Use `rdfs:comment` string to generate documentation

README.md

@@ -18,7 +18,7 @@ For details see the GitHub project page:
 
 http://robstewart57.github.io/rdf4h/
 
-Supports GHC versions from 8.0.2 (stackage lts-9) to 8.8.3 (stackage lts-16.0).
+Supports GHC versions from 9.2.5 (stackage lts-20.11).
 
 ### Development with Nix and direnv
 

rdf4h.cabal

@@ -21,7 +21,7 @@ cabal-version:   >= 1.10
 build-type:      Simple
 category:        RDF
 stability:       stable
-tested-with:     GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.5, GHC==8.8.3
+tested-with:     GHC==9.2.5
 extra-tmp-files: test
 extra-source-files: examples/ParseURLs.hs
                   , examples/ESWC.hs
@@ -97,7 +97,7 @@ library
                  , selective
                  , html-entities
                  , xeno
-                 , template-haskell
+                 , template-haskell >= 2.18.0
   other-modules:   Text.RDF.RDF4H.XmlParser.Xmlbf
                  , Text.RDF.RDF4H.XmlParser.Xeno
   if impl(ghc < 7.6)

src/Data/RDF/Vocabulary/Generator/VocabularyGenerator.hs

@@ -6,19 +6,23 @@ module Data.RDF.Vocabulary.Generator.VocabularyGenerator
   )
 where
 
+import Control.Monad (join)
 import Data.Char (isLower)
-import Data.List (nub)
+import Data.List (nub, sortBy)
 import qualified Data.Map as M
 import Data.Maybe (maybeToList)
 import Data.RDF
   ( AdjHashMap,
-    Node (UNode),
+    LValue (..),
+    Node (..),
     PrefixMappings (PrefixMappings),
     RDF,
     Rdf,
     TurtleParser (TurtleParser),
+    objectOf,
     parseFile,
     prefixMappings,
+    query,
     subjectOf,
     triplesOf,
   )
@@ -50,29 +54,33 @@ genVocabulary ::
   -- | the filepath of the file containing the schema in RDF Turtle format.
   String ->
   Q [Dec]
-genVocabulary file = vocabulary <$> runIO (loadGraph file)
+genVocabulary file = runIO (loadGraph file) >>= vocabulary
 
 loadGraph :: String -> IO (RDF AdjHashMap)
 loadGraph file =
   parseFile (TurtleParser Nothing Nothing) file >>= \result -> case result of
     Left err -> error $ show err
     Right rdfGraph -> return rdfGraph
 
-vocabulary :: Rdf a => RDF a -> [Dec]
+vocabulary :: Rdf a => RDF a -> Q [Dec]
 vocabulary graph =
   let nameDecls = do
         subject <- nub $ subjectOf <$> triplesOf graph
         iri <- maybeToList $ toIRI subject
         name <- maybeToList $ iriToName iri
-        return (name, declareIRI name iri)
+        let comment = combineComments .
+                      sequenceA .
+                      fmap (nodeToComment . objectOf) $
+                      query graph (Just subject) (Just rdfsCommentNode) Nothing
+        return (name, declareIRI name iri comment)
       (PrefixMappings prefixMappings') = prefixMappings graph
       namespaceDecls = do
         (prefix, iri) <- M.toList prefixMappings'
         let name = mkName . T.unpack . escape $ prefix <> "NS"
         return $ declarePrefix name prefix iri
-      iriDecls = snd <$> nameDecls
+      iriDecls = fmap snd . sortBy (\x y -> fst y `compare` fst x) $ nameDecls
       irisDecl = declareIRIs $ fst <$> nameDecls
-   in irisDecl : namespaceDecls <> iriDecls
+   in sequence $ irisDecl : namespaceDecls <> iriDecls
 
 toIRI :: Node -> Maybe Text
 toIRI (UNode iri) = Just iri
@@ -87,24 +95,47 @@ unodeFun = VarE $ mkName "Data.RDF.Types.unode"
 mkPrefixedNSFun :: Exp
 mkPrefixedNSFun = VarE $ mkName "Data.RDF.Namespace.mkPrefixedNS"
 
-declareIRI :: Name -> Text -> Dec
-declareIRI name iri =
+nodeToComment :: Node -> Maybe Text
+nodeToComment (UNode uri)           = Just $ "See \\<<" <> uri <> ">\\>."
+nodeToComment (BNode _)             = Nothing
+nodeToComment (BNodeGen _)          = Nothing
+nodeToComment (LNode (PlainL l))    = Just l
+nodeToComment (LNode (PlainLL l _)) = Just l
+nodeToComment (LNode (TypedL l _))  = Just l
+
+combineComments :: Maybe [Text] -> Maybe Text
+combineComments = join . fmap combineComments'
+  where
+    combineComments' [] = Nothing
+    combineComments' comments = Just . T.intercalate "\n" $ comments
+
+rdfsCommentNode :: Node
+rdfsCommentNode = UNode "http://www.w3.org/2000/01/rdf-schema#comment"
+
+declareIRI :: Name -> Text -> Maybe Text -> Q Dec
+declareIRI name iri comment =
   let iriLiteral = LitE . StringL $ T.unpack iri
       unodeLiteral = AppE unodeFun $ AppE packFun iriLiteral
-   in FunD name [Clause [] (NormalB unodeLiteral) []]
+   in funD_doc name [return $ Clause [] (NormalB unodeLiteral) []]
+               (T.unpack <$> comment)
+               [Nothing]
 
-declareIRIs :: [Name] -> Dec
+declareIRIs :: [Name] -> Q Dec
 declareIRIs names =
   let iriList = ListE (VarE <$> names)
-   in FunD (mkName "iris") [Clause [] (NormalB iriList) []]
+   in funD_doc (mkName "iris") [return $ Clause [] (NormalB iriList) []]
+               (Just $ "All IRIs in this vocabulary.")
+               [Nothing]
 
 -- namespace = mkPrefixedNS "ogit" "http://www.purl.org/ogit/"
-declarePrefix :: Name -> Text -> Text -> Dec
+declarePrefix :: Name -> Text -> Text -> Q Dec
 declarePrefix name prefix iri =
   let prefixLiteral = AppE packFun . LitE . StringL . T.unpack $ prefix
       iriLiteral = AppE packFun . LitE . StringL . T.unpack $ iri
       namespace = AppE (AppE mkPrefixedNSFun prefixLiteral) iriLiteral
-   in FunD name [Clause [] (NormalB namespace) []]
+   in funD_doc name [return $ Clause [] (NormalB namespace) []]
+               (Just $ "Namespace prefix for \\<<" <> T.unpack iri <> ">\\>.")
+               [Nothing]
 
 iriToName :: Text -> Maybe Name
 iriToName iri = mkName . T.unpack . escape <$> (lastMay . filter (not . T.null) . T.split (`elem` separators)) iri

stack.yaml

@@ -1,18 +1,7 @@
-resolver: lts-16.6
+resolver: lts-20.11
 packages:
 - '.'
 extra-deps:
-- algebraic-graphs-0.5
-- unordered-containers-0.2.10.0
-- selective-0.3
-- html-entities-1.1.4.3
-- mmorph-1.1.3
-- exceptions-0.10.4
-- semigroups-0.18.3
-- xeno-0.3.5.2
-- Cabal-3.2.0.0@sha256:d0d7a1f405f25d0000f5ddef684838bc264842304fd4e7f80ca92b997b710874,27320
-- parsec-3.1.14.0
-- text-1.2.4.0
 
 # for weeder tool
 #   https://github.com/ndmitchell/weeder