fuzzy-parse 0.1.0.0 → 0.1.2.0

raw patch · 8 files changed

+339/−21 lines, 8 filesdep +safesetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: safe

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• README.markdown +131/−0
• Setup.hs +0/−2
• fuzzy-parse.cabal +9/−4
• src/Data/Text/Fuzzy/Attoparsec/Month.hs +46/−0
• src/Data/Text/Fuzzy/Section.hs +15/−0
• src/Data/Text/Fuzzy/Tokenize.hs +83/−15
• test/FuzzyParseSpec.hs +50/−0

@@ -1,5 +1,10 @@ # Revision history for fuzzy-parse +## 0.1.2.0++ - Techical release+ - Added some missed things+ ## 0.1.0.0 -- YYYY-mm-dd  * First version. Released on an unsuspecting world.

@@ -0,0 +1,131 @@+# About++# Data.Text.Fuzzy.Tokenize++The lightweight and multi-functional text tokenizer allowing different types of text tokenization+depending on it's settings.++It may be used in different sutiations, for DSL, text markups or even for parsing simple grammars+easier and sometimes faster than in case of usage mainstream parsing combinators or parser+generators.++The primary goal of this package  is to parse unstructured text data, however it may be  used for+parsing  such data formats as CSV with ease.++Currently it supports the following types of entities: atoms, string literals (currently with the+minimal set of escaped characters), punctuation characters and delimeters.++## Examples++### Simple CSV-like tokenization++```haskell+tokenize (delims ":") "aaa : bebeb : qqq ::::" :: [Text]++["aaa "," bebeb "," qqq "]+```++```haskell+tokenize (delims ":"<>sq<>emptyFields ) "aaa : bebeb : qqq ::::" :: [Text]++["aaa "," bebeb "," qqq ","","","",""]+```++```haskell+tokenize (delims ":"<>sq<>emptyFields ) "aaa : bebeb : qqq ::::" :: [Maybe Text]++[Just "aaa ",Just " bebeb ",Just " qqq ",Nothing,Nothing,Nothing,Nothing]+```++```haskell+tokenize (delims ":"<>sq<>emptyFields ) "aaa : 'bebeb:colon inside' : qqq ::::" :: [Maybe Text]++[Just "aaa ",Just " ",Just "bebeb:colon inside",Just " ",Just " qqq ",Nothing,Nothing,Nothing,Nothing]+```++```haskell+let spec = sl<>delims ":"<>sq<>emptyFields<>noslits+tokenize spec "   aaa :   'bebeb:colon inside' : qqq ::::" :: [Maybe Text]++[Just "aaa ",Just "bebeb:colon inside ",Just "qqq ",Nothing,Nothing,Nothing,Nothing]+```++```haskell+let spec = delims ":"<>sq<>emptyFields<>uw<>noslits+tokenize spec "  a  b  c  : 'bebeb:colon inside' : qqq ::::"  :: [Maybe Text]++[Just "a b c",Just "bebeb:colon inside",Just "qqq",Nothing,Nothing,Nothing,Nothing]+```++### Primitive lisp-like language++```haskell+{-# LANGUAGE QuasiQuotes, ExtendedDefaultRules #-}++import Text.InterpolatedString.Perl6 (q)+import Data.Text.Fuzzy.Tokenize++data TTok = TChar Char+          | TSChar Char+          | TPunct Char+          | TText Text+          | TStrLit Text+          | TKeyword Text+          | TEmpty+          deriving(Eq,Ord,Show)++instance IsToken TTok where+ mkChar = TChar+ mkSChar = TSChar+ mkPunct = TPunct+ mkText = TText+ mkStrLit = TStrLit+ mkKeyword = TKeyword+ mkEmpty = TEmpty++main = do++   let spec = delims " \n\t" <> comment ";"+                             <> punct "{}()[]<>"+                             <> sq <> sqq+                             <> uw+                             <> keywords ["define","apply","+"]+     let code = [q|+       (define add (a b ) ; define simple function+         (+ a b) )+       (define r (add 10 20))+|]+     let toks = tokenize spec code :: [TTok]++   print toks+```++## Notes++### About the delimeter tokens+This type of tokens appears during a "delimited" formats processing and disappears in results.+Currenly you will never see it unless normalization is turned off by 'nn' option.++The delimeters make sense in case of processing the CSV-like formats, but in this case you probably+need only values in results.++This behavior may be changed later. But right now delimeters seem pointless in results. If you+process some sort of grammar where delimeter character is important, you may use punctuation+instead, i.e:++```haskell+let spec = delims " \t"<>punct ",;()" <>emptyFields<>sq+tokenize spec "( delimeters , are , important, 'spaces are not');" :: [Text]++["(","delimeters",",","are",",","important",",","spaces are not",")",";"]+```++### Other+For CSV-like formats it makes sense to split text to lines first, otherwise newline characters may+cause to weird results+++# Authors++This library is written and maintained by Dmitry Zuikov, dzuikov@gmail.com+

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

