diff --git a/CHANGES b/CHANGES new file mode 100644 --- /dev/null +++ b/CHANGES @@ -0,0 +1,15 @@ +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 +* Basic index implementation +* Basic command line tool diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) 2014 Krzysztof Langner +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/condor.cabal b/condor.cabal new file mode 100644 --- /dev/null +++ b/condor.cabal @@ -0,0 +1,88 @@ +name: condor +version: 0.3 +cabal-version: >= 1.10 +build-type: Simple +author: Krzysztof Langner +maintainer: klangner@gmail.com +synopsis: Information retrieval library +homepage: https://github.com/klangner/Condor +Bug-reports: https://github.com/klangner/Condor/issues +stability: Unstable interface, incomplete features. +category: Search, Text, Library +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-app, + src + default-language: Haskell2010 + build-depends: + base >= 4 && <4.7, + binary >=0.5.1 && <0.6, + containers >=0.5.0 && <0.6, + directory >=1.2.0 && <1.3, + filepath >=1.3.0 && <1.4, + text >=1 && <1.1, + glider-nlp >= 0.1 && <1 + + ghc-options: -Wall + other-modules: + 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.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, + glider-nlp >= 0.1 && <1 + other-modules: Condor.Commons.Unsafe + +test-suite unit-tests + type: detailed-0.9 + test-module: AllTests + default-language: Haskell2010 + ghc-options: -Wall -rtsopts + build-depends: + base >= 4 && <4.7, + HUnit >=1.2.5 && <1.3, + Cabal >=1.16.0 && <1.17, + containers >=0.5.0 && <0.6, + binary >=0.5.1 && <0.6, + text >=1 && <1.1, + glider-nlp >= 0.1 && <1 + + other-modules: + Condor.Commons.Document, + Condor.Commons.Unsafe, + Condor.Search.Index, + Condor.Search.IndexTest, + Distribution.TestSuite.HUnit + hs-source-dirs: + src, + test-src diff --git a/dist/build/unit-testsStub/unit-testsStub-tmp/unit-testsStub.hs b/dist/build/unit-testsStub/unit-testsStub-tmp/unit-testsStub.hs new file mode 100644 --- /dev/null +++ b/dist/build/unit-testsStub/unit-testsStub-tmp/unit-testsStub.hs @@ -0,0 +1,5 @@ +module Main ( main ) where +import Distribution.Simple.Test ( stubMain ) +import AllTests ( tests ) +main :: IO () +main = stubMain tests diff --git a/src-app/IO.hs b/src-app/IO.hs new file mode 100644 --- /dev/null +++ b/src-app/IO.hs @@ -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] + diff --git a/src-app/Main.hs b/src-app/Main.hs new file mode 100644 --- /dev/null +++ b/src-app/Main.hs @@ -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" + + diff --git a/src/Condor/Commons/Document.hs b/src/Condor/Commons/Document.hs new file mode 100644 --- /dev/null +++ b/src/Condor/Commons/Document.hs @@ -0,0 +1,48 @@ +{- | +Module : Condor.Commons.Document +Copyright : Copyright (C) 2014 Krzysztof Langner +License : BSD3 + +Maintainer : Krzysztof Langner +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 diff --git a/src/Condor/Commons/Unsafe.hs b/src/Condor/Commons/Unsafe.hs new file mode 100644 --- /dev/null +++ b/src/Condor/Commons/Unsafe.hs @@ -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 +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 + diff --git a/src/Condor/Reader/Text.hs b/src/Condor/Reader/Text.hs new file mode 100644 --- /dev/null +++ b/src/Condor/Reader/Text.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE BangPatterns #-} +{- | +Module : Condor.Reader.Text +Copyright : Copyright (C) 2014 Krzysztof Langner +License : BSD3 + +Maintainer : Krzysztof Langner +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 + ) + diff --git a/src/Condor/Search/Index.hs b/src/Condor/Search/Index.hs new file mode 100644 --- /dev/null +++ b/src/Condor/Search/Index.hs @@ -0,0 +1,130 @@ +{- | +Module : Condor.Search.Index +Copyright : Copyright (C) 2013-2014 Krzysztof Langner +License : BSD3 + +Maintainer : Krzysztof Langner +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 + + diff --git a/test-src/AllTests.hs b/test-src/AllTests.hs new file mode 100644 --- /dev/null +++ b/test-src/AllTests.hs @@ -0,0 +1,10 @@ +module AllTests (tests) where + +import qualified Distribution.TestSuite as C +import qualified Distribution.TestSuite.HUnit as H +import Condor.Search.IndexTest (testCases) + + +tests :: IO [C.Test] +tests = return $ map (uncurry H.test) $ Condor.Search.IndexTest.testCases + diff --git a/test-src/Condor/Search/IndexTest.hs b/test-src/Condor/Search/IndexTest.hs new file mode 100644 --- /dev/null +++ b/test-src/Condor/Search/IndexTest.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE OverloadedStrings #-} +{- | +Module : Condor.Search.IndexTest +Copyright : Copyright (C) 2013-2014 Krzysztof Langner +License : BSD3 + +Maintainer : Krzysztof Langner +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) + + diff --git a/test-src/Distribution/TestSuite/HUnit.hs b/test-src/Distribution/TestSuite/HUnit.hs new file mode 100644 --- /dev/null +++ b/test-src/Distribution/TestSuite/HUnit.hs @@ -0,0 +1,66 @@ +------------------------------------------------------------------------------- +-- | +-- Module : Distribution.TestSuite.HUnit +-- Copyright : Patrick Brisbin 2013 +-- +-- Maintainer : pbrisbin@gmail.com +-- Portability : portable +-- +-- Test interface for running HUnit tests via cabal. +-- +-- Usage: +-- +-- > import Test.HUnit +-- > +-- > import qualified Distribution.TestSuite as C +-- > import qualified Distribution.TestSuite.HUnit as H +-- > +-- > tests :: IO [C.Test] +-- > tests = return $ map (uncurry H.test) testCases +-- > +-- > testCases :: [(String, Test)] +-- > testCases = [("Truth test", truthTest)] +-- > +-- > truthTest :: Test +-- > truthTest = assertEqual True True +-- +-- An early version of this module, written by Thomas Tuegel +-- , can be found at: +-- +-- +-- +-- This file shares no code with that one, as the changes in Cabal 1.16 +-- required it be entirely rewritten. I've retained Thomas' LICENSE but +-- removed his copyright; I hope that's appropriate. +-- +------------------------------------------------------------------------------- +module Distribution.TestSuite.HUnit (test) where + +import Distribution.TestSuite +import qualified Test.HUnit as H + +test :: String -> H.Test -> Test +test n = Test . testInstance n + +testInstance :: String -> H.Test -> TestInstance +testInstance n t = TestInstance + { run = runTest t + , name = n + , tags = [] + , options = [] + , setOption = \_ _ -> Right $ testInstance n t + } + +runTest :: H.Test -> IO Progress +runTest = fmap snd . H.performTest onStart onError onFailure (Finished Pass) + + where + + onStart :: H.State -> Progress -> IO Progress + onStart _ = return + + onError :: String -> H.State -> Progress -> IO Progress + onError msg _ _ = return $ Finished (Error msg) + + onFailure :: String -> H.State -> Progress -> IO Progress + onFailure msg _ _ = return $ Finished (Fail msg)