Doug Burke avatar Doug Burke committed 5d47d61

Formatting: more minor refactoring

Comments (0)

Files changed (4)

src/Swish/RDF/Formatter/Internal.hs

     , PredTree
     , LabelContext(..)
     , NodeGenState(..)
+    , changeState
+    , hasMore
     , emptyNgs 
+    , getBNodeLabel
     , findMaxBnode
     , getCollection
     , processArcs
                        )
 import Swish.RDF.Vocabulary (LanguageTag, fromLangTag, xsdBoolean, xsdDecimal, xsdInteger, xsdDouble)
 
+import Control.Monad (liftM)
+import Control.Monad.State (State, get, put)
+
 import Data.List (delete, foldl', groupBy)
-import Data.Monoid (mconcat)
+import Data.Monoid (Monoid(..), mconcat)
 import Data.Word
 
 import Network.URI (URI)
 type SubjTree lb = [(lb,PredTree lb)]
 type PredTree lb = [(lb,[lb])]
 
--- simple context for label creation
--- (may be a temporary solution to the problem
---  of label creation)
+-- | The context for label creation.
 --
 data LabelContext = SubjContext | PredContext | ObjContext
                     deriving (Eq, Show)
 
+-- | A generator for BNode labels.
 data NodeGenState = Ngs
-    { prefixes  :: NamespaceMap
+    { prefixes  :: NamespaceMap          -- TODO: why do we have prefixes in here? should be in parent state (if needed)
     , nodeMap   :: NodeGenLookupMap
     , nodeGen   :: Word32
     }
 
+-- | Create an empty node generator.
 emptyNgs :: NodeGenState
 emptyNgs = Ngs
     { prefixes  = M.empty
     }
 
 {-|
+Get the label text for the blank node, creating a new one
+if it has not been seen before.
+
+The label text is currently _:swish<number> where number is
+1 or higher. This format may be changed in the future.
+-}
+getBNodeLabel :: RDFLabel -> NodeGenState -> (B.Builder, Maybe NodeGenState)
+getBNodeLabel lab ngs = 
+    let cmap = nodeMap ngs
+        cval = nodeGen ngs
+
+        (lnum, mngs) = 
+            case M.findWithDefault 0 lab cmap of
+              0 -> let nval = succ cval
+                       nmap = M.insert lab nval cmap
+                   in (nval, Just (ngs { nodeGen = nval, nodeMap = nmap }))
+
+              n -> (n, Nothing)
+
+    in ("_:swish" `mappend` B.fromString (show lnum), mngs)
+
+
+{-|
+Process the state, returning a value extracted from it
+after updating the state.
+-}
+
+changeState ::
+    (a -> (b, a)) -> State a b
+changeState f = do
+  st <- get
+  let (rval, nst) = f st
+  put nst
+  return rval
+
+{-|
+Apply the function to the state and return True
+if the result is not empty.
+-}
+
+hasMore :: (a -> [b]) -> State a Bool
+hasMore lens = (not . null . lens) `liftM` get
+
+
+{-|
 Removes the first occurrence of the item from the
 association list, returning it's contents and the rest
 of the list, if it exists.

src/Swish/RDF/Formatter/N3.hs

 
 import Swish.RDF.Formatter.Internal (NodeGenLookupMap, SubjTree, PredTree
                                     , LabelContext(..)
-                                    , NodeGenState(..), emptyNgs
+                                    , NodeGenState(..)
+                                    , changeState
+                                    , hasMore
+                                    , emptyNgs
+                                    , getBNodeLabel
                                     , findMaxBnode
                                     , processArcs
 				    , quoteB
 setGraph :: RDFGraph -> Formatter ()
 setGraph = modify . newState
 
-hasMore :: (N3FormatterState -> [b]) -> Formatter Bool
-hasMore lens = (not . null . lens) `liftM` get
-
 moreSubjects :: Formatter Bool
 moreSubjects = hasMore subjs
 
 moreObjects = hasMore objs
 
 nextSubject :: Formatter RDFLabel
-nextSubject = do
-  st <- get
-
-  let sb:sbs = subjs st
-      nst = st  { subjs = sbs
-                , props = snd sb
-                , objs  = []
-                }
-
-  put nst
-  return $ fst sb
+nextSubject = 
+    changeState $ \st -> 
+        let (a,b):sbs = subjs st
+            nst = st  { subjs = sbs
+                      , props = b
+                      , objs  = []
+                      }
+        in (a, nst)
 
 nextProperty :: RDFLabel -> Formatter RDFLabel
-nextProperty _ = do
-  st <- get
-
-  let pr:prs = props st
-      nst = st  { props = prs
-                 , objs  = snd pr
-                 }
-
-  put nst
-  return $ fst pr
-
+nextProperty _ =
+    changeState $ \st ->
+        let (a,b):prs = props st
+            nst = st  { props = prs
+                      , objs  = b
+                      }
+        in (a, nst)
+        
 nextObject :: RDFLabel -> RDFLabel -> Formatter RDFLabel
-nextObject _ _ = do
-  st <- get
-
-  let ob:obs = objs st
-      nst = st { objs = obs }
-
-  put nst
-  return ob
+nextObject _ _ =
+    changeState $ \st ->
+        let ob:obs = objs st
+            nst = st { objs = obs }
+        in (ob, nst)
 
 nextLine :: B.Builder -> Formatter B.Builder
 nextLine str = do
 mapBlankNode :: RDFLabel -> Formatter B.Builder
 mapBlankNode lab = do
   ngs <- getNgs
-  let cmap = nodeMap ngs
-      cval = nodeGen ngs
-  nv <- case M.findWithDefault 0 lab cmap of
-    0 -> do 
-      let nval = succ cval
-          nmap = M.insert lab nval cmap
-      setNgs $ ngs { nodeGen = nval, nodeMap = nmap }
-      return nval
-      
-    n -> return n
-  
-  -- TODO: is this what we want?
-  return $ "_:swish" `mappend` B.fromString (show nv)
+  let (lval, mngs) = getBNodeLabel lab ngs
+  case mngs of
+    Just ngs' -> setNgs ngs'
+    _ -> return ()
+  return lval
 
 --------------------------------------------------------------------------------
 --

src/Swish/RDF/Formatter/NTriples.hs

     )
 where
 
-import Swish.RDF.Formatter.Internal (NodeGenLookupMap)
+import Swish.RDF.Formatter.Internal ( NodeGenLookupMap
+                                    , NodeGenState(..)
+                                    , emptyNgs
+                                    , getBNodeLabel
+                                    )
 
 import Swish.GraphClass (Arc(..))
 import Swish.Namespace (ScopedName, getQName)
 --
 --  This is a lot simpler than other formatters.
 
+type NTFormatterState = NodeGenState
+
+{-
 data NTFormatterState = NTFS { 
       ntfsNodeMap :: NodeGenLookupMap,
       ntfsNodeGen :: Word32
     } deriving Show
+-}
 
 emptyNTFS :: NTFormatterState
+emptyNTFS = emptyNgs
+{-
 emptyNTFS = NTFS {
               ntfsNodeMap = M.empty,
               ntfsNodeGen = 0
               }
+-}
 
 type Formatter a = State NTFormatterState a
 
 -- just in case rather than failing
 formatLabel lab = return $ B.fromString $ show lab
 
+{-
 mapBlankNode :: RDFLabel -> Formatter B.Builder
 mapBlankNode lab = do
   st <- get
             n -> return n
 
   return $ "_:swish" `mappend` B.fromString (show nv)
+-}
+
+mapBlankNode :: RDFLabel -> Formatter B.Builder
+mapBlankNode lab = do
+  ngs <- get
+  let (lval, mngs) = getBNodeLabel lab ngs
+  case mngs of
+    Just ngs' -> put ngs'
+    _ -> return ()
+  return lval
+  
 
 -- TODO: can we use Network.URI to protect the URI?
 showScopedName :: ScopedName -> B.Builder

src/Swish/RDF/Formatter/Turtle.hs

 
 import Swish.RDF.Formatter.Internal (NodeGenLookupMap, SubjTree, PredTree
                                     , LabelContext(..)
-                                    , NodeGenState(..), emptyNgs
+                                    , NodeGenState(..)
+                                    , changeState
+                                    , hasMore
+                                    , emptyNgs
+                                    , getBNodeLabel
                                     , findMaxBnode
                                     , processArcs
                                     , formatScopedName
 setGraph :: RDFGraph -> Formatter ()
 setGraph = modify . newState
 
-hasMore :: (TurtleFormatterState -> [b]) -> Formatter Bool
-hasMore lens = (not . null . lens) `liftM` get
-
 moreSubjects :: Formatter Bool
 moreSubjects = hasMore subjs
 
 moreObjects = hasMore objs
 
 nextSubject :: Formatter RDFLabel
-nextSubject = do
-  st <- get
-
-  let sb:sbs = subjs st
-      nst = st  { subjs = sbs
-                , props = snd sb
-                , objs  = []
-                }
-
-  put nst
-  return $ fst sb
+nextSubject = 
+    changeState $ \st -> 
+        let (a,b):sbs = subjs st
+            nst = st  { subjs = sbs
+                      , props = b
+                      , objs  = []
+                      }
+        in (a, nst)
 
 nextProperty :: RDFLabel -> Formatter RDFLabel
-nextProperty _ = do
-  st <- get
-
-  let pr:prs = props st
-      nst = st  { props = prs
-                 , objs  = snd pr
-                 }
-
-  put nst
-  return $ fst pr
-
+nextProperty _ =
+    changeState $ \st ->
+        let (a,b):prs = props st
+            nst = st  { props = prs
+                      , objs  = b
+                      }
+        in (a, nst)
+        
 nextObject :: RDFLabel -> RDFLabel -> Formatter RDFLabel
-nextObject _ _ = do
-  st <- get
-
-  let ob:obs = objs st
-      nst = st { objs = obs }
-
-  put nst
-  return ob
+nextObject _ _ =
+    changeState $ \st ->
+        let ob:obs = objs st
+            nst = st { objs = obs }
+        in (ob, nst)
 
 nextLine :: B.Builder -> Formatter B.Builder
 nextLine str = do
 mapBlankNode :: RDFLabel -> Formatter B.Builder
 mapBlankNode lab = do
   ngs <- getNgs
-  let cmap = nodeMap ngs
-      cval = nodeGen ngs
-  nv <- case M.findWithDefault 0 lab cmap of
-    0 -> do 
-      let nval = succ cval
-          nmap = M.insert lab nval cmap
-      setNgs $ ngs { nodeGen = nval, nodeMap = nmap }
-      return nval
-      
-    n -> return n
-  
-  -- TODO: is this what we want?
-  return $ "_:swish" `mappend` B.fromString (show nv)
+  let (lval, mngs) = getBNodeLabel lab ngs
+  case mngs of
+    Just ngs' -> setNgs ngs'
+    _ -> return ()
+  return lval
 
 --------------------------------------------------------------------------------
 --
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.