diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/README.markdown b/README.markdown new file mode 100644 --- /dev/null +++ b/README.markdown @@ -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 + diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/fuzzy-parse.cabal b/fuzzy-parse.cabal --- a/fuzzy-parse.cabal +++ b/fuzzy-parse.cabal @@ -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 diff --git a/src/Data/Text/Fuzzy/Attoparsec/Month.hs b/src/Data/Text/Fuzzy/Attoparsec/Month.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Fuzzy/Attoparsec/Month.hs @@ -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) + ] diff --git a/src/Data/Text/Fuzzy/Section.hs b/src/Data/Text/Fuzzy/Section.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Fuzzy/Section.hs @@ -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 + diff --git a/src/Data/Text/Fuzzy/Tokenize.hs b/src/Data/Text/Fuzzy/Tokenize.hs --- a/src/Data/Text/Fuzzy/Tokenize.hs +++ b/src/Data/Text/Fuzzy/Tokenize.hs @@ -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 } diff --git a/test/FuzzyParseSpec.hs b/test/FuzzyParseSpec.hs --- a/test/FuzzyParseSpec.hs +++ b/test/FuzzyParseSpec.hs @@ -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 +