packages feed

swish 0.3.2.0 → 0.3.2.1

raw patch · 16 files changed

+173/−146 lines, 16 files

Files

Swish/RDF/ClassRestrictionRule.hs view
@@ -66,18 +66,14 @@     , bwdCheckInference     ) -import Swish.RDF.VarBinding-    ( VarBinding(..)-    )+import Swish.RDF.VarBinding (VarBinding(..))  import Swish.Utils.Namespace     ( Namespace(..)     , ScopedName(..)     ) -import Swish.RDF.Vocabulary-    ( namespaceRDFD-    )+import Swish.RDF.Vocabulary (namespaceRDFD)  import Swish.Utils.PartOrderedCollection     ( minima, maxima@@ -91,19 +87,12 @@     , mapFindMaybe     ) -import Swish.Utils.ListHelpers-    ( powerSet )--import Data.Maybe (isJust, fromJust, fromMaybe, mapMaybe)--import Data.List-    ( delete, nub, (\\) )+import Swish.Utils.ListHelpers (powerSet) -import Control.Monad-    ( liftM )+import Control.Monad (liftM) -import Swish.Utils.TraceHelpers-    ( trace )+import Data.Maybe (isJust, fromJust, fromMaybe, mapMaybe)+import Data.List (delete, nub, (\\))  ------------------------------------------------------------ --  Class restriction data type@@ -196,16 +185,6 @@ makeRestrictionRule1 ::     [ClassRestriction] -> RDFGraph -> RDFVarBinding -> Maybe RDFRule makeRestrictionRule1 crs gr vb =-    {--    trace "\nmakeRestrictionRule1:" $-    -- seq (traceShow "\ngr:" gr)-    seq (traceShow "\nvb:" vb) $-    seq (traceShow "\nc:" c) $-    seq (traceShow "\np:" p) $-    seq (traceShow "\nr:" r) $-    seq (traceShow "\nps:" ps) $-    -- seq (traceShow "\nrn:" rn) $-    -}     makeRestrictionRule2 rn c ps cs     where         c  = fromMaybe NoNode $ vbMap vb (Var "c")@@ -220,11 +199,6 @@     Maybe ClassRestriction -> RDFLabel -> [RDFLabel] -> [Int]     -> Maybe RDFRule makeRestrictionRule2 (Just restriction) cls@(Res cname) props cs =-    {--    trace "\nmakeRestrictionRule2:" $-    seq (traceShow "\ncls:" cls)-    seq (traceShow "\nprops:" props) $-    -}     Just restrictionRule     where         restrictionRule = Rule@@ -235,9 +209,8 @@             , bwdApply = bwdApplyRestriction restriction cls props cs             , checkInference = bwdCheckInference restrictionRule             }-makeRestrictionRule2 _ _ _ _ =-    trace "\nmakeRestrictionRule: missing class restriction"-    Nothing+makeRestrictionRule2 _ _ _ _ = Nothing+    -- trace "\nmakeRestrictionRule: missing class restriction"  --  Forward apply class restriction. fwdApplyRestriction ::@@ -266,12 +239,6 @@     ClassRestriction -> RDFLabel -> [RDFLabel] -> [Int] -> RDFGraph     -> Maybe [RDFGraph] fwdApplyRestriction1 restriction ci props cs antgr =-    {--    trace "\nfwdApplyRestriction1:" $-    seq (traceShow "\nci:" ci)-    seq (traceShow "\nprops:" props)-    seq (traceShow "\nantgr:" antgr) $-    -}     if grConsistent then Just newgrs else Nothing     where         --  Apply restriction to graph@@ -318,12 +285,6 @@     -> Maybe [[RDFGraph]] bwdApplyRestriction1 restriction cls ci props cs congr =     if grConsistent then Just grss else Nothing-    {--    trace "\nfwdApplyRestriction1:" $-    seq (traceShow "\nci:" ci)-    seq (traceShow "\nprops:" props)-    seq (traceShow "\ncongr:" congr) $-    -}     where         --  Apply restriction to graph         (grConsistent,pvs,cts,_) =
Swish/RDF/GraphClass.hs view
@@ -34,7 +34,7 @@ import qualified Data.Foldable as F import qualified Data.Traversable as T -import Data.List (union, (\\))+import Data.List (foldl', union, (\\))  --  NOTE:  I wanted to declare this as a subclass of Functor, but --  the constraint on the label type seems to prevent that.@@ -78,13 +78,13 @@     -- that is, any label that appears in the subject,     -- predicate or object position of an `Arc`.     labels      :: lg lb -> [lb]-    labels g    = foldl union [] (map arcLabels (getArcs g))+    labels g    = foldl' union [] (map arcLabels (getArcs g))          -- | Enumerate the distinct nodes contained in a graph;     -- that is, any label that appears in the subject     -- or object position of an `Arc`.     nodes       :: lg lb -> [lb]-    nodes g     = foldl union [] (map arcNodes (getArcs g))+    nodes g     = foldl' union [] (map arcNodes (getArcs g))          -- | Test for graph containment in another.     --
Swish/RDF/GraphMatch.hs view
@@ -32,15 +32,19 @@         graphMatch1, graphMatch2, equivalenceClasses, reclassify       ) where -import Swish.Utils.LookupMap-import Swish.Utils.ListHelpers-import Swish.Utils.MiscHelpers--- import Swish.Utils.TraceHelpers( trace, traceShow )-import Swish.RDF.GraphClass import Data.Ord (comparing)-import Data.List( nub, sortBy, partition )+import Data.List (foldl', nub, sortBy, partition) import qualified Data.List +import Swish.RDF.GraphClass (Arc(..), Label(..),+                             arc, arcSubj, arcPred, arcObj, arcLabels,+                             hasLabel, arcToTriple)+import Swish.Utils.LookupMap (LookupEntryClass(..), LookupMap(..),+                              makeLookupMap, listLookupMap, mapFind, mapReplaceAll,+                              mapAddIfNew, mapReplaceMap, mapMerge)+import Swish.Utils.ListHelpers (select, equiv, pairSort, pairGroup, pairUngroup)+import Swish.Utils.MiscHelpers (assert, hash, hashModulus)+ -------------------------- --  Label index value type --------------------------@@ -361,7 +365,7 @@ showLabelMap :: (Label lb) => LabelMap lb -> String showLabelMap (LabelMap gn lmap) =     "LabelMap gen="++ Prelude.show gn ++", map="++-    foldl (++) "" (map (("\n    "++) . Prelude.show) es)+    foldl' (++) "" (map (("\n    "++) . Prelude.show) es)     where         es = listLookupMap lmap @@ -416,8 +420,7 @@ --  value, as they may be matched with each other. -- assignLabelMap :: (Label lb) => [lb] -> LabelMap lb -> LabelMap lb-assignLabelMap ns lmap = foldl (flip assignLabelMap1) lmap ns--- TODO: foldl to foldl' ?+assignLabelMap ns lmap = foldl' (flip assignLabelMap1) lmap ns  assignLabelMap1 :: (Label lb) => lb -> LabelMap lb -> LabelMap lb assignLabelMap1 lab (LabelMap g lvs) = LabelMap g lvs'@@ -535,16 +538,6 @@  graphLabels :: (Label lb) => [Arc lb] -> [lb] graphLabels = nub . concatMap arcLabels--{-  OLD CODE:-graphLabels gs = graphLabels1 gs []--graphLabels1 (t:gs) ls = graphLabels1 gs $-                         foldl (flip addSetElem) ls (arcLabels t)-graphLabels1 [] ls     = ls--}---- addSetElem ::  lb -> [lb] -> [lb]  -- | Calculate a signature value for each arc that can be used in constructing an --   adjacency based value for a node.  The adjacancy value for a label is obtained
Swish/RDF/GraphPartition.hs view
@@ -29,14 +29,12 @@     -- , hasLabel, arcLabels     ) -import Data.List-    ( partition )+import Data.List (foldl', partition)  import Control.Monad.State     ( MonadState(..), State, evalState ) -import Data.Maybe-    ( isJust, fromJust, mapMaybe )+import Data.Maybe (isJust, fromJust, mapMaybe)   ------------------------------------------------------------@@ -476,7 +474,7 @@ -- |Reverse first argument, prepending the result to the second argument -- reverseTo :: [a] -> [a] -> [a]-reverseTo front back = foldl (flip (:)) back front+reverseTo front back = foldl' (flip (:)) back front  -- |Remove each element from a list, returning a list of pairs, --  each of which is the element removed and the list remaining.
Swish/RDF/Proof.hs view
@@ -34,7 +34,7 @@  import Swish.Utils.ListHelpers (subset) -import Data.List (union, intersect, intercalate)+import Data.List (union, intersect, intercalate, foldl') import Data.Maybe (catMaybes, isNothing)  ------------------------------------------------------------@@ -73,7 +73,7 @@  -- |Return list of axioms actually referenced by a proof proofAxiomsUsed :: Proof ex -> [Formula ex]-proofAxiomsUsed proof = foldl union [] $ map stepAxioms (proofChain proof)+proofAxiomsUsed proof = foldl' union [] $ map stepAxioms (proofChain proof)     where         stepAxioms st = stepAnt st `intersect` proofAxioms proof @@ -103,7 +103,7 @@ checkStep ::    (Expression ex)    => [Rule ex]   -- ^ rules-  -> [ex]        -- ^ a ntecedants+  -> [ex]        -- ^ antecedants   -> Step ex     -- ^ the step to validate   -> Bool        -- ^ @True@ if the step is valid 
Swish/RDF/RDFGraph.hs view
@@ -871,7 +871,7 @@  -- | List all nodes in graph formulae satisfying a supplied predicate formulaNodes :: (Label lb) => (lb -> Bool) -> NSGraph lb -> [lb]-formulaNodes p gr = foldl (unionNodes p) fkeys (map (allLabels p) fvals)+formulaNodes p gr = foldl' (unionNodes p) fkeys (map (allLabels p) fvals)     where         -- fm :: (Label lb) => FormulaMap lb         --                     LookupMap LookupFormula (NSGraph lb) lb
Swish/RDF/VarBinding.hs view
@@ -41,20 +41,13 @@     , makeLookupMap, mapFindMaybe     ) -import Swish.Utils.Namespace-    ( ScopedName(..) )--import Swish.RDF.Vocabulary-    ( swishName )--import Swish.Utils.ListHelpers-    ( equiv, subset, flist, headOrNothing, permutations )+import Swish.Utils.Namespace (ScopedName(..))+import Swish.RDF.Vocabulary (swishName)+import Swish.Utils.ListHelpers (equiv, subset, flist, headOrNothing, permutations) -import Data.Maybe-    ( mapMaybe, fromMaybe, isJust, fromJust, listToMaybe )+import Data.Maybe (mapMaybe, fromMaybe, isJust, fromJust, listToMaybe) -import Data.List-    ( find, intersect, union, (\\) )+import Data.List (find, intersect, union, (\\), foldl')   ------------------------------------------------------------@@ -377,8 +370,7 @@ composeSequence :: (Eq a) => [VarBindingModify a b]     -> Maybe (VarBindingModify a b) composeSequence [] = Just varBindingId-composeSequence (vbm:vbms) =-    foldl composePair (Just vbm) vbms+composeSequence (vbm:vbms) = foldl' composePair (Just vbm) vbms  -- |Compose a pair of variable binding modifiers, returning --  @Just (composed modifier)@, or @Nothing@.
Swish/Utils/DateTime.hs view
@@ -12,7 +12,8 @@ -- --  This Module defines a collection of date/time manipulation functions. It --  is deprecated - since it's functionality is available from other---  modules - and will be removed in a future release.+--  modules - and will be removed in the next minor release of Swish+--  (@0.3.3@). -- -------------------------------------------------------------------------------- --
Swish/Utils/ListHelpers.hs view
@@ -10,22 +10,58 @@ --  Stability   :  experimental --  Portability :  H98 -----  This module defines some generic list and related helper functions.+--  This module defines some generic list and related helper functions. Although+--  some routines are explicitly marked as deprecated, the intention is to+--  move this functionality into the modules that need it, or replace it by+--  other modules, where possible. -- -------------------------------------------------------------------------------- +{-+TODO:++The plan is to use modules such as Data.Set where appropriate.++-}+ module Swish.Utils.ListHelpers-      ( select, mapset, deleteIndex-      , subset, equiv, hasPartitions, addSetElem-      , headOrNothing-      , pairUngroup, pairsUngroup, pairSort, pairGroup-      , breakAll-      , powerSet, combinations-      , permutations, listProduct-      , powerSequences, powerSequences_len, powerSequences_inf-      , flist, ffold, allf, anyf, allp, anyp )+       ( -- list of Swish.RDF.xxx modules the routine is used in+         select  -- GraphMatch+       , deleteIndex -- Datatype+       , subset -- Proof, RDFProof, VarBinding [also defined in Utils.PartOrderedCollection]+       , equiv -- GraphMatch, RDFRuleset, SwishScript, VarBinding, Utils.LookupMap+       , addSetElem -- RDFGraph+       , headOrNothing -- VarBinding+       , pairUngroup -- GraphMatch+       , pairSort -- GraphMatch+       , pairGroup -- GraphMatch+       , breakAll -- SwishMain+       , powerSet -- ClassRestrictionRule, RDFProof+       , permutations -- VarBinding+       , listProduct -- RDFQuery+       , powerSequences_len -- RDFProof+       , flist -- Datatype, RDFProof, RDFRuleset, SwishScript, VarBinding+       , allp -- RDFQuery+       , anyp -- RDFQuery+        +        -- * Deprecated routines+        --+        -- | These routines will be removed at the next minor release of+        -- of Swish (@0.3.3@).+        --+       , mapset+       , pairsUngroup+       , ffold+       , hasPartitions+       , powerSequences+       , powerSequences_inf+       , allf+       , anyf+       , combinations -- used by powerSet+        +      ) where-+   import Data.Ord (comparing)   import Data.List (union, intersect, sortBy, groupBy) @@ -71,6 +107,9 @@  ------------------------------------------------------------ --  Set functions+--+--  NOTE: to change to Data.Set then Eq a constraint will +--        likely need changing to Ord a ------------------------------------------------------------  -- |Subset test
Swish/Utils/LookupMap.hs view
@@ -34,9 +34,16 @@     , mapApplyToAll, mapTranslate     , mapEq, mapKeys, mapVals     , mapSelect, mapMerge-    , mapSortByKey, mapSortByVal     , mapTranslateKeys, mapTranslateVals     , mapTranslateEntries, mapTranslateEntriesM++    -- * Deprecated routines+    --+    -- | These routines will be removed at the next minor release of+    -- of Swish (@0.3.3@).+    --+    , mapSortByKey, mapSortByVal+     )     where @@ -44,10 +51,16 @@ import qualified Data.Traversable as T import qualified Data.List as L +import Control.Arrow (first, second)+ import Data.Ord (comparing) -import Swish.Utils.ListHelpers ( equiv )+import Swish.Utils.ListHelpers (equiv) +-- this is in Data.Tuple in base 4.3+swap :: (a,b) -> (b,a)+swap (a,b) = (b,a)+ ------------------------------------------------------------ --  Class for lookup map entries ------------------------------------------------------------@@ -61,18 +74,24 @@     where         newEntry    :: (k,v) -> a         keyVal      :: a -> (k,v)+                 entryKey    :: a -> k-        entryKey e = k where (k,_) = keyVal e+        entryKey = fst . keyVal+                 entryVal    :: a -> v-        entryVal e = v where (_,v) = keyVal e+        entryVal = snd . keyVal+                                      entryEq     :: (Eq v) => a -> a -> Bool         entryEq e1 e2 = keyVal e1 == keyVal e2+                 entryShow   :: (Show v) => a -> String         entryShow e = show k ++ ":" ++ show v where (k,v) = keyVal e+                                                             kmap :: (LookupEntryClass a2 k2 v) => (k -> k2) -> a -> a2-        kmap f e    = newEntry (f $ entryKey e,entryVal e)+        kmap f = newEntry . first f . keyVal+                 vmap :: (LookupEntryClass a2 k v2) => (v -> v2) -> a -> a2-        vmap f e    = newEntry (entryKey e,f $ entryVal e)+        vmap f = newEntry . second f . keyVal  -- |Predefine a pair of appropriate values as a valid lookup table entry --  (i.e. an instance of LookupEntryClass).@@ -107,15 +126,16 @@ gLM :: LookupMap a -> [a] gLM (LookupMap es) = es +-- TODO:  See also 'mapEq'+--  (why not just use that for the Eq instance?  I don't know:  it's probably historic.)+--+ -- |Define equality of 'LookupMap' values based on equality of entries. -- --  (This is possibly a poor definition, as it is dependent on ordering --  of list members.  But it passes all current test cases, and is used --  only for testing.) -----  See also 'mapEq'---  (why not just use that here?  I don't know:  it's probably historic.)--- instance (Eq a) => Eq (LookupMap a) where     LookupMap es1 == LookupMap es2 = es1 == es2 @@ -160,7 +180,7 @@ -- reverseEntry :: (LookupEntryClass a1 k v, LookupEntryClass a2 v k)     => a1 -> a2-reverseEntry e = newEntry (v,k) where (k,v) = keyVal e+reverseEntry = newEntry . swap . keyVal  -- |Given a lookup map, return a new map that can be used --  in the opposite direction of lookup.@@ -174,10 +194,7 @@ -- keyOrder :: (LookupEntryClass a k v, Ord k)     =>  a -> a -> Ordering-keyOrder e1 e2 = compare k1 k2-    where-        (k1,_) = keyVal e1-        (k2,_) = keyVal e2+keyOrder = comparing entryKey  --  Local helper function to build a new LookupMap from --  a new entry and an exiting map.@@ -262,7 +279,7 @@     LookupMap a -> LookupMap a -> LookupMap a mapReplaceMap (LookupMap (e:es)) newmap = mapCons e' more where     more  = mapReplaceMap (LookupMap es) newmap-    e'    = newEntry (k,mapFind v k newmap)+    e'    = newEntry (k, mapFind v k newmap)     (k,v) = keyVal e mapReplaceMap (LookupMap []) _ = LookupMap [] @@ -343,13 +360,13 @@ -- mapKeys :: (LookupEntryClass a k v) =>     LookupMap a -> [k]-mapKeys (LookupMap es) = L.nub $ map (fst . keyVal) es+mapKeys (LookupMap es) = L.nub $ map entryKey es  -- |Return list of distinct values in a supplied LookupMap -- mapVals :: (Eq v, LookupEntryClass a k v) =>     LookupMap a -> [v]-mapVals (LookupMap es) = L.nub $ map (snd . keyVal) es+mapVals (LookupMap es) = L.nub $ map entryVal es  -- |Select portion of a lookup map that corresponds to --  a supplied list of keys@@ -359,7 +376,7 @@ mapSelect (LookupMap es) ks =     LookupMap $ filter (keyIn ks) es     where-        keyIn iks e = fst (keyVal e) `elem` iks+        keyIn iks e = entryKey e `elem` iks  -- |Merge two lookup maps, ensuring that if the same key appears --  in both maps it is associated with the same value.@@ -383,8 +400,6 @@ -- |Creates a new map that is the same as the supplied map, except --  that its entries are sorted by key value. -----  (What's this used for?  It should be redundant.)--- mapSortByKey :: (LookupEntryClass a k v, Ord k) =>     LookupMap a -> LookupMap a mapSortByKey (LookupMap es) =@@ -393,8 +408,6 @@ -- |Creates a new map that is the same as the supplied map, except --  that its entries are sorted by key value. -----  (What's this used for?  It should be redundant.)--- mapSortByVal :: (LookupEntryClass a k v, Ord v) =>     LookupMap a -> LookupMap a mapSortByVal (LookupMap es) =@@ -420,11 +433,11 @@ --  supplied map with complete entries replaced according to --  a supplied function. ----- Since 'LookupMap' now has a 'Functor' instance this is just 'fmap' mapTranslateEntries :: (a1 -> a2) -> LookupMap a1 -> LookupMap a2 mapTranslateEntries = fmap --- |A monadic form of `mapTranslateEntries`.+-- |A monadic form of `mapTranslateEntries` which is+-- the same as `Data.Traversable.mapM`. -- -- Since `LookupMap` now has a `Data.Traversable.Traversable` instance -- this is just `T.mapM`.
Swish/Utils/MiscHelpers.hs view
@@ -10,17 +10,29 @@ --  Stability   :  experimental --  Portability :  H98 -----  This module defines some generic list and related helper functions+--  This module defines a random set of helper functions --  used by the graph handling code. -- --------------------------------------------------------------------------------  module Swish.Utils.MiscHelpers-      ( assert, lower, stricmp, quote, hash, hashModulus )+      ( hash -- RDFGraph, GraphMem, GraphMatch+      , hashModulus -- GraphMatch+      +        -- * Deprecated routines+        --+        -- | These routines will be removed at the next minor release of+        -- of Swish (@0.3.3@).+        --+      , assert -- GraphMatch QUS: can we use Control.Exception.assert?+      , stricmp+      , lower -- Vocabulary+      , quote -- RDFGraph+ +      ) where -import Data.Char-    ( toLower )+import Data.Char (toLower)  ------------------------------------------------------------ --  assert test
Swish/Utils/PartOrderedCollection.hs view
@@ -21,16 +21,27 @@ -- -------------------------------------------------------------------------------- +-- at present the only user of this module is Swish.RDF.ClassRestrictionRule+ module Swish.Utils.PartOrderedCollection     ( PartCompare-    , minima, maxima-    , partCompareEq, partCompareOrd, partComparePair-    , partCompareListPartOrd, partCompareListOrd-    , partCompareMaybe, partCompareListMaybe+    , minima+    , maxima+    , partCompareEq+    , partComparePair+    , partCompareListMaybe     , partCompareListSubset+    , partCompareListPartOrd+    , partCompareMaybe+        +      -- the following are currently unused+    , partCompareOrd+    , partCompareListOrd      )-where+    where +import Data.List (foldl')+ ------------------------------------------------------------ --  Type of partial compare function ------------------------------------------------------------@@ -49,7 +60,7 @@ --  for which there is no larger element in the list. -- maxima :: PartCompare a -> [a] -> [a]-maxima cmp as = foldl add [] as+maxima cmp as = foldl' add [] as     where         add []     e = [e]         add ms@(m:mr) e = case cmp m e of
Swish/Utils/QName.hs view
@@ -59,7 +59,7 @@ newQName = QName  qnameFromPair :: (String,String) -> QName-qnameFromPair (ns,ln) = QName ns ln+qnameFromPair = uncurry QName  qnameFromURI :: String -> QName qnameFromURI = qnameFromPair . splitURI
Swish/Utils/ShowM.hs view
@@ -24,7 +24,14 @@ --------------------------------------------------------------------------------  module Swish.Utils.ShowM-    ( ShowM(..), showm+    ( ShowM(..), +      +      -- * Deprecated routine+      --+      -- | This routine will be removed at the next minor release of+      -- of Swish (@0.3.3@).+      --+      showm     ) where 
Swish/Utils/TraceHelpers.hs view
@@ -10,11 +10,8 @@ --  Stability   :  experimental --  Portability :  H98 -----  This module provides access to tracing functions from the pre-2003---  Hugs trace module.  Over time, it may accumulate other tracing---  functions that I find useful.------  This should probably just be replaced by "Debug.Trace".+--  This module is deprecated and will be removed in the next minor+--  release of Swish (@0.3.3@). -- -------------------------------------------------------------------------------- 
swish.cabal view
@@ -1,5 +1,5 @@ Name:               swish-Version:            0.3.2.0+Version:            0.3.2.1 Stability:          experimental License:            LGPL License-file:       LICENSE @@ -45,6 +45,9 @@   * Complete, ready-to-run, command-line and script-driven programs.   .   Changes:+  .+  [Version 0.3.2.1] Marked a number of routines from the Swish.Utils modules+  as deprecated. Use foldl' rather than foldl.   .   [Version 0.3.2.0] The N3 parser no longer assumes a set of pre-defined namespaces.   There is no API change worthy of a bump to the minor version number, but it