Condor 0.2 → 0.3
raw patch · 22 files changed
+537/−899 lines, 22 filesdep +glider-nlp
Dependencies added: glider-nlp
Files
- CHANGES +6/−1
- Condor.cabal +31/−27
- LICENSE +22/−16
- src-app/IO.hs +39/−0
- src-app/Main.hs +92/−0
- src/Condor/Commons/Document.hs +48/−0
- src/Condor/Commons/Unsafe.hs +28/−0
- src/Condor/DataTypes.hs +0/−46
- src/Condor/Index.hs +0/−118
- src/Condor/Language/English/Porter.hs +0/−168
- src/Condor/Language/English/StopWords.hs +0/−152
- src/Condor/Reader/Text.hs +29/−0
- src/Condor/Readers/Text.hs +0/−29
- src/Condor/Search/Index.hs +130/−0
- src/Condor/Text.hs +0/−37
- src/IO.hs +0/−39
- src/Main.hs +0/−91
- test-src/AllTests.hs +3/−6
- test-src/Condor/IndexTest.hs +0/−100
- test-src/Condor/Language/English/PorterTest.hs +0/−36
- test-src/Condor/Search/IndexTest.hs +109/−0
- test-src/Condor/TextTest.hs +0/−33
CHANGES view
@@ -1,8 +1,13 @@+Version 0.3 2014-01-20+* Refactored modules+* New Tokenizer module. +* NLP package moved to separate project++ Version 0.2 2014-01-08 * Changes in Index API * Add recursive option to command line tool. * Post list contains document id instead of document name. - Version 0.1 2014-01-04
Condor.cabal view
@@ -1,27 +1,33 @@ name: Condor-version: 0.2+version: 0.3 cabal-version: >= 1.10 build-type: Simple author: Krzysztof Langner maintainer: klangner@gmail.com synopsis: Information retrieval library-description: Library for indexing and searching text documents homepage: https://github.com/klangner/Condor Bug-reports: https://github.com/klangner/Condor/issues stability: Unstable interface, incomplete features. category: Search, Text, Library-License: MIT+License: BSD3 License-file: LICENSE Extra-Source-Files: CHANGES+description: + An Information Retrieval (IR) library which consists of the following components:+ .+ * Search - for indexing and searching text documents. + Check "Condor.Search.Index" for API information+ .+ * Readers for reading documents from disk. Check "Condor.Reader.Text" folder text reader. source-repository head type: git location: https://github.com/klangner/Condor executable condor- hs-source-dirs: src- main-is: Main.hs+ hs-source-dirs: src-app,+ src default-language: Haskell2010 build-depends: base >= 4 && <4.7,@@ -29,31 +35,33 @@ containers >=0.5.0 && <0.6, directory >=1.2.0 && <1.3, filepath >=1.3.0 && <1.4,- text >=1 && <1.1+ text >=1 && <1.1,+ glider-nlp >= 0.1 && <1 ghc-options: -Wall other-modules: - Condor.Index,- Condor.Readers.Text,- Condor.Text,+ Condor.Commons.Document,+ Condor.Commons.Unsafe,+ Condor.Reader.Text,+ Condor.Search.Index, IO+ main-is: Main.hs library hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall exposed-modules: - Condor.DataTypes,- Condor.Index,- Condor.Language.English.Porter,- Condor.Language.English.StopWords,- Condor.Readers.Text,- Condor.Text+ Condor.Commons.Document,+ Condor.Reader.Text,+ Condor.Search.Index build-depends: base >= 4 && <4.7, containers >=0.5.0 && <0.6, binary >=0.5.1 && <0.6,- text >=1 && <1.1+ text >=1 && <1.1,+ glider-nlp >= 0.1 && <1+ other-modules: Condor.Commons.Unsafe test-suite unit-tests type: detailed-0.9@@ -66,19 +74,15 @@ Cabal >=1.16.0 && <1.17, containers >=0.5.0 && <0.6, binary >=0.5.1 && <0.6,- text >=1 && <1.1+ text >=1 && <1.1,+ glider-nlp >= 0.1 && <1 other-modules: - Condor.Index,- Condor.IndexTest,- Condor.Language.English.Porter,- Condor.Language.English.PorterTest,- Condor.Language.English.StopWords,- Condor.Text,- Condor.TextTest,- Distribution.TestSuite.HUnit,- Condor.DataTypes+ Condor.Commons.Document,+ Condor.Commons.Unsafe,+ Condor.Search.Index,+ Condor.Search.IndexTest,+ Distribution.TestSuite.HUnit hs-source-dirs: src, test-src-
LICENSE view
@@ -1,20 +1,26 @@-The MIT License (MIT)- Copyright (c) 2014 Krzysztof Langner+All rights reserved. -Permission is hereby granted, free of charge, to any person obtaining a copy of-this software and associated documentation files (the "Software"), to deal in-the Software without restriction, including without limitation the rights to-use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of-the Software, and to permit persons to whom the Software is furnished to do so,-subject to the following conditions:+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met: -The above copyright notice and this permission notice shall be included in all-copies or substantial portions of the Software.+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer. -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS-FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR-COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER-IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN-CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ src-app/IO.hs view
@@ -0,0 +1,39 @@+{- |+Module : IO+Copyright : Copyright (C) 2013-2014 Krzysztof Langner+License : BSD3++Helper module with functions operating on IO+-}+module IO + ( listFiles+ , listDirs+ )where++import System.Directory (canonicalizePath, getDirectoryContents, doesDirectoryExist)+import Data.List+import Control.Monad+++-- | list files+listFiles :: FilePath -> IO [FilePath] +listFiles p = do + contents <- list p+ filterM (fmap not . doesDirectoryExist) contents++ +-- | list subdirectories+listDirs :: FilePath -> IO [FilePath] +listDirs p = do+ contents <- list p+ filterM doesDirectoryExist contents+ +-- | list directory content+list :: FilePath -> IO [FilePath] +list p = do + ds <- getDirectoryContents p+ let filtered = filter f ds+ path <- canonicalizePath $ p + return $ map ((path++"/")++) filtered+ where f x = and [x /= ".", x /= "..", (not . isPrefixOf ".") x]+
+ src-app/Main.hs view
@@ -0,0 +1,92 @@+module Main where++import System.Environment+import System.Directory (removeFile, renameFile)+import Control.Exception+import Control.Monad+import Data.Binary+import qualified Data.Text as T+import Condor.Search.Index+import qualified Condor.Reader.Text as TextReader+import IO+++-- | Commands dispatcher+dispatch :: [(String, [String] -> Index -> IO ())] +dispatch = [ ("index", indexCmd) + , ("search", searchCmd) + ]+indexFile :: FilePath +indexFile = "index.db"++-- This is dummy main function (not working yet)+main :: IO ()+main = do+ idx <- (readIndex indexFile) `catch` readIndexError+ (command:args) <- getArgs+ let (Just action) = lookup command dispatch+ action args idx+++-- | Read Index data from file+readIndex :: FilePath -> IO Index+readIndex p = {-# SCC "read" #-} decodeFile p++-- | Create empty index if can't read from file+readIndexError :: IOError -> IO Index+readIndexError _ = return emptyIndex++-- | Silent IO error+nullError :: IOError -> IO ()+nullError _ = return ()++-- | Write index data to the file+writeIndex :: FilePath -> Index -> IO ()+writeIndex p idx = do+ putStrLn $ "Entries count: " ++ show (termCount idx)+ let temp = p ++ ".temp" + encodeFile temp idx+ removeFile p `catch` nullError+ renameFile temp p++-- | Command to index all files from given folder +indexCmd :: [String] -> Index -> IO () +indexCmd [p] idx = do + idx2 <- indexFolder False idx p+ writeIndex indexFile idx2 +indexCmd [p, "-r"] idx = do + idx2 <- indexFolder True idx p+ writeIndex indexFile idx2+indexCmd _ _ = error "add command requires path to the documents"++-- | Index given folder +indexFolder :: Bool -> Index -> FilePath -> IO Index +indexFolder False idx p = do + putStrLn $ "Added folder: " ++ p+ fs <- listFiles p+ idx2 <- foldM addFile idx fs+ return idx2+indexFolder True idx p = do + idx2 <- indexFolder False idx p+ ds <- listDirs p+ idx3 <- foldM (indexFolder True) idx2 ds+ return idx3++-- | Add file to the index+addFile :: Index -> FilePath -> IO Index+addFile idx p = do+ doc <- TextReader.readDocument p+ let idx2 = addDocument doc idx+ return idx2 + ++-- | Command tosearch index+searchCmd :: [String] -> Index -> IO ()+searchCmd (t:_) idx = do + let result = {-# SCC "search" #-} search idx (T.pack t)+ putStrLn $ "Search term: " ++ show t ++ " found in documents: "+ _ <- mapM (putStrLn . show) result+ return ()+searchCmd _ _ = error "search command requires search terms"++
+ src/Condor/Commons/Document.hs view
@@ -0,0 +1,48 @@+{- |+Module : Condor.Commons.Document+Copyright : Copyright (C) 2014 Krzysztof Langner+License : BSD3++Maintainer : Krzysztof Langner <klangner@gmail.com>+Stability : alpha+Portability : portable++Contains basic data structures uses by other modules.+-}+module Condor.Commons.Document + ( DocName+ , Document(..)+ , docFromStrings+ , docName+ , docText+ ) where++import Prelude hiding (concat, map)+import qualified Data.List as List+import Data.Text++-- | Document name+type DocName = Text++-- | Field consists of title and content+data Field = Field Text Text+ +-- | Document with name and contents +data Document = Document DocName [Field]+++-- | Create simple field from strings+fieldFromStrings :: String -> String -> Field+fieldFromStrings k v = Field (pack k) (pack v) ++-- | Create simple document with name and single field content.+docFromStrings :: String -> String -> Document+docFromStrings t c = Document (pack t) [fieldFromStrings "content" c]++-- | Get document name+docName :: Document -> Text+docName (Document a _) = a++-- | Get text from all fields+docText :: Document -> Text+docText (Document _ fs) = concat $ List.map (\(Field _ y) -> y) fs
+ src/Condor/Commons/Unsafe.hs view
@@ -0,0 +1,28 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{- |+Module : Condor.Commons.Unsafe+Copyright : Copyright (C) 2013-2014 Krzysztof Langner+License : BSD3++Maintainer : Krzysztof Langner <klangner@gmail.com>+Stability : alpha+Portability : portable++This module contains code which is necessary but should be removed if possible.+The warning here are turn off.+-}+module Condor.Commons.Unsafe+ ( + ) where++import Data.Text+import Data.Binary+import Data.Text.Encoding (encodeUtf8, decodeUtf8)+++-- | This instance is necessary so Index can be serialized to and from disk using binary format+instance Binary Text where+ put i = do put (encodeUtf8 i)+ get = do i <- get+ return $ decodeUtf8 i +
− src/Condor/DataTypes.hs
@@ -1,46 +0,0 @@-{- |-Module : Condor.DataTypes-Copyright : Copyright (C) 2014 Krzysztof Langner-License : The MIT License (MIT)--Maintainer : Krzysztof Langner <klangner@gmail.com>-Stability : alpha-Portability : portable--Common to all modules data types definitions.--}-module Condor.DataTypes - ( DocName- , Document(..)- , docFromStrings- , docName- , docText- ) where--import qualified Data.Text as T---type DocName = T.Text---- | Field consists of title and content-data Field = Field T.Text T.Text- --- | Document with name and contents -data Document = Document DocName [Field]----- | Create simple field from strings-fieldFromStrings :: String -> String -> Field-fieldFromStrings k v = Field (T.pack k) (T.pack v) ---- | Create simple document with name and single field content.-docFromStrings :: String -> String -> Document-docFromStrings t c = Document (T.pack t) [fieldFromStrings "content" c]---- | Get document name-docName :: Document -> T.Text-docName (Document a _) = a---- | Get text from all fields-docText :: Document -> T.Text-docText (Document _ fs) = T.concat $ map (\(Field _ y) -> y) fs
− src/Condor/Index.hs
@@ -1,118 +0,0 @@-{- |-Module : Condor.Index-Copyright : Copyright (C) 2013-2014 Krzysztof Langner-License : The MIT License (MIT)--Maintainer : Krzysztof Langner <klangner@gmail.com>-Stability : alpha-Portability : portable--This module contains functions which create, update and search index. -Default implementation uses algorithms for english language (stemming, stop words etc.)--Functions in this module (for performance reasons) are based on unicode strings Data.Text.---}-module Condor.Index - ( DocName- , Index- , addDocument- , addDocTerms- , emptyIndex- , search- , searchTerms- , termCount- ) where--import qualified Data.Map as Map-import qualified Data.List as List-import qualified Data.Text as T-import qualified Data.Text.Encoding as E-import Data.Binary-import Condor.Text-import Condor.DataTypes (DocName, Document(..), docName, docText)-import Condor.Language.English.StopWords (isStopWord)-import Condor.Language.English.Porter (stem)---type Term = T.Text---- | Inverted index-data Index = Index { terms :: Map.Map Term [Int]- , docs :: [DocName]- }---- An instance of Binary to encode and decode an IndexParams in binary-instance Binary Index where- put i = do - put (terms i)- put (docs i)- get = do i <- get- d <- get- return $ Index i d ---- An instance of Binary to encode and decode T.Text-instance Binary T.Text where- put i = do put (E.encodeUtf8 i)- get = do i <- get- return $ E.decodeUtf8 i ----- | Create empty index. --- This index will be configured for english language.-emptyIndex :: Index-emptyIndex = Index Map.empty []----- | Add document to the index.--- This function uses algorithms for english language to split document content--- into index terms.-addDocument :: Document -> Index -> Index-addDocument d idx = addDocTerms (docName d) (splitTerms content) idx- where content = docText d----- | Add document to the index.--- This function should be used if document content should be splitted into terms--- with custom algorithms.-addDocTerms :: DocName -> [Term] -> Index -> Index-addDocTerms d c ix = Index (foldl f (terms ix) c) (d:docs ix)- where f ix' t = case Map.lookup t ix' of - Just a -> Map.insert t (index:a) ix'- Nothing -> Map.insert t [index] ix'- index = length (docs ix)----- | Search terms given as single string in the index--- This function uses algorithms for english language to split query into tokens.-search :: Index -> String -> [DocName]-search ix s = searchTerms ix (splitTerms (T.pack s))----- | Search terms given as array in the index.--- This function should be used if query should be splitted into terms--- with custom algorithms-searchTerms :: Index -> [Term] -> [DocName]-searchTerms ix s = List.nub $ foldl (++) [] ys- where ys = map (findDocs ix) s----- | Search single term in the index-findDocs :: Index -> Term -> [DocName]-findDocs ix s = case Map.lookup s (terms ix) of- Just a -> map ((reverse (docs ix))!!) a- Nothing -> []- ---- | Get the number of terms in indexs-termCount :: Index -> Int-termCount ix = Map.size (terms ix)----- | Split text into terms.--- This function removes stop words and stems words-splitTerms :: T.Text -> [Term]-splitTerms s = map stem (filter (not . isStopWord) t)- where t = tokenize s- -
− src/Condor/Language/English/Porter.hs
@@ -1,168 +0,0 @@-{- | This code was taken from: http://tartarus.org/~martin/PorterStemmer/haskell.txt --}-module Condor.Language.English.Porter (stem) where- -import Control.Monad -import Data.Maybe-import Data.List-import qualified Data.Text as T----- | API stemming function-stem :: T.Text -> T.Text-stem s | T.length s < 3 = s- | otherwise = T.pack $ allSteps (T.unpack s)---isConsonant :: [Char] -> Int -> Bool -isConsonant str i- | c `elem` "aeiou" = False- | c == 'y' = i == 0 || isVowel str (i - 1)- | otherwise = True- where- c = str !! i--isVowel :: [Char] -> Int -> Bool-isVowel = (not .) . isConsonant--byIndex :: ([a] -> [Int] -> t) -> [a] -> t-byIndex fun str = fun str [0..length str - 1]--measure :: [Char] -> Int-measure = length . filter not . init . (True:) . map head . group . byIndex (map . isConsonant)--containsVowel :: [Char] -> Bool-containsVowel = byIndex (any . isVowel)--endsWithDouble :: [Char] -> Bool-endsWithDouble = startsWithDouble . reverse- where- startsWithDouble l | length l < 2 = False- | otherwise = let (x:y:_) = l in x == y && x `notElem` "aeiou"--cvc :: [Char] -> Bool-cvc word | length word < 3 = False- | otherwise = isConsonant word lastIndex &&- isVowel word (lastIndex - 1) &&- isConsonant word (lastIndex - 2) &&- last word `notElem` "wxy"- where lastIndex = length word - 1--statefulReplace :: Eq a => ([a] -> Bool) -> [a] -> [a] -> [a] -> Maybe (Either [a] [a])-statefulReplace predicate str end replacement- | end `isSuffixOf` str = Just replaced- | otherwise = Nothing- where- part = take (length str - length end) str- replaced | predicate part = Right (part ++ replacement)- | otherwise = Left str--replaceEnd :: Eq a => ([a] -> Bool) -> [a] -> [a] -> [a] -> Maybe [a]-replaceEnd predicate str end replacement = do- result <- statefulReplace predicate str end replacement- return (either id id result)--findStem :: Eq a => ([a] -> Bool) -> [a] -> [([a], [a])] -> Maybe [a]-findStem f word pairs = msum $ map (uncurry (replaceEnd f word)) pairs--measureGT :: Int -> [Char] -> Bool-measureGT = flip ((>) . measure)--step1a :: [Char] -> [Char]-step1a word = fromMaybe word result- where result = findStem (const True) word [("sses", "ss"), ("ies", "i"), ("ss", "ss"), ("s", "")]--beforeStep1b :: [Char] -> Either [Char] [Char]-beforeStep1b word = fromMaybe (Left word) result- where- cond23 x = do { v <- x; either (const Nothing) (return . Right) v }- cond1 x = do { v <- x; return (Left v) }- result =- cond1 (replaceEnd (measureGT 0) word "eed" "ee") `mplus`- cond23 (statefulReplace containsVowel word "ed" "" ) `mplus`- cond23 (statefulReplace containsVowel word "ing" "" )--afterStep1b :: [Char] -> [Char]-afterStep1b word = fromMaybe word result- where- double = endsWithDouble word && not (any ((`isSuffixOf` word) . return) "lsz")- mEq1AndCvc = measure word == 1 && cvc word- iif cond val = if cond then Just val else Nothing- result = findStem (const True) word [("at", "ate"), ("bl", "ble"), ("iz", "ize")]- `mplus` iif double (init word)- `mplus` iif mEq1AndCvc (word ++ "e")--step1b :: [Char] -> [Char]-step1b = either id afterStep1b . beforeStep1b--step1c :: [Char] -> [Char]-step1c word = fromMaybe word result- where result = replaceEnd containsVowel word "y" "i"--step1 :: [Char] -> [Char]-step1 = step1c . step1b . step1a--step2 :: [Char] -> [Char]-step2 word = fromMaybe word result- where- result = findStem (measureGT 0) word- [ ("ational", "ate" )- , ("tional", "tion")- , ("enci", "ence")- , ("anci", "ance")- , ("izer", "ize" )- , ("bli", "ble" )- , ("alli", "al" )- , ("entli", "ent" )- , ("eli", "e" )- , ("ousli", "ous" )- , ("ization", "ize" )- , ("ation", "ate" )- , ("ator", "ate" )- , ("alism", "al" )- , ("iveness", "ive" )- , ("fulness", "ful" )- , ("ousness", "ous" )- , ("aliti", "al" )- , ("iviti", "ive" )- , ("biliti", "ble" )- , ("logi", "log" ) ]--step3 :: [Char] -> [Char]-step3 word = fromMaybe word result- where- result = findStem (measureGT 0) word- [ ("icate", "ic")- , ("ative", "" )- , ("alize", "al")- , ("iciti", "ic")- , ("ical" , "ic")- , ("ful" , "" )- , ("ness" , "" ) ]--step4 :: [Char] -> [Char]-step4 word = fromMaybe word result- where- gt1andST str = (measureGT 1) str && any ((`isSuffixOf` str) . return) "st"- findGT1 = findStem (measureGT 1) word . map (flip (,) "")- result = (findGT1 ["al", "ance", "ence", "er", "ic", "able", "ible", "ant", "ement", "ment", "ent"]) `mplus`- (findStem gt1andST word [("ion","")]) `mplus`- (findGT1 ["ou", "ism", "ate", "iti", "ous", "ive", "ize"])--step5a :: [Char] -> [Char]-step5a word = fromMaybe word result- where- test str = (measureGT 1 str) || ((measure str == 1) && (not $ cvc str))- result = replaceEnd test word "e" ""--step5b :: [Char] -> [Char]-step5b word = fromMaybe word result- where- cond s = last s == 'l' && measureGT 1 s- result = replaceEnd cond word "l" ""--step5 :: [Char] -> [Char]-step5 = step5b . step5a--allSteps :: [Char] -> [Char]-allSteps = step5 . step4 . step3 . step2 . step1
− src/Condor/Language/English/StopWords.hs
@@ -1,152 +0,0 @@-{- |-Module : Condor.Language.English.StopWords-Copyright : Copyright (C) 2013-2014 Krzysztof Langner-License : The MIT License (MIT)--Maintainer : Krzysztof Langner <klangner@gmail.com>-Stability : alpha-Portability : portable--Module contains functions specific to the english language---}-module Condor.Language.English.StopWords (isStopWord) where- -import qualified Data.Set as S -import qualified Data.Text as T- ---- | Predicate to check if given words is a stop word-isStopWord :: T.Text -> Bool-isStopWord w = S.member w stopWords--stopWords :: S.Set T.Text-stopWords = S.fromList $ map T.pack- [ "i"- , "me"- , "my"- , "myself"- , "we"- , "our"- , "ours"- , "ourselves"- , "you"- , "your"- , "yours"- , "yourself"- , "yourselves"- , "he"- , "him"- , "his"- , "himself"- , "she"- , "her"- , "hers"- , "herself"- , "it"- , "its"- , "itself"- , "they"- , "them"- , "their"- , "theirs"- , "themselves"- , "what"- , "which"- , "who"- , "whom"- , "this"- , "that"- , "these"- , "those"- , "am"- , "is"- , "are"- , "was"- , "were"- , "be"- , "been"- , "being"- , "have"- , "has"- , "had"- , "having"- , "do"- , "does"- , "did"- , "doing"- , "a"- , "an"- , "the"- , "and"- , "but"- , "if"- , "or"- , "because"- , "as"- , "until"- , "while"- , "of"- , "at"- , "by"- , "for"- , "with"- , "about"- , "against"- , "between"- , "into"- , "through"- , "during"- , "before"- , "after"- , "above"- , "below"- , "to"- , "from"- , "up"- , "down"- , "in"- , "out"- , "on"- , "off"- , "over"- , "under"- , "again"- , "further"- , "then"- , "once"- , "here"- , "there"- , "when"- , "where"- , "why"- , "how"- , "all"- , "any"- , "both"- , "each"- , "few"- , "more"- , "most"- , "other"- , "some"- , "such"- , "no"- , "nor"- , "not"- , "only"- , "own"- , "same"- , "so"- , "than"- , "too"- , "very"- , "s"- , "t"- , "can"- , "will"- , "just"- , "don"- , "should"- , "now"- ]
+ src/Condor/Reader/Text.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE BangPatterns #-}+{- |+Module : Condor.Reader.Text+Copyright : Copyright (C) 2014 Krzysztof Langner+License : BSD3++Maintainer : Krzysztof Langner <klangner@gmail.com>+Stability : alpha+Portability : portable++Reader for text files. Strict version.+Uses bang patters to force hGetContents to read the whole file.+-}+module Condor.Reader.Text(readDocument) where++import System.IO+import Condor.Commons.Document (Document, docFromStrings)++ +-- | read text as UTF8 and return as document+readDocument :: FilePath -> IO Document+readDocument path = do+ withFile path ReadMode (\h -> do+ hSetEncoding h utf8+ !contents <- hGetContents h + hClose h+ return $ docFromStrings path contents + ) +
− src/Condor/Readers/Text.hs
@@ -1,29 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{- |-Module : Condor.Readers.Text-Copyright : Copyright (C) 2014 Krzysztof Langner-License : The MIT License (MIT)--Maintainer : Krzysztof Langner <klangner@gmail.com>-Stability : alpha-Portability : portable--Reader for text files. Strict version.-Uses bang patters to force hGetContents to read file--}-module Condor.Readers.Text(readDocument) where--import System.IO-import Condor.DataTypes (Document, docFromStrings)-- --- | read text as UTF8 and return as document-readDocument :: FilePath -> IO Document-readDocument path = do- withFile path ReadMode (\h -> do- hSetEncoding h utf8- !contents <- hGetContents h - hClose h- return $ docFromStrings path contents - ) -
+ src/Condor/Search/Index.hs view
@@ -0,0 +1,130 @@+{- |+Module : Condor.Search.Index+Copyright : Copyright (C) 2013-2014 Krzysztof Langner+License : BSD3++Maintainer : Krzysztof Langner <klangner@gmail.com>+Stability : alpha+Portability : portable++Memory based index.+This module contains functions which create, update and search index. +Default implementation uses algorithms for english language (stemming, stop words etc.)++Functions in this module (for performance reasons) are based on unicode strings from module Data.Text.++Basic usage:++> import Condor.Search.Index (addDocument, search)+> import Condor.Commons.Document (docFromStrings)+>+> let idx = addDocument emptyIndex $ docFromStrings "My document 1" "This is a document content."+> search idx "content"+> ["My document 1"]++-}+module Condor.Search.Index + ( Index+ , Term+ , addDocument+ , addDocTerms+ , emptyIndex+ , docCount+ , search+ , searchTerms+ , termCount+ ) where++import Data.Text (Text)+import qualified Data.Map as Map+import qualified Data.List as List+import Data.Binary++import Condor.Commons.Unsafe()+import Condor.Commons.Document (DocName, Document(..), docName, docText)+import Glider.NLP.Language.English.StopWords (isStopWord)+import Glider.NLP.Language.English.Porter (stem)+import Glider.NLP.Tokenizer+++-- | Single term. Could be normalized word+type Term = Text++-- | Inverted index+data Index = Index { terms :: Map.Map Term [Int]+ , docs :: [DocName]+ }++-- | An instance of Binary to encode and decode an IndexParams in binary+instance Binary Index where+ put i = do + put (terms i)+ put (docs i)+ get = do i <- get+ d <- get+ return $ Index i d +++-- | Create empty index. +-- This index will be configured for english language.+emptyIndex :: Index+emptyIndex = Index Map.empty []+++-- | Add document to the index.+-- This function uses algorithms for english language to split document content+-- into index terms.+addDocument :: Document -> Index -> Index+addDocument d = addDocTerms (docName d) (splitTerms content)+ where content = docText d+++-- | Add document to the index.+-- This function should be used if document content should be splitted into terms+-- with custom algorithms.+addDocTerms :: DocName -> [Term] -> Index -> Index+addDocTerms d c ix = Index (foldl f (terms ix) c) (d:docs ix)+ where f ix' t = case Map.lookup t ix' of + Just a -> Map.insert t (index:a) ix'+ Nothing -> Map.insert t [index] ix'+ index = length (docs ix)+++-- | Search terms given as single string in the index+-- This function uses algorithms for english language to split query into tokens.+search :: Index -> Text -> [DocName]+search ix s = searchTerms ix (splitTerms s)+++-- | Search terms given as array in the index.+-- This function should be used if query should be splitted into terms+-- with custom algorithms+searchTerms :: Index -> [Term] -> [DocName]+searchTerms ix s = List.nub $ foldl (++) [] ys+ where ys = map (findDocs ix) s+++-- | Search single term in the index+findDocs :: Index -> Term -> [DocName]+findDocs ix s = case Map.lookup s (terms ix) of+ Just a -> map ((reverse (docs ix))!!) a+ Nothing -> []+ ++-- | Get the number of terms in the index+termCount :: Index -> Int+termCount ix = Map.size (terms ix)+ ++-- | Get the number of documents in the index+docCount :: Index -> Int+docCount ix = length (docs ix)+++-- | Split text into terms.+-- This function removes stop words and stems words+splitTerms :: Text -> [Term]+splitTerms s = map stem (filter (not . isStopWord) t)+ where t = (foldCase . getWords . tokenize) s+ +
− src/Condor/Text.hs
@@ -1,37 +0,0 @@-{- |-Module : Condor.Text-Copyright : Copyright (C) 2013-2014 Krzysztof Langner-License : The MIT License (MIT)--Maintainer : Krzysztof Langner <klangner@gmail.com>-Stability : alpha-Portability : portable--Helper module with functions operating on Text.-Functions in this module are language neutral. -Functions which are specific to the given language can be found in -Condor.Language.<language> modules. ---}-module Condor.Text - ( tokenize- ) where- -import qualified Data.Text as T----- | List of separators-isSeparator :: Char -> Bool-isSeparator s = elem s " .,!?"---- | Remove suffix separator -removeSeparators:: T.Text -> T.Text-removeSeparators = T.dropWhile isSeparator----- | Split string into tokens-tokenize :: T.Text -> [T.Text]-tokenize xs = if T.length s == 0 then []- else (T.toCaseFold t : tokenize r)- where s = removeSeparators xs- (t, r) = T.break isSeparator (removeSeparators xs)
− src/IO.hs
@@ -1,39 +0,0 @@-{- |-Module : IO-Copyright : Copyright (C) 2013-2014 Krzysztof Langner-License : The MIT License (MIT)--Helper module with functions operating on IO--}-module IO - ( listFiles- , listDirs- )where--import System.Directory (canonicalizePath, getDirectoryContents, doesDirectoryExist)-import Data.List-import Control.Monad----- | list files-listFiles :: FilePath -> IO [FilePath] -listFiles p = do - contents <- list p- filterM (fmap not . doesDirectoryExist) contents-- --- | list subdirectories-listDirs :: FilePath -> IO [FilePath] -listDirs p = do- contents <- list p- filterM doesDirectoryExist contents- --- | list directory content-list :: FilePath -> IO [FilePath] -list p = do - ds <- getDirectoryContents p- let filtered = filter f ds- path <- canonicalizePath $ p - return $ map ((path++"/")++) filtered- where f x = and [x /= ".", x /= "..", (not . isPrefixOf ".") x]-
− src/Main.hs
@@ -1,91 +0,0 @@-module Main where--import System.Environment-import System.Directory (removeFile, renameFile)-import Control.Exception-import Control.Monad-import Data.Binary-import Condor.Index-import qualified Condor.Readers.Text as TextReader-import IO----- | Commands dispatcher-dispatch :: [(String, [String] -> Index -> IO ())] -dispatch = [ ("index", indexCmd) - , ("search", searchCmd) - ]-indexFile :: FilePath -indexFile = "index.db"---- This is dummy main function (not working yet)-main :: IO ()-main = do- idx <- (readIndex indexFile) `catch` readIndexError- (command:args) <- getArgs- let (Just action) = lookup command dispatch- action args idx----- | Read Index data from file-readIndex :: FilePath -> IO Index-readIndex p = {-# SCC "read" #-} decodeFile p---- | Create empty index if can't read from file-readIndexError :: IOError -> IO Index-readIndexError _ = return emptyIndex---- | Silent IO error-nullError :: IOError -> IO ()-nullError _ = return ()---- | Write index data to the file-writeIndex :: FilePath -> Index -> IO ()-writeIndex p idx = do- putStrLn $ "Entries count: " ++ show (termCount idx)- let temp = p ++ ".temp" - encodeFile temp idx- removeFile p `catch` nullError- renameFile temp p---- | Command to index all files from given folder -indexCmd :: [String] -> Index -> IO () -indexCmd [p] idx = do - idx2 <- indexFolder False idx p- writeIndex indexFile idx2 -indexCmd [p, "-r"] idx = do - idx2 <- indexFolder True idx p- writeIndex indexFile idx2-indexCmd _ _ = error "add command requires path to the documents"---- | Index given folder -indexFolder :: Bool -> Index -> FilePath -> IO Index -indexFolder False idx p = do - putStrLn $ "Added folder: " ++ p- fs <- listFiles p- idx2 <- foldM addFile idx fs- return idx2-indexFolder True idx p = do - idx2 <- indexFolder False idx p- ds <- listDirs p- idx3 <- foldM (indexFolder True) idx2 ds- return idx3---- | Add file to the index-addFile :: Index -> FilePath -> IO Index-addFile idx p = do- doc <- TextReader.readDocument p- let idx2 = addDocument doc idx- return idx2 - ---- | Command tosearch index-searchCmd :: [String] -> Index -> IO ()-searchCmd (t:_) idx = do - let result = {-# SCC "search" #-} search idx t- putStrLn $ "Search term: " ++ show t ++ " found in documents: "- _ <- mapM (putStrLn . show) result- return ()-searchCmd _ _ = error "search command requires search terms"--
test-src/AllTests.hs view
@@ -2,12 +2,9 @@ import qualified Distribution.TestSuite as C import qualified Distribution.TestSuite.HUnit as H-import Condor.TextTest (testCases)-import Condor.IndexTest (testCases)-import Condor.Language.English.PorterTest (testCases)+import Condor.Search.IndexTest (testCases) tests :: IO [C.Test]-tests = return $ map (uncurry H.test) $ Condor.TextTest.testCases- ++ Condor.IndexTest.testCases- ++ Condor.Language.English.PorterTest.testCases+tests = return $ map (uncurry H.test) $ Condor.Search.IndexTest.testCases+
− test-src/Condor/IndexTest.hs
@@ -1,100 +0,0 @@-{- |-Module : Condor.IndexTest-Copyright : Copyright (C) 2013-2014 Krzysztof Langner-License : The MIT License (MIT)--Maintainer : Krzysztof Langner <klangner@gmail.com>-Stability : alpha-Portability : portable--Unit tests for Condor.Index module--}--module Condor.IndexTest (testCases) where--import Data.Binary-import qualified Data.Text as T-import Condor.DataTypes (DocName, Document(..), docFromStrings)-import Condor.Index-import Test.HUnit---testCases :: [(String, Test)]-testCases = [ ( "Empty index has length 0"- , TestCase $ prop_empty)- - , ( "Space separates terms"- , TestCase $ prop_termCount (docFromStrings "doc1" "one two three") 3)- - , ( "Check stop words"- , TestCase $ prop_termCount (docFromStrings "doc1" "one and two or three") 3)- - , ( "Search for term with the same case"- , TestCase $ prop_search "two" (T.pack "doc1") [docFromStrings "doc1" "one two three"])- - , ( "Search for first term"- , TestCase $ prop_search "one" (T.pack "doc1") [ docFromStrings "doc1" "one two three" - , docFromStrings "doc2" "forty two"- ])- - , ( "Search for term in second document"- , TestCase $ prop_search "two" (T.pack "doc2") [ docFromStrings "doc1" "one two three" - , docFromStrings "doc2" "forty two"- ])- - , ( "Search for lower case term. Document has upper case"- , TestCase $ prop_search "two" (T.pack "doc1") [docFromStrings "doc1" "One Two Three"])- - , ( "Search for upperr case term. Document has lower case"- , TestCase $ prop_search "Three" (T.pack "doc1") [docFromStrings "doc1" "one two three"])- - , ( "Search for 2 terms"- , TestCase $ prop_search "one Three" (T.pack "doc1") [docFromStrings "doc1" "one two three"])- - , ( "Single doc"- , TestCase $ prop_search_count "one" 1 [ docFromStrings "doc1" "one two three" - , docFromStrings "doc2" "forty two"- ])- - , ( "Document should be returned only once"- , TestCase $ prop_search_count "two one" 2 [ docFromStrings "doc1" "one two three" - , docFromStrings "doc2" "forty two"- ])- - , ( "encode . decode == id"- , TestCase $ prop_serialize [ docFromStrings "doc1" "one two three" - , docFromStrings "doc2" "forty two"- ]) - ]- --- | Helper function to populate index -indexFromDocs :: [Document] -> Index-indexFromDocs ds = foldl f emptyIndex ds- where f i d = addDocument d i-- --- | Check empty index -prop_empty :: Assertion -prop_empty = assertEqual "Empty index has 0 size" 0 (termCount emptyIndex) - --- | Check if document is found -prop_search :: String -> DocName -> [Document] -> Assertion -prop_search s e ds = assertEqual s True $ elem e (search idx s)- where idx = indexFromDocs ds---- | Count number of returned documents -prop_search_count :: String -> Int -> [Document] -> Assertion -prop_search_count s n ds = assertEqual s n $ length (search idx s)- where idx = indexFromDocs ds- --- | Check number of terms -prop_termCount :: Document -> Int -> Assertion-prop_termCount d n = assertEqual "Count terms" n (termCount $ addDocument d emptyIndex) - --- | Check empty index -prop_serialize :: [Document] -> Assertion -prop_serialize ds = assertEqual "Serialize" (termCount idx) (termCount idx') - where idx = indexFromDocs ds - idx' = decode (encode idx)- -
− test-src/Condor/Language/English/PorterTest.hs
@@ -1,36 +0,0 @@-{- |-Module : Condor.Language.English.Porter2Test-Copyright : Copyright (C) 2013-2014 Krzysztof Langner-License : The MIT License (MIT)--Maintainer : Krzysztof Langner <klangner@gmail.com>-Stability : alpha-Portability : portable--Unit tests for Condor.Language.English.Porter2 module--}--module Condor.Language.English.PorterTest (testCases) where--import qualified Data.Text as T-import Condor.Language.English.Porter-import Test.HUnit---testCases :: [(String, Test)]-testCases = [("Porter", t) | t <- tests]--tests :: [Test]-tests = [ TestCase $ prop_stem "consign" "consign"- , TestCase $ prop_stem "class's" "class'"- , TestCase $ prop_stem "classes" "class"- , TestCase $ prop_stem "cried" "cri"- , TestCase $ prop_stem "ties" "ti"- , TestCase $ prop_stem "gas" "ga"- , TestCase $ prop_stem "gaps" "gap"- , TestCase $ prop_stem "bleed" "bleed"- , TestCase $ prop_stem "guaranteed" "guarante"- ]- -prop_stem :: String -> String -> Assertion -prop_stem a b = assertEqual a (T.pack b) (stem (T.pack a))
+ test-src/Condor/Search/IndexTest.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE OverloadedStrings #-}+{- |+Module : Condor.Search.IndexTest+Copyright : Copyright (C) 2013-2014 Krzysztof Langner+License : BSD3++Maintainer : Krzysztof Langner <klangner@gmail.com>+Stability : alpha+Portability : portable+-}++module Condor.Search.IndexTest (testCases) where++import Data.Binary+import qualified Data.Text as T+import Condor.Commons.Document (DocName, Document, docFromStrings)+import Condor.Search.Index+import Test.HUnit+++testCases :: [(String, Test)]+testCases = [ ( "Empty index has length 0"+ , TestCase prop_empty)+ + , ( "Space separates terms"+ , TestCase $ prop_termCount (docFromStrings "doc1" "one two three") 3)+ + , ( "Check stop words"+ , TestCase $ prop_termCount (docFromStrings "doc1" "one and two or three") 3)+ + , ( "There are 2 documents"+ , TestCase $ prop_docCount [ docFromStrings "doc1" "one two three" + , docFromStrings "doc2" "forty two"+ ]+ 2)+ + , ( "Search for term with the same case"+ , TestCase $ prop_search "two" "doc1" [docFromStrings "doc1" "one two three"])+ + , ( "Search for first term"+ , TestCase $ prop_search "one" "doc1" [ docFromStrings "doc1" "one two three" + , docFromStrings "doc2" "forty two"+ ])+ + , ( "Search for term in second document"+ , TestCase $ prop_search "two" "doc2" [ docFromStrings "doc1" "one two three" + , docFromStrings "doc2" "forty two"+ ])+ + , ( "Search for lower case term. Document has upper case"+ , TestCase $ prop_search "two" "doc1" [docFromStrings "doc1" "One Two Three"])+ + , ( "Search for upperr case term. Document has lower case"+ , TestCase $ prop_search "Three" "doc1" [docFromStrings "doc1" "one two three"])+ + , ( "Search for 2 terms"+ , TestCase $ prop_search "one Three" "doc1" [docFromStrings "doc1" "one two three"])+ + , ( "Single doc"+ , TestCase $ prop_search_count "one" 1 [ docFromStrings "doc1" "one two three" + , docFromStrings "doc2" "forty two"+ ])+ + , ( "Document should be returned only once"+ , TestCase $ prop_search_count "two one" 2 [ docFromStrings "doc1" "one two three" + , docFromStrings "doc2" "forty two"+ ])+ + , ( "encode . decode == id"+ , TestCase $ prop_serialize [ docFromStrings "doc1" "one two three" + , docFromStrings "doc2" "forty two"+ ]) + ]+ +-- | Helper function to populate index +indexFromDocs :: [Document] -> Index+indexFromDocs = foldl f emptyIndex+ where f i d = addDocument d i++ +-- | Check empty index +prop_empty :: Assertion +prop_empty = assertEqual "Empty index has 0 size" 0 (termCount emptyIndex) + +-- | Check if document is found +prop_search :: T.Text -> DocName -> [Document] -> Assertion +prop_search s e ds = assertEqual (show s) True $ elem e (search idx s)+ where idx = indexFromDocs ds++-- | Count number of returned documents +prop_search_count :: T.Text -> Int -> [Document] -> Assertion +prop_search_count s n ds = assertEqual (show s) n $ length (search idx s)+ where idx = indexFromDocs ds+ +-- | Check number of terms +prop_termCount :: Document -> Int -> Assertion+prop_termCount d n = assertEqual "Count terms" n (termCount $ addDocument d emptyIndex) + +-- | Check number of document +prop_docCount :: [Document] -> Int -> Assertion+prop_docCount ds n = assertEqual "Count docs" n (docCount $ indexFromDocs ds) + +-- | Check empty index +prop_serialize :: [Document] -> Assertion +prop_serialize ds = assertEqual "Serialize" (termCount idx) (termCount idx') + where idx = indexFromDocs ds + idx' = decode (encode idx)+ +
− test-src/Condor/TextTest.hs
@@ -1,33 +0,0 @@-{- |-Module : Condor.TextTest-Copyright : Copyright (C) 2013-2014 Krzysztof Langner-License : The MIT License (MIT)--Maintainer : Krzysztof Langner <klangner@gmail.com>-Stability : alpha-Portability : portable--Unit tests for Condor.Text module--}--module Condor.TextTest (testCases) where--import qualified Data.Text as T-import Condor.Text-import Test.HUnit---testCases :: [(String, Test)]-testCases = [("Text", t) | t <- tests]--tests :: [Test]-tests = [ TestCase $ prop_tokenize_count (T.pack "one two three") 3- , TestCase $ prop_tokenize_count (T.pack "one,two ") 2- , TestCase $ prop_tokenize_token (T.pack " one?two! ") 1 (T.pack "two")- ]- -prop_tokenize_count :: T.Text -> Int -> Assertion -prop_tokenize_count xs n = assertEqual (show xs) n (length (tokenize xs)) --prop_tokenize_token :: T.Text -> Int -> T.Text -> Assertion -prop_tokenize_token xs i t = assertEqual (show xs) t ((tokenize xs)!!i)