WordNet 1.0.0 → 1.1.0
raw patch · 8 files changed
+109/−94 lines, 8 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- NLP/WordNet.hs +14/−18
- NLP/WordNet/Common.hs +7/−15
- NLP/WordNet/Consts.hs +6/−1
- NLP/WordNet/PrimTypes.hs +17/−7
- NLP/WordNet/Prims.hs +36/−35
- NLP/WordNet/Types.hs +1/−6
- NLP/WordNet/Util.hs +25/−9
- WordNet.cabal +3/−3
NLP/WordNet.hs view
@@ -61,19 +61,12 @@ ) where -import Prelude hiding (catch)-import Data.Array-import GHC.Arr (unsafeIndex)-import GHC.IO.Handle+import Prelude import Data.Tree-import Data.IORef-import Data.Dynamic import qualified Data.Set as Set-import Numeric (readHex, readDec) import System.IO.Unsafe import NLP.WordNet.Common-import NLP.WordNet.Consts import NLP.WordNet.Util import NLP.WordNet.Types @@ -144,7 +137,7 @@ strM <- P.getIndexString ?wne word pos case strM of Nothing -> return Nothing- Just s -> unsafeInterleaveIO $ P.indexLookup ?wne word pos+ Just _ -> unsafeInterleaveIO $ P.indexLookup ?wne word pos -- | This takes an 'Overview' (see 'getOverview'), a 'POS' and a 'SenseType' and returns -- a list of search results. If 'SenseType' is 'AllSenses', there will be one@@ -159,9 +152,9 @@ let numSenses = T.indexSenseCount idx skL <- mapMaybe id `liftM` unsafeInterleaveIO (- mapM (\sense -> do- skey <- P.indexToSenseKey ?wne idx sense- return (liftM ((,) sense) skey)+ mapM (\sense' -> do+ skey <- P.indexToSenseKey ?wne idx sense'+ return (liftM ((,) sense') skey) ) (sensesOf numSenses sense) ) r <- unsafeInterleaveIO $ mapM (\ (snum, skey) ->@@ -180,7 +173,7 @@ -- | This takes a 'Word', a 'POS' and a 'SenseType' and returns -- the equivalent of first running 'getOverview' and then 'searchByOverview'. search :: WN (Word -> POS -> SenseType -> [SearchResult])-search word pos sense = searchByOverview (getOverview word) pos sense+search word = searchByOverview (getOverview word) -- | This takes a 'Key' (see 'srToKey' and 'srFormKeys') and looks it -- up in the databse.@@ -236,6 +229,7 @@ addToBag = flip (:) isEmptyBag = null splitBag (x:xs) = (x, xs)+ splitBag [] = undefined -- | A very slow queue based on lists. newtype Queue a = Queue [a] deriving (Show)@@ -245,6 +239,7 @@ addToBag (Queue l) a = Queue (l++[a]) isEmptyBag (Queue l) = null l splitBag (Queue (x:xs)) = (x, Queue xs)+ splitBag (Queue []) = undefined addListToBag (Queue l) l' = Queue (l ++ l') -- | An empty stack.@@ -314,6 +309,11 @@ t1 = closureOn Hypernym sr1 t2 = closureOn Hypernym sr2 +meetSearchPaths :: Bag b (Tree SearchResult)+ => b (Tree SearchResult)+ -> Tree SearchResult+ -> Tree SearchResult+ -> Maybe ([SearchResult], SearchResult, [SearchResult]) meetSearchPaths emptyBg t1 t2 = let srch b v1 v2 bag1 bag2 | isEmptyBag bag1 && isEmptyBag bag2 = Nothing@@ -330,9 +330,5 @@ bag2 (addListToBag bag1' chl) -- flip the order :) in srch True [] [] (addToBag emptyBg t1) (addToBag emptyBg t2) where- containsResult v sl = sl `elem` map (flip srWords AllSenses) v+ containsResult v sl = sl `elem` map (`srWords` AllSenses) v addResult v sr = sr:v--personTree = runWordNetQuiet (closureOn Hypernym (head $ search "person" Noun AllSenses))-organizationTree = runWordNetQuiet (closureOn Hypernym (head $ search "organization" Noun AllSenses))-
NLP/WordNet/Common.hs view
@@ -1,16 +1,8 @@-module NLP.WordNet.Common- (- module Data.Char,- module Data.List,- module Data.Maybe,- module Control.Exception,- module Control.Monad,- )- where+module NLP.WordNet.Common (module X) where -import Prelude hiding (catch)-import Data.Char-import Data.List-import Data.Maybe-import Control.Exception-import Control.Monad+import Prelude+import Data.Char as X+import Data.List as X+import Data.Maybe as X+import Control.Exception as X+import Control.Monad as X
NLP/WordNet/Consts.hs view
@@ -1,9 +1,14 @@ module NLP.WordNet.Consts where -import Data.List (intersperse)+import Data.String import System.FilePath (joinPath) +makePath :: [FilePath] -> FilePath makePath = joinPath++dictDir :: IsString a => a+defaultPath :: IsString a => a+defaultBin :: IsString a => a #if defined (UNIX) dictDir = "/dict"
NLP/WordNet/PrimTypes.hs view
@@ -10,14 +10,17 @@ -- | The basic part of speech type, either a 'Noun', 'Verb', 'Adj'ective or 'Adv'erb. data POS = Noun | Verb | Adj | Adv deriving (Eq, Ord, Show, Ix, Typeable)+allPOS :: [POS] allPOS = [Noun ..] data EPOS = POS POS | Satellite | AdjSatellite | IndirectAnt | DirectAnt | UnknownEPos | Pertainym deriving (Eq, Ord, Typeable) +fromEPOS :: EPOS -> POS fromEPOS (POS p) = p fromEPOS _ = Adj +allEPOS :: [EPOS] allEPOS = [POS Noun ..] instance Enum POS where@@ -25,6 +28,7 @@ toEnum 2 = Verb toEnum 3 = Adj toEnum 4 = Adv+ toEnum _ = undefined fromEnum Noun = 1 fromEnum Verb = 2 fromEnum Adj = 3@@ -39,27 +43,29 @@ toEnum 4 = POS Adv toEnum 5 = Satellite toEnum 6 = AdjSatellite+ toEnum _ = undefined fromEnum (POS Noun) = 1 fromEnum (POS Verb) = 2 fromEnum (POS Adj) = 3 fromEnum (POS Adv) = 4 fromEnum Satellite = 5 fromEnum AdjSatellite = 6+ fromEnum _ = 0 enumFrom i = enumFromTo i AdjSatellite enumFromThen i j = enumFromThenTo i j AdjSatellite instance Show EPOS where showsPrec i (POS p) = showsPrec i p- showsPrec i (Satellite) = showString "Satellite"- showsPrec i (AdjSatellite) = showString "AdjSatellite"- showsPrec i (IndirectAnt) = showString "IndirectAnt"- showsPrec i (DirectAnt) = showString "DirectAnt"- showsPrec i (Pertainym) = showString "Pertainym"- showsPrec i (UnknownEPos) = showString "UnknownEPos"+ showsPrec _ (Satellite) = showString "Satellite"+ showsPrec _ (AdjSatellite) = showString "AdjSatellite"+ showsPrec _ (IndirectAnt) = showString "IndirectAnt"+ showsPrec _ (DirectAnt) = showString "DirectAnt"+ showsPrec _ (Pertainym) = showString "Pertainym"+ showsPrec _ (UnknownEPos) = showString "UnknownEPos" instance Ix EPOS where range (i,j) = [i..j]- index (i,j) a = fromEnum a - fromEnum i+ index (i,_) a = fromEnum a - fromEnum i inRange (i,j) a = a `elem` [i..j] @@ -69,6 +75,7 @@ readEPOS "a" = POS Adj readEPOS "r" = POS Adv readEPOS "s" = Satellite+readEPOS _ = undefined data WordNetEnv = WordNetEnv {@@ -84,6 +91,7 @@ warnAbout :: String -> SomeException -> IO () } +wordNetEnv0 :: WordNetEnv wordNetEnv0 = WordNetEnv { dataHandles = undefined, excHandles = undefined,@@ -127,6 +135,7 @@ headSense :: SenseType } -- deriving (Show) +synset0 :: Synset synset0 = Synset 0 UnknownEPos (-1) undefined [] Nothing [] [] "" Nothing (-1) "" AllSenses -- | The basic type which holds search results. Its 'Show' instance simply@@ -156,6 +165,7 @@ indexOffsets :: [Offset] } deriving (Eq, Ord, Show, Typeable) +index0 :: Index index0 = Index "" (POS Noun) (-1) [] (-1) [] -- | The different types of relations which can hold between WordNet Synsets.
NLP/WordNet/Prims.hs view
@@ -31,11 +31,11 @@ import Numeric (readHex, readDec) import Data.Char (toLower, isSpace) import Data.Array+import Data.Foldable (forM_) import Control.Exception-import Control.Monad (when, liftM, mplus)-import Data.List (findIndex, find)+import Control.Monad (when, liftM, mplus, unless)+import Data.List (findIndex, find, elemIndex) import Data.Maybe (isNothing, fromJust, isJust, fromMaybe)-import GHC.IO.Handle -- (openFileEx, BinaryMode(..)) import NLP.WordNet.PrimTypes import NLP.WordNet.Util@@ -61,12 +61,12 @@ searchdir <- case mSearchdir of { Nothing -> getDefaultSearchDir ; Just d -> return d } let warn = fromMaybe (\s e -> hPutStrLn stderr (s ++ "\n" ++ show e)) mWarn version <- tryMaybe $ getEnv "WNDBVERSION"- dHands <- mapM (\pos -> do+ dHands <- mapM (\pos' -> do idxH <- openFileEx- (makePath [searchdir, "index." ++ partName pos])+ (makePath [searchdir, "index." ++ partName pos']) (BinaryMode ReadMode) dataH <- openFileEx - (makePath [searchdir, "data." ++ partName pos])+ (makePath [searchdir, "data." ++ partName pos']) (BinaryMode ReadMode) return (idxH, dataH) ) allPOS@@ -84,10 +84,10 @@ idx <- openFileEx (makePath [searchdir, "sentidx.vrb"]) (BinaryMode ReadMode) snt <- openFileEx (makePath [searchdir, "sents.vrb" ]) (BinaryMode ReadMode) return (idx, snt)- mHands <- mapM (\pos -> openFileEx - (makePath [searchdir, partName pos ++ ".exc"])+ mHands <- mapM (\pos' -> openFileEx + (makePath [searchdir, partName pos' ++ ".exc"]) (BinaryMode ReadMode)) allPOS- return $ WordNetEnv + return WordNetEnv { dataHandles = listArray (Noun, Adv) dHands, excHandles = listArray (Noun, Adv) mHands, senseHandle = sense,@@ -116,7 +116,7 @@ closeWordNet wne = do mapM_ (\ (h1,h2) -> hClose h1 >> hClose h2) (elems (dataHandles wne)) mapM_ hClose (elems (excHandles wne))- mapM_ (\x -> when (isJust x) $ hClose (fromJust x))+ mapM_ (`forM_` hClose) [senseHandle wne, countListHandle wne, keyIndexHandle wne, revKeyIndexHandle wne, liftM fst (vSentHandle wne), liftM snd (vSentHandle wne)] @@ -138,15 +138,15 @@ -- be built using indexToSenseKey. getSynsetForSense :: WordNetEnv -> SenseKey -> IO (Maybe Synset) getSynsetForSense wne _ | isNothing (senseHandle wne) = ioError $ userError "no sense dictionary"-getSynsetForSense wne key = do+getSynsetForSense wne key' = do l <- binarySearch (fromJust $ senseHandle wne)- (senseKeyString key) -- ++ " " ++ charForPOS (senseKeyPOS key))+ (senseKeyString key') -- ++ " " ++ charForPOS (senseKeyPOS key)) case l of Nothing -> return Nothing- Just l -> do offset <- maybeRead $ takeWhile (not . isSpace) $- drop 1 $ dropWhile (not . isSpace) l- ss <- readSynset wne (senseKeyPOS key) offset (senseKeyWord key)+ Just l' -> do offset <- maybeRead $ takeWhile (not . isSpace) $+ drop 1 $ dropWhile (not . isSpace) l'+ ss <- readSynset wne (senseKeyPOS key') offset (senseKeyWord key') return (Just ss) -- | readSynset takes a part of speech, and an offset (the offset can be found@@ -178,7 +178,7 @@ -- print (toks, ptrCountS, ptrCount) wrds' <- readWords ss1 wrds let ss2 = ss1 { ssWords = wrds',- whichWord = findIndex (==w) wrds }+ whichWord = elemIndex w wrds } let (ptrs,rest3) = splitAt (ptrCount*4) rest2 let (fp,ss3) = readPtrs (False,ss2) ptrs let ss4 = if fp && searchPos == Adj && ssType ss3 == UnknownEPos@@ -187,23 +187,23 @@ let (ss5,rest4) = if searchPos /= Verb then (ss4, rest3) - else let (fcountS:rest4) = rest3- (synPtrs, rest5) = splitAt (read fcountS * 3) rest4+ else let (fcountS:_) = rest3+ (_ , rest5) = splitAt (read fcountS * 3) rest4 in (ss4, rest5) let ss6 = ss5 { defn = unwords $ drop 1 rest4 } return ss6 where- readWords ss (w:lid:xs) = do- let s = map toLower $ replaceChar ' ' '_' w+ readWords ss (w':lid:xs) = do+ let s = map toLower $ replaceChar ' ' '_' w' idx <- indexLookup wne s (fromEPOS $ pos ss) -- print (w,st,idx) let posn = case idx of Nothing -> Nothing- Just ix -> findIndex (==hereIAm ss) (indexOffsets ix)+ Just ix -> elemIndex (hereIAm ss) (indexOffsets ix) rest <- readWords ss xs- return ((w, fst $ head $ readHex lid, maybe AllSenses SenseNumber posn) : rest)+ return ((w', fst $ head $ readHex lid, maybe AllSenses SenseNumber posn) : rest) readWords _ _ = return [] readPtrs (fp,ss) (typ:off:ppos:lexp:xs) = let (fp',ss') = readPtrs (fp,ss) xs@@ -231,20 +231,20 @@ case findIndex ((==indexWord idx) . map toLower) (map (\ (w,_,_) -> w) $ ssWords ss2) of Nothing -> return Nothing Just j -> do- let skey = if ssType ss2 == Satellite- then indexWord idx ++ "%" ++ show (fromEnum Satellite) ++ ":" +++ let skey = ((indexWord idx ++ "%") ++) (if ssType ss2 == Satellite+ then show (fromEnum Satellite) ++ ":" ++ padTo 2 (show $ fnum ss2) ++ ":" ++ headWord ss2 ++ ":" ++ padTo 2 (show $ headSense ss2)- else indexWord idx ++ "%" ++ show (fromEnum $ pos ss2) ++ ":" +++ else show (fromEnum $ pos ss2) ++ ":" ++ padTo 2 (show $ fnum ss2) ++ ":" ++ - padTo 2 (show $ lexId ss2 j) ++ "::"+ padTo 2 (show $ lexId ss2 j) ++ "::") return (Just $ SenseKey cpos skey (indexWord idx)) where followSatellites ss | ssType ss == Satellite = case find (\ (f,_,_,_,_) -> f == Similar) (forms ss) of Nothing -> return ss- Just (f,offset,p,j,k) -> do+ Just (_,offset,p,_,_) -> do adjss <- readSynset wne (fromEPOS p) offset "" case ssWords adjss of (hw,_,hs):_ -> return (ss { headWord = map toLower hw,@@ -254,8 +254,8 @@ -- indexLookup takes a word and part of speech and gives back its index. indexLookup :: WordNetEnv -> String -> POS -> IO (Maybe Index)-indexLookup wne w pos = do- ml <- binarySearch (fst (dataHandles wne ! pos)) w+indexLookup wne w pos' = do+ ml <- binarySearch (fst (dataHandles wne ! pos')) w case ml of Nothing -> return Nothing Just l -> do@@ -294,16 +294,17 @@ else binarySearch' top (bot-1) ((top+bot-1) `div` 2) else do l <- hGetLine h- let key = takeWhile (/=' ') l- if key == s + let key' = takeWhile (/=' ') l+ if key' == s then return (Just l) else case (bot - top) `div` 2 of 0 -> return Nothing- d -> case key `compare` s of+ d -> case key' `compare` s of LT -> binarySearch' mid bot (mid + d) GT -> binarySearch' top mid (top + d)+ EQ -> undefined readUntilNL = do eof <- hIsEOF h- if eof - then return ()- else do hGetLine h; return ()+ unless eof $ do+ hGetLine h+ return ()
NLP/WordNet/Types.hs view
@@ -76,7 +76,6 @@ ) where -import System.IO.Unsafe import Data.List import Data.Maybe @@ -154,7 +153,7 @@ -- | This gives the actual words used to describe the Synset of a search result. srWords :: SearchResult -> SenseType -> [Word]-srWords sr t = nub . map fst3 . filter ((isType t) . thr3) . ssWords . srSynset $ sr+srWords sr t = nub . map fst3 . filter (isType t . thr3) . ssWords . srSynset $ sr where isType AllSenses _ = True isType _ AllSenses = True isType (SenseNumber n) (SenseNumber m) = n == m@@ -185,7 +184,3 @@ _ -> case ssType (srSynset sr) of POS pp -> pp _ -> Adj--instance Show SearchResult where- showsPrec i (SearchResult { srSynset = ss }) =- showChar '<' . showString (unwords $ map fst3 $ ssWords ss) . showChar '>'
NLP/WordNet/Util.hs view
@@ -2,27 +2,37 @@ import NLP.WordNet.PrimTypes +#if MIN_VERSION_base(4,6,0)+import Prelude+#else import Prelude hiding (catch)+#endif import Control.Exception+import Control.Monad import Data.Char (toLower) import Data.List (nub) import Data.Maybe (fromMaybe)+import Data.String import GHC.IO.Handle import System.IO data IOModeEx = BinaryMode IOMode | AsciiMode IOMode deriving (Eq, Ord, Show, Read) +openFileEx :: FilePath -> IOModeEx -> IO Handle openFileEx fp (BinaryMode md) = openBinaryFile fp md openFileEx fp (AsciiMode md) = openFile fp md +fst3 :: (a, b, c) -> a fst3 (a,_,_) = a+snd3 :: (a, b, c) -> b snd3 (_,b,_) = b+thr3 :: (a, b, c) -> c thr3 (_,_,c) = c maybeRead :: (Read a, Monad m) => String -> m a maybeRead s = - case readsPrec 0 s of+ case reads s of (a,_):_ -> return a _ -> fail "error parsing string" @@ -30,8 +40,11 @@ matchN n l | length l >= n = return l | otherwise = fail "expecting more tokens" -lexId x n = (\ (_,i,_) -> i) $ (ssWords x !! n)-padTo n s = reverse $ take n $ (reverse s ++ repeat '0')+lexId :: Synset -> Int -> Int+lexId x n = (\ (_,i,_) -> i) (ssWords x !! n)++padTo :: Int -> String -> String+padTo n s = reverse $ take n (reverse s ++ repeat '0') sensesOf :: Int {- num senses -} -> SenseType -> [Int] sensesOf n AllSenses = [1..n]@@ -42,25 +55,26 @@ -- utility functions +charForPOS :: IsString a => POS -> a charForPOS (Noun) = "n" charForPOS (Verb) = "v" charForPOS (Adj) = "a" charForPOS (Adv) = "r" tryMaybe :: IO a -> IO (Maybe a)-tryMaybe a = (a >>= return . Just) `catch` (\(_ :: SomeException) -> return Nothing)+tryMaybe a = liftM Just a `catch` (\(_ :: SomeException) -> return Nothing) tryMaybeWarn :: Exception e => (e -> IO ()) -> IO a -> IO (Maybe a)-tryMaybeWarn warn a = (a >>= return . Just) `catch` (\e -> warn e >> return Nothing)+tryMaybeWarn warn a = liftM Just a `catch` (\e -> warn e >> return Nothing) partName :: POS -> String partName = map toLower . show cannonWNString :: String -> [String] cannonWNString s'- | not ('_' `elem` s) &&- not ('-' `elem` s) &&- not ('.' `elem` s) = [s]+ | notElem '_' s &&+ notElem '-' s &&+ notElem '.' s = [s] | otherwise = nub [s, replaceChar '_' '-' s,@@ -70,11 +84,13 @@ ] where s = map toLower s' -replaceChar from to [] = []+replaceChar :: Eq a => a -> a -> [a] -> [a]+replaceChar _ _ [] = [] replaceChar from to (c:cs) | c == from = to : replaceChar from to cs | otherwise = c : replaceChar from to cs +getPointerType :: (Eq a, IsString a) => a -> Form getPointerType s = fromMaybe Unknown $ lookup s l where l =
WordNet.cabal view
@@ -1,5 +1,5 @@ Name: WordNet-Version: 1.0.0+Version: 1.1.0 Description: A pure-Haskell interface to the WordNet lexical database of English. Depends on the WordNet database, but not on the WordNet source code.@@ -12,10 +12,10 @@ Build-Depends: base, filepath Build-Type: Simple Cabal-Version: >= 1.8+Tested-With: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.7.20130824 Library Build-depends: base == 4.*, containers, filepath, array- Exposed-Modules: NLP.WordNet @@ -27,4 +27,4 @@ NLP.WordNet.Prims NLP.WordNet.Types - Extensions: CPP, DeriveDataTypeable, ImplicitParams, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables+ Extensions: CPP, DeriveDataTypeable, FlexibleContexts, FlexibleInstances, ImplicitParams, MultiParamTypeClasses, OverloadedStrings, RankNTypes, ScopedTypeVariables