@@ -1,7 +1,7 @@ cabal-version:       2.2  name:                fuzzy-parse-version:             0.1.0.0+version:             0.1.2.0 synopsis:            Tools for processing unstructured text data  description:@@ -12,7 +12,7 @@   grammars easier and sometimes faster than in case of usage mainstream parsing combinators   or parser generators. -  See the README.md, examples and modules documentation for more.+  See the README.markdown, examples and modules documentation for more.  license:             MIT license-file:        LICENSE@@ -25,6 +25,9 @@ homepage:            https://github.com/hexresearch/fuzzy-parse bug-reports:         https://github.com/hexresearch/fuzzy-parse/issues +extra-source-files:+    README.markdown+ source-repository this   type:     git   location: https://github.com/hexresearch/fuzzy-parse.git@@ -36,13 +39,15 @@    exposed-modules:     Data.Text.Fuzzy.Tokenize                       , Data.Text.Fuzzy.Dates--  other-modules:       Data.Text.Fuzzy.Attoparsec.Day+                     , Data.Text.Fuzzy.Section+                     , Data.Text.Fuzzy.Attoparsec.Day+                     , Data.Text.Fuzzy.Attoparsec.Month    build-depends:       base        >= 4.11 && <5                      , attoparsec  >= 0.13                      , containers                      , mtl         >= 2.2+                     , safe                      , text        >= 1.2                      , time        >= 1.8 

@@ -0,0 +1,46 @@+module Data.Text.Fuzzy.Attoparsec.Month ( fuzzyMonth, fuzzyMonthFromText+                                        ) where++import Control.Applicative ((<|>))+import Data.Attoparsec.Text (Parser,decimal,digit,letter,many1,parseOnly)+import Data.Map (Map)+import Data.Maybe+import Data.Text (Text)+import Data.Time.Calendar (Day,fromGregorian,gregorianMonthLength)+import qualified Data.Char as Char+import qualified Data.Map as Map+import qualified Data.Text as Text+++fuzzyMonth :: Parser Int+fuzzyMonth  = pMonthNum <|> pMonth++fuzzyMonthFromText :: Text -> Maybe Int+fuzzyMonthFromText = either (const Nothing) Just . parseOnly fuzzyMonth++pMonthNum :: Parser Int+pMonthNum = do+  n <- decimal+  if n >= 1 && n <= 13+    then pure n+    else fail "invalid months num"++pMonth :: Parser Int+pMonth = do+  mo <- many1 (Char.toLower <$> letter)+  maybe (fail "invalid month name") pure (Map.lookup mo months)+  where+    months :: Map String Int+    months = Map.fromList [ ("jan",  1), ("january"  ,  1)+                          , ("feb",  2), ("febuary"  ,  2)+                          , ("mar",  3), ("march"    ,  3)+                          , ("apr",  4), ("april"    ,  4)+                          , ("may",  5), ("may"      ,  5)+                          , ("jun",  6), ("june"     ,  6)+                          , ("jul",  7), ("july"     ,  7)+                          , ("aug",  8), ("august"   ,  8)+                          , ("sep",  9), ("september",  9)+                          , ("oct", 10), ("october"  , 10)+                          , ("nov", 11), ("november" , 11)+                          , ("dec", 12), ("december" , 12)+                          ]

