packages feed

glider-nlp (empty) → 0.1

raw patch · 16 files changed

+1189/−0 lines, 16 filesdep +Cabaldep +HUnitdep +basesetup-changed

Dependencies added: Cabal, HUnit, base, containers, text

Files

+ CHANGES view
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ glider-nlp.cabal view
@@ -0,0 +1,67 @@+name:           glider-nlp+version:        0.1+cabal-version:  >=1.10+build-type:     Simple+author:         Krzysztof Langner+maintainer:     klangner@gmail.com+stability:      Alpha - not stable+synopsis:       Natural Language Processing library+homepage:       https://github.com/klangner/glider-nlp+Bug-reports:    https://github.com/klangner/glider-nlp/issues+category:       NLP, Text, Library+License:        BSD3+License-file:   LICENSE+Extra-Source-Files:+                CHANGES+description:    +    Natural Language Processing (NLP) library.+    .+    Check module in folder "Glider.NLP.Statistics" for universal functions and +    Glider.NLP.Language.language for functions designed for specific language.++source-repository head+  type:     git+  location: https://github.com/klangner/condor-nlp++library+  hs-source-dirs:   src+  default-language: Haskell2010+  ghc-options:      -Wall+  build-depends:    +                    base >= 4 && <4.7,+                    text >=1 && <1.1,+                    containers >=0.5.0 && <0.6+  exposed-modules:  +                    Glider.NLP.Language.English.Porter,+                    Glider.NLP.Language.English.StopWords,+                    Glider.NLP.Language.Polish.StopWords,+                    Glider.NLP.Statistics,+                    Glider.NLP.Tokenizer+  other-modules:    Glider.NLP.Language.Default++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,+                    text >=1 && <1.1,+                    containers >=0.5.0 && <0.6+  hs-source-dirs:  +                    src,+                    test-src+  other-modules:    +                    Distribution.TestSuite.HUnit,+                    Glider.NLP.Language.Default,+                    Glider.NLP.Language.DefaultTest,+                    Glider.NLP.Language.English.Porter,+                    Glider.NLP.Language.English.PorterTest,+                    Glider.NLP.Language.English.StopWords,+                    Glider.NLP.Language.Polish.StopWords,+                    Glider.NLP.Statistics,+                    Glider.NLP.StatisticsTest,+                    Glider.NLP.Tokenizer,+                    Glider.NLP.TokenizerTest
+ src/Glider/NLP/Language/Default.hs view
@@ -0,0 +1,22 @@+{- |+Module : Glider.NLP.Language.Default+Copyright : Copyright (C) 2013-2014 Krzysztof Langner+License : BSD3++Maintainer : Krzysztof Langner <klangner@gmail.com>+Stability : alpha+Portability : portable++This module contains default implementation for language specific algorithms.+If there is no specific algorithm for yor language you can use one from this module.++-}+module Glider.NLP.Language.Default (isStopWord) where+    +import Prelude hiding (length)    +import Data.Text+    ++-- | Any less then 4 characters words is marked as stop word+isStopWord :: Text -> Bool+isStopWord w = length w < 4
+ src/Glider/NLP/Language/English/Porter.hs view
@@ -0,0 +1,177 @@+{- |+Module : Glider.NLP.Language.English.Porter+Copyright : Dmitry Antonyuk+License : BSD3++Maintainer : Krzysztof Langner <klangner@gmail.com>+Stability : alpha+Portability : portable++This code was taken from: http://tartarus.org/~martin/PorterStemmer/haskell.txt +-}+module Glider.NLP.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/Glider/NLP/Language/English/StopWords.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE OverloadedStrings #-}+{- |+Module : Glider.NLP.Language.English.StopWords+Copyright : Copyright (C) 2013-2014 Krzysztof Langner+License : BSD3++Maintainer : Krzysztof Langner <klangner@gmail.com>+Stability : alpha+Portability : portable++Module contains stop words for English language++-}+module Glider.NLP.Language.English.StopWords (isStopWord) where+    +import qualified Data.Set as S    +import Data.Text+    ++-- | Predicate to check if given words is a stop word+isStopWord :: Text -> Bool+isStopWord w = S.member w stopWords++stopWords :: S.Set Text+stopWords = S.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/Glider/NLP/Language/Polish/StopWords.hs view
@@ -0,0 +1,370 @@+{-# LANGUAGE OverloadedStrings #-}+{- |+Module : Glider.NLP.Language.Polish.StopWords+Copyright : Copyright (C) 2013-2014 Krzysztof Langner+License : BSD3++Maintainer : Krzysztof Langner <klangner@gmail.com>+Stability : alpha+Portability : portable++Module contains stop words for Polish language++-}+module Glider.NLP.Language.Polish.StopWords (isStopWord) where+    +import qualified Data.Set as S    +import Data.Text+    ++-- | Predicate to check if given words is a stop word+isStopWord :: Text -> Bool+isStopWord w = S.member w stopWords++stopWords :: S.Set Text+stopWords = S.fromList+    [ "a"+    ,"aby"+    ,"ach"+    ,"acz"+    ,"aczkolwiek"+    ,"aj"+    ,"albo"+    ,"ale"+    ,"alez"+    ,"ależ"+    ,"ani"+    ,"az"+    ,"aż"+    ,"bardziej"+    ,"bardzo"+    ,"bo"+    ,"bowiem"+    ,"by"+    ,"byli"+    ,"bynajmniej"+    ,"byc"+    ,"być"+    ,"byl"+    ,"był"+    ,"byla"+    ,"bylo"+    ,"byly"+    ,"była"+    ,"było"+    ,"były"+    ,"bedzie"+    ,"będzie"+    ,"beda"+    ,"będą"+    ,"cali"+    ,"cala"+    ,"cała"+    ,"caly"+    ,"cały"+    ,"ci"+    ,"cie"+    ,"cię"+    ,"ciebie"+    ,"co"+    ,"cokolwiek"+    ,"cos"+    ,"coś"+    ,"czasami"+    ,"czasem"+    ,"czemu"+    ,"czy"+    ,"czyli"+    ,"daleko"+    ,"dla"+    ,"dlaczego"+    ,"dlatego"+    ,"do"+    ,"dobrze"+    ,"dokad"+    ,"dokąd"+    ,"dosc"+    ,"dość"+    ,"duzo"+    ,"dużo"+    ,"dwa"+    ,"dwaj"+    ,"dwie"+    ,"dwoje"+    ,"dzis"+    ,"dziś"+    ,"dzisiaj"+    ,"gdy"+    ,"gdyby"+    ,"gdyz"+    ,"gdyż"+    ,"gdzie"+    ,"gdziekolwiek"+    ,"gdzies"+    ,"gdzieś"+    ,"go"+    ,"i"+    ,"ich"+    ,"ile"+    ,"im"+    ,"inna"+    ,"inne"+    ,"inny"+    ,"innych"+    ,"iz"+    ,"iż"+    ,"ja"+    ,"ją"+    ,"jak"+    ,"jakas"+    ,"jakaś"+    ,"jakby"+    ,"jaki"+    ,"jakichs"+    ,"jakichś"+    ,"jakie"+    ,"jakis"+    ,"jakiś"+    ,"jakiz"+    ,"jakiż"+    ,"jakkolwiek"+    ,"jako"+    ,"jakos"+    ,"jakoś"+    ,"je"+    ,"jeden"+    ,"jedna"+    ,"jedno"+    ,"jednak"+    ,"jednakze"+    ,"jednakże"+    ,"jego"+    ,"jej"+    ,"jemu"+    ,"jest"+    ,"jestem"+    ,"jeszcze"+    ,"jesli"+    ,"jeśli"+    ,"jezeli"+    ,"jeżeli"+    ,"juz"+    ,"już"+    ,"kazdy"+    ,"każdy"+    ,"kiedy"+    ,"kilka"+    ,"kims"+    ,"kimś"+    ,"kto"+    ,"ktokolwiek"+    ,"ktos"+    ,"ktoś"+    ,"ktora"+    ,"ktore"+    ,"które"+    ,"ktorego"+    ,"ktorej"+    ,"ktory"+    ,"ktorych"+    ,"ktorym"+    ,"ktorzy"+    ,"która"+    ,"którego"+    ,"której"+    ,"który"+    ,"których"+    ,"którym"+    ,"którzy"+    ,"ku"+    ,"lat"+    ,"lecz"+    ,"lub"+    ,"ma"+    ,"mają"+    ,"mało"+    ,"mam"+    ,"mi"+    ,"mimo"+    ,"miedzy"+    ,"między"+    ,"mna"+    ,"mną"+    ,"mnie"+    ,"moga"+    ,"mogą"+    ,"moi"+    ,"moim"+    ,"moja"+    ,"moje"+    ,"moze"+    ,"może"+    ,"mozliwe"+    ,"mozna"+    ,"możliwe"+    ,"można"+    ,"moj"+    ,"mój"+    ,"mu"+    ,"musi"+    ,"my"+    ,"na"+    ,"nad"+    ,"nam"+    ,"nami"+    ,"nas"+    ,"nasi"+    ,"nasz"+    ,"nasza"+    ,"nasze"+    ,"naszego"+    ,"naszych"+    ,"natomiast"+    ,"natychmiast"+    ,"nawet"+    ,"nia"+    ,"nią"+    ,"nic"+    ,"nich"+    ,"nie"+    ,"niech"+    ,"niego"+    ,"niej"+    ,"niemu"+    ,"nigdy"+    ,"nim"+    ,"nimi"+    ,"niz"+    ,"niż"+    ,"no"+    ,"o"+    ,"obok"+    ,"od"+    ,"około"+    ,"on"+    ,"ona"+    ,"one"+    ,"oni"+    ,"ono"+    ,"oraz"+    ,"oto"+    ,"owszem"+    ,"pan"+    ,"pana"+    ,"pani"+    ,"po"+    ,"pod"+    ,"podczas"+    ,"pomimo"+    ,"ponad"+    ,"poniewaz"+    ,"ponieważ"+    ,"powinien"+    ,"powinna"+    ,"powinni"+    ,"powinno"+    ,"poza"+    ,"prawie"+    ,"przeciez"+    ,"przecież"+    ,"przed"+    ,"przede"+    ,"przedtem"+    ,"przez"+    ,"przy"+    ,"roku"+    ,"rowniez"+    ,"również"+    ,"sam"+    ,"sama"+    ,"są"+    ,"sie"+    ,"się"+    ,"skad"+    ,"skąd"+    ,"sobie"+    ,"soba"+    ,"sobą"+    ,"sposob"+    ,"sposób"+    ,"swoje"+    ,"ta"+    ,"tak"+    ,"taka"+    ,"taki"+    ,"takie"+    ,"takze"+    ,"także"+    ,"tam"+    ,"te"+    ,"tego"+    ,"tej"+    ,"ten"+    ,"teraz"+    ,"też"+    ,"to"+    ,"toba"+    ,"tobą"+    ,"tobie"+    ,"totez"+    ,"toteż"+    ,"trzeba"+    ,"tu"+    ,"tutaj"+    ,"twoi"+    ,"twoim"+    ,"twoja"+    ,"twoje"+    ,"twym"+    ,"twoj"+    ,"twój"+    ,"ty"+    ,"tych"+    ,"tylko"+    ,"tym"+    ,"u"+    ,"w"+    ,"wam"+    ,"wami"+    ,"was"+    ,"wasz"+    ,"wasza"+    ,"wasze"+    ,"we"+    ,"według"+    ,"wiele"+    ,"wielu"+    ,"więc"+    ,"więcej"+    ,"wszyscy"+    ,"wszystkich"+    ,"wszystkie"+    ,"wszystkim"+    ,"wszystko"+    ,"wtedy"+    ,"wy"+    ,"wlasnie"+    ,"właśnie"+    ,"z"+    ,"za"+    ,"zapewne"+    ,"zawsze"+    ,"ze"+    ,"znowu"+    ,"znow"+    ,"znów"+    ,"zostal"+    ,"został"+    ,"zaden"+    ,"zadna"+    ,"zadne"+    ,"zadnych"+    ,"ze"+    ,"zeby"+    ,"żaden"+    ,"żadna"+    ,"żadne"+    ,"żadnych"+    ,"że"+    ,"żeby"+    ]
+ src/Glider/NLP/Statistics.hs view
@@ -0,0 +1,35 @@+{- |+Module : Glider.NLP.Statistics+Copyright : Copyright (C) 2013-2014 Krzysztof Langner+License : BSD3++Maintainer : Krzysztof Langner <klangner@gmail.com>+Stability : alpha+Portability : portable++This module counts different statistics on the text++-}+module Glider.NLP.Statistics +    ( countWords+    , wordFreq+    ) where++import Prelude hiding(length)+import Data.Text+import Glider.NLP.Tokenizer+import qualified Data.List as List+++-- | Count number of words in the text.+--+-- > countWords (T.pack "one two three") == 3+countWords :: Text -> Int    +countWords = List.length . getWords . tokenize++-- | Count word frequency+--+-- > wordFreq (T.pack "one two, three one") == [("one", 2), ("two", 1), ("three", 1)]+wordFreq :: Text -> [(Text, Int)]+wordFreq a = [(List.head xs, List.length xs) | xs <- List.group tokens]+    where tokens = List.sort $ (foldCase . getWords . tokenize) a
+ src/Glider/NLP/Tokenizer.hs view
@@ -0,0 +1,118 @@+{- |+Module : Glider.NLP.Tokenizer+Copyright : Copyright (C) 2013-2014 Krzysztof Langner+License : BSD3++Maintainer : Krzysztof Langner <klangner@gmail.com>+Stability : alpha+Portability : portable++This module contains functions which parses text into tokens. +tokens are not normalized. If you need all tokens from the document then +check function "tokenize". If you need only words (na dots, numbers etc.) +then check function "getWords".++-}+module Glider.NLP.Tokenizer +    ( Token(..)+    , foldCase+    , getWords+    , tokenize+    , wordParser+    , numberParser+    , punctuationParser+    , symbolParser+    , spaceParser+    , allParser+    ) where++import Prelude hiding (null, takeWhile, dropWhile, head, tail)    +import Data.Text+import Data.Char+import qualified Data.List as List++-- | Token type+data Token = Word Text+           | Number Text+           | Punctuation Char+           | Symbol Char+           | Whitespace+           | Unknown Char+           deriving (Eq, Show)+++-- | Split text into tokens+--+-- > tokenize "one two." == [Word "one", Whitespace, Word "two", "Separator "."] +tokenize :: Text -> [Token]+tokenize xs = case allParser xs of+                [(v, out)] -> (v:tokenize out)+                _ -> []+                +-- | Exctract all words from tokens+--+-- > getWords "one two." == ["one", "two"] +getWords :: [Token] -> [Text]+getWords [] = []+getWords (x:xs) = case x of+                        Word a -> (a: getWords xs)+                        _ -> getWords xs+                        +-- | Convert all words to the same case+foldCase :: [Text] -> [Text]+foldCase = List.map toCaseFold                                          +    ++-- | Parser type+type Parser = Text -> [(Token, Text)]++-- | Parse word+wordParser :: Parser+wordParser xs | null xs = []+              | isLetter (head xs) = [(Word (takeWhile isAlphaNum xs), dropWhile isAlphaNum xs)]+              | otherwise = []++-- | Parse number+numberParser :: Parser+numberParser xs | null xs = []+                | isDigit (head xs) = [(Number (takeWhile isDigit xs), dropWhile isDigit xs)]+                | otherwise = []++-- | Parse punctuation+punctuationParser :: Parser+punctuationParser xs | null xs = []+                     | isPunctuation (head xs) = [(Punctuation (head xs), (tail xs))]+                     | otherwise = []++-- | Parse symbol+symbolParser :: Parser+symbolParser xs | null xs = []+                | isSymbol (head xs) = [(Symbol (head xs), (tail xs))]+                | otherwise = []+                            +-- | Parse whitespaces+spaceParser :: Parser+spaceParser xs | null xs = []+               | isSpace (head xs) = [(Whitespace, dropWhile isSpace xs)]+               | otherwise = []+                            +-- | Parse single char+charParser :: Parser+charParser xs | null xs = []+              | otherwise = [(Unknown (head xs), tail xs)]++-- | Apply all parsers to the input. +-- Return result from the first which will parse correctly given text.+allParser :: Parser+allParser xs = case wordParser xs of+                [(v, out)] -> [(v, out)]+                _ -> case numberParser xs of               +                        [(v, out)] -> [(v, out)]+                        _ -> case punctuationParser xs of               +                            [(v, out)] -> [(v, out)]+                            _ -> case symbolParser xs of               +                                [(v, out)] -> [(v, out)]+                                _ -> case spaceParser xs of               +                                    [(v, out)] -> [(v, out)]+                                    _ -> charParser xs+                
+ test-src/AllTests.hs view
@@ -0,0 +1,17 @@+module AllTests (tests) where++import qualified Distribution.TestSuite as C+import qualified Distribution.TestSuite.HUnit as H+import Glider.NLP.TokenizerTest (testCases)+import Glider.NLP.StatisticsTest (testCases)+import Glider.NLP.Language.English.PorterTest (testCases)+import Glider.NLP.Language.DefaultTest (testCases)+++tests :: IO [C.Test]+tests = return $ map (uncurry H.test) $  Glider.NLP.TokenizerTest.testCases+                                      ++ Glider.NLP.Language.English.PorterTest.testCases+                                      ++ Glider.NLP.Language.DefaultTest.testCases+                                      ++ Glider.NLP.StatisticsTest.testCases+                                      +                                      
+ 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)
+ test-src/Glider/NLP/Language/DefaultTest.hs view
@@ -0,0 +1,28 @@+{- |+Module : Glider.NLP.Language.DefaultTest+Copyright : Copyright (C) 2013-2014 Krzysztof Langner+License : BSD3++Maintainer : Krzysztof Langner <klangner@gmail.com>+Stability : alpha+Portability : portable+-}++module Glider.NLP.Language.DefaultTest (testCases) where++import Data.Text +import Glider.NLP.Language.Default+import Test.HUnit+++testCases :: [(String, Test)]+testCases = [ ( "Less then 4 chars" +              , TestCase $ prop_isStopWord "abc" True)+            , ( "4 chars not stop word" +              , TestCase $ prop_isStopWord "abcd" False)+            ]++-- | Check empty index         +prop_isStopWord :: String -> Bool -> Assertion         +prop_isStopWord a e = assertEqual a e (isStopWord (pack a))          +              
+ test-src/Glider/NLP/Language/English/PorterTest.hs view
@@ -0,0 +1,34 @@+{- |+Module : Glider.NLP.Language.English.Porter2Test+Copyright : Copyright (C) 2013-2014 Krzysztof Langner+License : BSD3++Maintainer : Krzysztof Langner <klangner@gmail.com>+Stability : alpha+Portability : portable+-}++module Glider.NLP.Language.English.PorterTest (testCases) where++import qualified Data.Text as T+import Glider.NLP.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/Glider/NLP/StatisticsTest.hs view
@@ -0,0 +1,39 @@+{- |+Module : Glider.NLP.IndexTest+Copyright : Copyright (C) 2013-2014 Krzysztof Langner+License : BSD3++Maintainer : Krzysztof Langner <klangner@gmail.com>+Stability : alpha+Portability : portable+-}++module Glider.NLP.StatisticsTest (testCases) where++import qualified Data.Text as T+import Glider.NLP.Statistics+import Test.HUnit+++testCases :: [(String, Test)]+testCases = [ ( "Count words"+              , TestCase $ prop_countWords "one two three" 3)+            +            , ( "Single word frequency"+              , TestCase $ prop_wordFreq "one" [("one", 1)])+            +            , ( "2 words frequency"+              , TestCase $ prop_wordFreq "one two" [("one", 1), ("two", 1)])+            +            , ( "Multi words frequency"+              , TestCase $ prop_wordFreq "one two one" [("one", 2), ("two", 1)])+            ]+         +-- | Count number of words       +prop_countWords :: String -> Int ->  Assertion         +prop_countWords xs n = assertEqual xs n $ countWords (T.pack xs)++-- | Check word frequency          +prop_wordFreq :: String -> [(String, Int)] ->  Assertion         +prop_wordFreq xs es = assertEqual xs expected $ wordFreq (T.pack xs)+    where expected = [(T.pack a, b) | (a, b) <- es]
+ test-src/Glider/NLP/TokenizerTest.hs view
@@ -0,0 +1,35 @@+{- |+Module : Glider.NLP.TokenizerTest+Copyright : Copyright (C) 2013-2014 Krzysztof Langner+License : BSD3++Maintainer : Krzysztof Langner <klangner@gmail.com>+Stability : alpha+Portability : portable+-}++module Glider.NLP.TokenizerTest (testCases) where++import qualified Data.Text as T+import Glider.NLP.Tokenizer+import Test.HUnit+++testCases :: [(String, Test)]+testCases = [ ( "Empty string"+              , TestCase $ prop_tokenize [] ""+              )+              +            , ( "Empty string"+              , TestCase $ prop_tokenize [ Word $ T.pack "one"+                                         , Whitespace+                                         , Word $ T.pack "two"+                                         , Whitespace+                                         , Word $ T.pack "three"+                                         ] +                                         "one two three"+              )  +            ]+         +prop_tokenize :: [Token] -> String -> Assertion         +prop_tokenize e a = assertEqual a e (tokenize (T.pack a))