Condor (empty) → 0.1
raw patch · 15 files changed
+856/−0 lines, 15 filesdep +Cabaldep +HUnitdep +basesetup-changed
Dependencies added: Cabal, HUnit, base, binary, containers, directory, filepath
Files
- CHANGES +1/−0
- Condor.cabal +74/−0
- LICENSE +20/−0
- Setup.hs +2/−0
- dist/build/unit-testsStub/unit-testsStub-tmp/unit-testsStub.hs +5/−0
- src/Condor/Index.hs +104/−0
- src/Condor/Language/English/Porter.hs +165/−0
- src/Condor/Language/English/StopWords.hs +150/−0
- src/Condor/Text.hs +36/−0
- src/Main.hs +79/−0
- test-src/AllTests.hs +13/−0
- test-src/Condor/IndexTest.hs +75/−0
- test-src/Condor/Language/English/PorterTest.hs +35/−0
- test-src/Condor/TextTest.hs +31/−0
- test-src/Distribution/TestSuite/HUnit.hs +66/−0
+ CHANGES view
@@ -0,0 +1,1 @@+0.1 Initial version
+ Condor.cabal view
@@ -0,0 +1,74 @@+name: Condor+version: 0.1+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-file: LICENSE+Extra-Source-Files:+ CHANGES++source-repository head+ type: git+ location: https://github.com/klangner/Condor++executable condor+ hs-source-dirs: src+ main-is: Main.hs+ 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+ ghc-options: -Wall+ other-modules: + Condor.Text,+ Condor.Index++library + hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall+ exposed-modules: Condor.Index+ other-modules: + Condor.Language.English.Porter,+ Condor.Language.English.StopWords,+ Condor.Text+ build-depends: + base >= 4 && <4.7,+ containers >=0.5.0 && <0.6,+ binary >=0.5.1 && <0.6++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+ 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+ hs-source-dirs: + src,+ test-src+
+ LICENSE view
@@ -0,0 +1,20 @@+The MIT License (MIT)++Copyright (c) 2014 Krzysztof Langner++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:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ dist/build/unit-testsStub/unit-testsStub-tmp/unit-testsStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test ( stubMain )+import AllTests ( tests )+main :: IO ()+main = stubMain tests
+ src/Condor/Index.hs view
@@ -0,0 +1,104 @@+{- |+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.)+But it should be possible to customize it for any language by modifying Index data type.++-}+module Condor.Index + ( DocName+ , Index+ , DocContent+ , addDocument+ , emptyIndex+ , search+ , termCount+ ) where++import qualified Data.Map as Map+import qualified Data.List as List+import Data.Binary+import Condor.Text+import Condor.Language.English.StopWords (isStopWord)+import Condor.Language.English.Porter (stem)+++type DocName = String+type DocContent = String++-- | Index parameters. Those parameters can be used to change how+-- the text is processed before adding to the index+data IndexParams = IndexParams { ignore :: String -> Bool+ , stemmer :: String -> String+ }+ +-- An instance of Binary to encode and decode an IndexParams in binary+instance Binary IndexParams where+ put _ = put (0 :: Word8)+ get = do tag <- getWord8+ case tag of+ _ -> return $ IndexParams isStopWord stem ++-- | Inverted index+data Index = Index { terms :: Map.Map String [String]+ , params :: IndexParams+ }++-- An instance of Binary to encode and decode an IndexParams in binary+instance Binary Index where+ put i = do put (terms i)+ put (params i)+ get = do i <- get+ p <- get+ return $ Index i p +++-- | Create empty index. +-- This index will be configured for english language.+emptyIndex :: Index+emptyIndex = Index Map.empty (IndexParams isStopWord stem)+++-- | Add document to the index+addDocument :: DocName -> DocContent -> Index -> Index+addDocument d c ix = Index (foldl f (terms ix) ws) (params ix)+ where ws = splitWords (params ix) c+ f i t = case Map.lookup t i of + Just a -> Map.insert t (d:a) i+ Nothing -> Map.insert t [d] i+++-- | Search term in the index+search :: Index -> DocContent -> [DocName]+search ix s = List.nub $ foldl (++) [] ys+ where ys = map (searchTerm ix) ws+ ws = splitWords (params ix) s+++-- | Search single term in the index+searchTerm :: Index -> String -> [DocName]+searchTerm ix s = case Map.lookup s (terms ix) of+ Just a -> a+ Nothing -> []+ ++-- | Get the number of terms in indexs+termCount :: Index -> Int+termCount ix = Map.size (terms ix)+++-- | Split text into tokens.+-- This function removes stop words and stems words+splitWords :: IndexParams -> String -> [String]+splitWords p s = map (stemmer p) (filter f t)+ where t = tokenize s+ f = \x -> not ((ignore p) x)+ +
+ src/Condor/Language/English/Porter.hs view
@@ -0,0 +1,165 @@+{- | 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++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++stem :: [Char] -> [Char]+stem s | length s < 3 = s+ | otherwise = allSteps s+
+ src/Condor/Language/English/StopWords.hs view
@@ -0,0 +1,150 @@+{- |+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 Data.Set + ++-- | Predicate to check if given words is a stop word+isStopWord :: String -> Bool+isStopWord w = member w stopWords++stopWords :: Set String+stopWords = fromList [ "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/Text.hs view
@@ -0,0 +1,36 @@+{- |+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 Data.Char (toLower)+++isSeparator :: Char -> Bool+isSeparator s = elem s " .,!?"++-- | Split string into tokens+tokenize :: String -> [String]+tokenize xs = case dropWhile isSeparator xs of+ "" -> []+ s' -> foldCase w : tokenize s''+ where (w, s'') = break isSeparator s'++-- | Convert string to lower case +foldCase :: String -> String+foldCase xs = map toLower xs +
+ src/Main.hs view
@@ -0,0 +1,79 @@+module Main where++import System.Environment+import System.IO+import System.Directory (getDirectoryContents, doesDirectoryExist)+import Control.Exception+import Control.Monad+import Data.Binary+import Condor.Index+++-- | Commands dispatcher+dispatch :: [(String, [String] -> Index -> IO Index)] +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+ idx2 <- action args idx+ -- This line is neccessary since otherwise there is problem with locked file+ -- Lazy evaluation first opens file for saving index + putStrLn $ "Entries count: " ++ show (termCount idx2)+ writeIndex indexFile idx2 +++-- | Read Index data from file+readIndex :: FilePath -> IO Index+readIndex p = decodeFile p++-- | Create empty index if can't read from file+readIndexError :: IOError -> IO Index+readIndexError _ = return emptyIndex++-- | Write index data to the file+writeIndex :: FilePath -> Index -> IO ()+writeIndex p i = do encodeFile p i++-- | Command to index all files from given folder +indexCmd :: [String] -> Index -> IO Index +indexCmd (p:_) idx = do + putStrLn $ "Added folder: " ++ p+ ds <- getDirectoryContents p + let ps = map ((p++"/")++) ds+ fs <- filterM (fmap not . doesDirectoryExist) ps+ idx2 <- foldM addFile idx fs+ return idx2+indexCmd _ _ = error "add command requires path to the documents"++-- | Add file to the index+addFile :: Index -> FilePath -> IO Index+addFile idx p = do+ putStrLn $ "Load content from: " ++ p+ withFile p ReadMode (\h -> do+ hSetEncoding h utf8+ contents <- hGetContents h + putStrLn $ "Content length: " ++ show (length contents)+ let idx2 = addDocument p contents idx+ putStrLn $ "Index entries: " ++ show (termCount idx2)+ return idx2 + ) + ++-- | Command tosearch index+searchCmd :: [String] -> Index -> IO Index+searchCmd (t:_) idx = do + let result = search idx t+ putStrLn $ "Search term: " ++ show t ++ " found in documents: "+ _ <- mapM putStrLn result+ return idx+searchCmd _ _ = error "search command requires search terms"++
+ test-src/AllTests.hs view
@@ -0,0 +1,13 @@+module AllTests (tests) where++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)+++tests :: IO [C.Test]+tests = return $ map (uncurry H.test) $ Condor.TextTest.testCases+ ++ Condor.IndexTest.testCases+ ++ Condor.Language.English.PorterTest.testCases
+ test-src/Condor/IndexTest.hs view
@@ -0,0 +1,75 @@+{- |+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 Condor.Index+import Test.HUnit+++testCases :: [(String, Test)]+testCases = [("Index", t) | t <- tests]++tests :: [Test]+tests = [ TestCase $ prop_empty+ , TestCase $ prop_termCount ("doc1", "one two three") 3+ , TestCase $ prop_termCount ("doc1", "one and two or three") 3+ , TestCase $ prop_search "two" "doc1" [("doc1", "one two three")]+ , TestCase $ prop_search "one" "doc1" [ ("doc1", "one two three") + , ("doc2", "forty two")+ ]+ , TestCase $ prop_search "two" "doc2" [ ("doc1", "one two three") + , ("doc2", "forty two")+ ]+ , TestCase $ prop_search "two" "doc1" [("doc1", "One Two Three")]+ , TestCase $ prop_search "Three" "doc1" [("doc1", "one two three")]+ , TestCase $ prop_search "one Three" "doc1" [("doc1", "one two three")]+ , TestCase $ prop_search_count "two one" 2 [ ("doc1", "one two three") + , ("doc2", "forty two")+ ]+ , TestCase $ prop_serialize [ ("doc1", "one two three") + , ("doc2", "forty two")+ ] + ]+ +-- | Helper function to populate index +indexFromDocs :: [(DocName, DocContent)] -> Index+indexFromDocs ds = foldl f emptyIndex ds+ where f i (d, c) = addDocument d c 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 -> [(DocName, DocContent)] -> 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 -> [(DocName, DocContent)] -> Assertion +prop_search_count s n ds = assertEqual s n $ length (search idx s)+ where idx = indexFromDocs ds+ +-- | Check number of terms +prop_termCount :: (DocName, DocContent) -> Int -> Assertion+prop_termCount (d, c) n = assertEqual ("Index size: " ++ c) n (termCount $ addDocument d c emptyIndex) + +-- | Check empty index +prop_serialize :: [(DocName, DocContent)] -> 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 view
@@ -0,0 +1,35 @@+{- |+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 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 b (stem a)
+ test-src/Condor/TextTest.hs view
@@ -0,0 +1,31 @@+{- |+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 Condor.Text+import Test.HUnit++testCases :: [(String, Test)]+testCases = [("Text", t) | t <- tests]++tests :: [Test]+tests = [ TestCase $ prop_tokenize_count "one two three" 3+ , TestCase $ prop_tokenize_count "one,two " 2+ , TestCase $ prop_tokenize_token " one?two! " 1 "two"+ ]+ +prop_tokenize_count :: String -> Int -> Assertion +prop_tokenize_count xs n = assertEqual xs n (length (tokenize xs)) ++prop_tokenize_token :: String -> Int -> String -> Assertion +prop_tokenize_token xs i t = assertEqual xs t ((tokenize xs)!!i)
+ test-src/Distribution/TestSuite/HUnit.hs view
@@ -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)