@@ -0,0 +1,15 @@+module Data.Text.Fuzzy.Section (cutSectionBy, cutSectionOn) where++import Data.Text (Text)+import qualified Data.List as List+++cutSectionOn :: Text -> Text -> [Text] -> [Text]+cutSectionOn a b txt = cutSectionBy ((==)a) ((==b)) txt++cutSectionBy :: (Text -> Bool) -> (Text -> Bool) -> [Text] -> [Text]+cutSectionBy a b txt = cutI+  where+    cutC = List.dropWhile (not . a) txt+    cutI = List.takeWhile (not . b) cutC+

@@ -82,20 +82,24 @@                                 , delims                                 , comment                                 , punct+                                , indent+                                , itabstops                                 , keywords+                                , eol                                 ) where  import Prelude hiding (init) -import Data.Set (Set)+import Control.Applicative import Data.Map (Map)+import Data.Maybe (fromMaybe)+import Data.Monoid()+import Data.Set (Set) import Data.Text (Text)-import qualified Data.Set as Set+import qualified Data.List as List import qualified Data.Map as Map+import qualified Data.Set as Set import qualified Data.Text as Text-import qualified Data.List as List-import Data.Monoid()-import Control.Applicative  import Control.Monad.RWS @@ -108,6 +112,7 @@                                  , tsNoSlits        :: Maybe Bool                                  , tsLineComment    :: Map Char Text                                  , tsDelims         :: Set Char+                                 , tsEol            :: Maybe Bool                                  , tsStripLeft      :: Maybe Bool                                  , tsStripRight     :: Maybe Bool                                  , tsUW             :: Maybe Bool@@ -115,6 +120,8 @@                                  , tsEsc            :: Maybe Bool                                  , tsAddEmptyFields :: Maybe Bool                                  , tsPunct          :: Set Char+                                 , tsIndent         :: Maybe Bool+                                 , tsItabStops      :: Maybe Int                                  , tsKeywords       :: Set Text                                  }                     deriving (Eq,Ord,Show)@@ -127,6 +134,7 @@                           , tsNoSlits     = tsNoSlits b <|> tsNoSlits a                           , tsLineComment = tsLineComment b <> tsLineComment a                           , tsDelims      = tsDelims b <> tsDelims a+                          , tsEol         = tsEol b <|> tsEol a                           , tsStripLeft   = tsStripLeft b <|> tsStripLeft a                           , tsStripRight  = tsStripRight b <|> tsStripRight a                           , tsUW          = tsUW b <|> tsUW a@@ -134,6 +142,8 @@                           , tsEsc         = tsEsc b <|> tsEsc a                           , tsAddEmptyFields = tsAddEmptyFields b <|> tsAddEmptyFields a                           , tsPunct = tsPunct b <> tsPunct a+                          , tsIndent = tsIndent b <|> tsIndent a+                          , tsItabStops = tsItabStops b <|> tsItabStops a                           , tsKeywords = tsKeywords b <> tsKeywords a                           } @@ -144,6 +154,7 @@                         , tsNoSlits = Nothing                         , tsLineComment = mempty                         , tsDelims = mempty+                        , tsEol = Nothing                         , tsStripLeft = Nothing                         , tsStripRight = Nothing                         , tsUW = Nothing@@ -151,6 +162,8 @@                         , tsEsc = Nothing                         , tsAddEmptyFields = Nothing                         , tsPunct = mempty+                        , tsIndent = Nothing+                        , tsItabStops = Nothing                         , tsKeywords = mempty                         } @@ -159,9 +172,13 @@ justTrue (Just True) = True justTrue _ = False +-- | Turns on EOL token generation+eol :: TokenizeSpec+eol = mempty { tsEol = pure True }+ -- | Turn on character escaping inside string literals. -- Currently the following escaped characters are--- supported: [" ' \ t n r \a b f v ]+-- supported: [" ' \ t n r a b f v ] esc :: TokenizeSpec esc = mempty { tsEsc = pure True } @@ -223,14 +240,14 @@ delims :: String -> TokenizeSpec delims s = mempty { tsDelims = Set.fromList s } --- | Strip spaces on left side of a token--- Does not affect string literals, i.e string are processed normally. Useful mostly during+-- | Strip spaces on left side of a token.+-- Does not affect string literals, i.e string are processed normally. Useful mostly for -- processing CSV-like formats, otherwise 'delims' may be used to skip unwanted spaces. sl :: TokenizeSpec sl = mempty { tsStripLeft = pure True } --- | Strip spaces on right side of a token--- Does not affect string literals, i.e string are processed normally. Useful mostly during+-- | Strip spaces on right side of a token.+-- Does not affect string literals, i.e string are processed normally. Useful mostly for -- processing CSV-like formats, otherwise 'delims' may be used to skip unwanted spaces. sr :: TokenizeSpec sr = mempty { tsStripRight = pure True }@@ -238,7 +255,7 @@ -- | Strips spaces on right and left sides and transforms multiple spaces into the one. -- Name origins from  unwords . words ----- Does not affect string literals, i.e string are processed normally. Useful mostly during+-- Does not affect string literals, i.e string are processed normally. Useful mostly for -- processing CSV-like formats, otherwise 'delims' may be used to skip unwanted spaces. uw :: TokenizeSpec uw = mempty { tsUW = pure True }@@ -279,6 +296,17 @@ keywords :: [Text] -> TokenizeSpec keywords s = mempty { tsKeywords = Set.fromList s } +-- | Enable identation support+indent :: TokenizeSpec+indent = mempty { tsIndent = Just True }++-- | Set tab expanding multiplier+-- i.e. each tab extends into n spaces before processing.+-- It also turns on the indentation. Only the tabs at the beginning of the string are expanded,+-- i.e. before the first non-space character appears.+itabstops :: Int -> TokenizeSpec+itabstops n = mempty { tsIndent = Just True, tsItabStops = pure n }+ newtype TokenizeM w a = TokenizeM (RWS TokenizeSpec w () a)                         deriving( Applicative                                 , Functor@@ -296,6 +324,8 @@            | TKeyword Text            | TEmpty            | TDelim+           | TIndent Int+           | TEol            deriving (Eq,Ord,Show)  -- | Typeclass for token values.@@ -323,6 +353,14 @@   mkDelim  :: a   mkDelim = mkEmpty +  -- | Creates an indent token+  mkIndent :: Int -> a+  mkIndent = const mkEmpty++  -- | Creates an EOL token+  mkEol :: a+  mkEol = mkEmpty+ instance IsToken (Maybe Text) where   mkChar = pure . Text.singleton   mkSChar = pure . Text.singleton@@ -354,6 +392,8 @@     tr TEmpty  = mkEmpty     tr (TPunct c) = mkPunct c     tr TDelim  = mkDelim+    tr (TIndent n) = mkIndent n+    tr TEol = mkEol  execTokenizeM :: TokenizeM [Token] a -> TokenizeSpec -> [Token] execTokenizeM (TokenizeM m) spec =@@ -363,15 +403,23 @@                | otherwise = normalize spec x  tokenize' :: TokenizeSpec -> Text -> [Token]-tokenize' spec txt = execTokenizeM (root txt) spec+tokenize' spec txt = execTokenizeM (root' txt) spec   where +    r = spec++    noIndent = not doIndent+    doIndent = justTrue (tsIndent r)+    eolOk = justTrue (tsEol r)++    root' x = scanIndent x >>= root+     root ts = do-      r <- ask        case Text.uncons ts of         Nothing           -> pure () +        Just ('\n', rest) | doIndent                  -> raiseEol >> root' rest         Just (c, rest)    | Set.member c (tsDelims r) -> tell [TDelim]  >> root rest         Just ('\'', rest) | justTrue (tsStringQ r)    -> scanQ '\'' rest         Just ('"', rest)  | justTrue (tsStringQQ r)   -> scanQ '"' rest@@ -383,16 +431,28 @@         Just (c, rest)    | otherwise                 -> tell [TChar c] >> root rest  +    raiseEol | eolOk = tell [TEol]+             | otherwise = pure ()++    expandSpace ' '  = 1+    expandSpace '\t' = (fromMaybe 8 (tsItabStops r))+    expandSpace _    = 0++    scanIndent x | noIndent = pure x+                 | otherwise = do+      let (ss,as) = Text.span (\c -> c == ' ' || c == '\t') x+      tell [ TIndent (sum (map expandSpace (Text.unpack ss))) ]+      pure as+     scanComment (c,rest) = do       suff <- Map.lookup c <$> asks tsLineComment       case suff of         Just t | Text.isPrefixOf t rest -> do-           root $ Text.drop 1 $ Text.dropWhile ('\n' /=) rest+           root $ Text.dropWhile ('\n' /=) rest          _  -> tell [TChar c] >> root rest      scanQ q ts = do-      r <- ask        case Text.uncons ts of         Nothing           -> root ts@@ -429,6 +489,11 @@      go [] = addEmptyField +    go s@(TIndent _ : _) = do+      let (iis, rest') = List.span isIndent s+      tell [TIndent (sum [k | TIndent k <- iis])]+      go rest'+     go (TChar c0 : cs) = do       let (n,ns) = List.span isTChar cs       succStat@@ -471,6 +536,9 @@      isTSChar (TSChar _) = True     isTSChar _          = False++    isIndent (TIndent _) = True+    isIndent _           = False      init = NormStats { nstatBeforeDelim = 0 } 

@@ -17,6 +17,7 @@           | TStrLit Text           | TKeyword Text           | TEmpty+          | TIndent Int           deriving(Eq,Ord,Show)  instance IsToken TTok where@@ -27,6 +28,7 @@   mkStrLit = TStrLit   mkKeyword = TKeyword   mkEmpty = TEmpty+  mkIndent n = TIndent n  spec :: Spec spec = do@@ -84,4 +86,52 @@                                   ,TPunct ')',TPunct ')']        toks `shouldBe` expected+++    describe "Checks indentation support" $ do++      let spec = delims " \n\t" <> comment ";"+                                <> punct "{}()[]<>"+                                <> sq <> sqq+                                <> uw+                                <> indent+                                <> itabstops 8+                                <> keywords ["define"]++++      it "parses some indented blocks" $ do++        let expected = [ TIndent 0, TKeyword "define", TText "a", TText "0"+                       , TIndent 2, TText "atom", TText "foo", TText "2"+                       , TIndent 2, TKeyword "define", TText "aq", TText "2"+                       , TIndent 4, TText "atom", TText "one", TText "4"+                       , TIndent 4, TText "atom", TText "two", TText "4"+                       , TIndent 0, TKeyword "define", TText "b", TText "0"+                       , TIndent 2, TText "atom", TText "baar", TText "2"+                       , TIndent 2, TText "atom", TText "quux", TText "2"+                       , TIndent 2, TKeyword "define", TText "new", TText "2"+                       , TIndent 6, TText "atom", TText "bar", TText "6"+                       , TIndent 4, TText "atom", TText "fuu", TText "4"+                       , TIndent 0+                       ]++        let pyLike = [q|+define a      0+  atom foo    2+  define aq   2+    atom one  4+    atom two  4++define  b       0+  atom baar     2+  atom quux     2+  define new    2+      atom bar  6+    atom fuu    4++|]+        let toks = tokenize spec pyLike :: [TTok]+        toks `shouldBe` expected+