condor (empty) → 0.3

raw patch · 14 files changed

+687/−0 lines, 14 filesdep +Cabaldep +HUnitdep +basesetup-changed

Dependencies added: Cabal, HUnit, base, binary, containers, directory, filepath, glider-nlp, text

Files

• CHANGES +15/−0
• LICENSE +26/−0
• Setup.hs +2/−0
• condor.cabal +88/−0
• dist/build/unit-testsStub/unit-testsStub-tmp/unit-testsStub.hs +5/−0
• 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/Reader/Text.hs +29/−0
• src/Condor/Search/Index.hs +130/−0
• test-src/AllTests.hs +10/−0
• test-src/Condor/Search/IndexTest.hs +109/−0
• test-src/Distribution/TestSuite/HUnit.hs +66/−0

@@ -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

@@ -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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -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

@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test ( stubMain )+import AllTests ( tests )+main :: IO ()+main = stubMain tests

@@ -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]+    

@@ -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"++            

@@ -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

@@ -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                        +

@@ -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  +        )      +    

@@ -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+        +

@@ -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+                                      

@@ -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)+         +    

@@ -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+-- <ttuegel@gmail.com>, can be found at:+--+-- <http://community.haskell.org/~ttuegel/cabal-test-hunit>+--+-- 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)