regex-applicative-text-0.1.0.1/src/0000755000000000000000000000000012562313054015220 5ustar0000000000000000regex-applicative-text-0.1.0.1/src/Text/0000755000000000000000000000000012562313054016144 5ustar0000000000000000regex-applicative-text-0.1.0.1/src/Text/Regex/0000755000000000000000000000000012562313054017216 5ustar0000000000000000regex-applicative-text-0.1.0.1/src/Text/Regex/Applicative/0000755000000000000000000000000012656172131021462 5ustar0000000000000000regex-applicative-text-0.1.0.1/src/Text/Regex/Applicative/Text.hs0000644000000000000000000001475712656172131022760 0ustar0000000000000000-------------------------------------------------------------------- -- | -- Module : Text.Regex.Applicative.Text -- Copyright : (c) 2015 Oleg Grenrus -- License : BSD3 -- -- Maintainer: Oleg Grenrus -- Stability : experimental -- -- @Text.Regex.Applicative@ API specialised to 'Char' and 'Text'. -------------------------------------------------------------------- {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >=704 {-# LANGUAGE Safe #-} #endif module Text.Regex.Applicative.Text ( -- * Types RE' , R.RE -- * Smart constructors , sym , psym , msym , anySym , string , reFoldl , R.Greediness(..) , few , withMatched -- * Basic matchers , match , (=~) , replace -- * Advanced matchers , findFirstPrefix , findLongestPrefix , findShortestPrefix , findFirstInfix , findLongestInfix , findShortestInfix -- * Module re-exports , module Control.Applicative ) where import Control.Applicative import Control.Arrow import Data.Monoid (mappend) import Data.Text (Text) import qualified Data.Text as T import qualified Text.Regex.Applicative as R -- | Convenience alias for 'RE' working (also) on 'Text'. type RE' a = R.RE Char a -- | Match and return a single 'Char' which satisfies the predicate psym :: (Char -> Bool) -> RE' Char psym = R.psym -- | Like 'psym', but allows to return a computed value instead of the -- original symbol msym :: (Char -> Maybe a) -> RE' a msym = R.msym -- | Match and return the given symbol sym :: Char -> RE' Char sym = R.sym -- | Match and return any single symbol anySym :: RE' Char anySym = R.anySym -- | Match and return the given 'Text'. -- -- -- > import Text.Regex.Applicative -- > -- > number = string "one" *> pure 1 <|> string "two" *> pure 2 -- > -- > main = print $ "two" =~ number string :: Text -> RE' Text string = fmap T.pack . R.string . T.unpack -- | Match zero or more instances of the given expression, which are combined using -- the given folding function. -- -- 'Greediness' argument controls whether this regular expression should match -- as many as possible ('Greedy') or as few as possible ('NonGreedy') instances -- of the underlying expression. reFoldl :: R.Greediness -> (b -> a -> b) -> b -> RE' a -> RE' b reFoldl = R.reFoldl -- | Match zero or more instances of the given expression, but as -- few of them as possible (i.e. /non-greedily/). A greedy equivalent of 'few' -- is 'many'.x -- -- > >>> findFirstPrefix (few anySym <* "b") "ababab" -- > Just ("a","abab") -- > >>> findFirstPrefix (many anySym <* "b") "ababab" -- > Just ("ababa","") few :: RE' a -> RE' [a] few = R.few -- | Return matched symbols as part of the return value withMatched :: RE' a -> RE' (a, Text) withMatched = fmap (second T.pack) . R.withMatched -- | @s =~ a = match a s@ (=~) :: Text -> RE' a -> Maybe a (=~) = flip match infix 2 =~ -- | Attempt to match a 'Text' against the regular expression. -- Note that the whole string (not just some part of it) should be matched. -- -- > >>> match (sym 'a' <|> sym 'b') "a" -- > Just 'a' -- > >>> match (sym 'a' <|> sym 'b') "ab" -- > Nothing -- match :: RE' a -> Text -> Maybe a match = reTextF R.match -- | Find a string prefix which is matched by the regular expression. -- -- Of all matching prefixes, pick one using left bias (prefer the left part of -- '<|>' to the right part) and greediness. -- -- This is the match which a backtracking engine (such as Perl's one) would find -- first. -- -- If match is found, the rest of the input is also returned. -- -- > >>> findFirstPrefix ("a" <|> "ab") "abc" -- > Just ("a","bc") -- > >>> findFirstPrefix ("ab" <|> "a") "abc" -- > Just ("ab","c") -- > >>> findFirstPrefix "bc" "abc" -- > Nothing findFirstPrefix :: RE' a -> Text -> Maybe (a, Text) findFirstPrefix = fmap pairF .: reTextF R.findFirstPrefix -- | Find the longest string prefix which is matched by the regular expression. -- -- Submatches are still determined using left bias and greediness, so this is -- different from POSIX semantics. -- -- If match is found, the rest of the input is also returned. -- -- -- > >>> let keyword = "if" -- > >>> let identifier = many $ psym isAlpha -- > >>> let lexeme = (Left <$> keyword) <|> (Right <$> identifier) -- > >>> findLongestPrefix lexeme "if foo" -- > Just (Left "if"," foo") -- > >>> findLongestPrefix lexeme "iffoo" -- > Just (Right "iffoo","") findLongestPrefix :: RE' a -> Text -> Maybe (a, Text) findLongestPrefix = fmap pairF .: reTextF R.findLongestPrefix -- | Find the shortest prefix (analogous to 'findLongestPrefix') findShortestPrefix :: RE' a -> Text -> Maybe (a, Text) findShortestPrefix = fmap pairF .: reTextF R.findShortestPrefix -- | Find the leftmost substring that is matched by the regular expression. -- Otherwise behaves like 'findFirstPrefix'. Returns the result together with -- the prefix and suffix of the string surrounding the match. findFirstInfix :: RE' a -> Text -> Maybe (Text, a, Text) findFirstInfix = fmap tripleF .: reTextF R.findFirstInfix -- | Find the leftmost substring that is matched by the regular expression. -- Otherwise behaves like 'findLongestPrefix'. Returns the result together with -- the prefix and suffix of the string surrounding the match. findLongestInfix :: RE' a -> Text -> Maybe (Text, a, Text) findLongestInfix = fmap tripleF .: reTextF R.findLongestInfix -- | Find the leftmost substring that is matched by the regular expression. -- Otherwise behaves like 'findShortestPrefix'. Returns the result together with -- the prefix and suffix of the string surrounding the match. findShortestInfix :: RE' a -> Text -> Maybe (Text, a, Text) findShortestInfix = fmap tripleF .: reTextF R.findShortestInfix -- | Replace matches of regular expression with it's value. -- -- > >>> replace ("!" <$ sym 'f' <* some (sym 'o')) "quuxfoofooooofoobarfobar" -- > "quux!!!bar!bar" replace :: RE' Text -> Text -> Text replace r = go . T.unpack where go :: String -> Text go [] = T.empty go ys@(x:xs) = case R.findLongestPrefix r ys of Nothing -> T.cons x (go xs) Just (prefix, rest) -> prefix `mappend` go rest -- Helpers reTextF :: (a -> String -> b) -> (a -> Text -> b) reTextF f a s = f a (T.unpack s) {- INLINE reTextF -} pairF :: (a, String) -> (a, Text) pairF (x, y) = (x, T.pack y) {-# INLINE pairF #-} tripleF :: (String, a, String) -> (Text, a, Text) tripleF (x, y, z) = (T.pack x, y, T.pack z) {-# INLINE tripleF #-} (.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d) f .: g = \a b -> f (g a b) {-# INLINE (.:) #-} regex-applicative-text-0.1.0.1/LICENSE0000644000000000000000000000276212562324620015446 0ustar0000000000000000Copyright (c) 2015, Oleg Grenrus 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. * Neither the name of Oleg Grenrus nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. 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. regex-applicative-text-0.1.0.1/Setup.hs0000644000000000000000000000005612551474314016073 0ustar0000000000000000import Distribution.Simple main = defaultMain regex-applicative-text-0.1.0.1/regex-applicative-text.cabal0000644000000000000000000000213612656172131022015 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.8.0. -- -- see: https://github.com/sol/hpack name: regex-applicative-text version: 0.1.0.1 synopsis: regex-applicative on text description: Wrapped regex-applicative primitives to work with Text category: Text homepage: https://github.com/phadej/regex-applicative-text#readme bug-reports: https://github.com/phadej/regex-applicative-text/issues author: Oleg Grenrus maintainer: Oleg Grenrus license: BSD3 license-file: LICENSE tested-with: GHC==7.0.4, GHC==7.2.2, GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.1 build-type: Simple cabal-version: >= 1.10 extra-source-files: README.md source-repository head type: git location: https://github.com/phadej/regex-applicative-text library hs-source-dirs: src ghc-options: -Wall build-depends: base >= 4.3 && <4.10 , regex-applicative >=0.3 && <0.4 , text exposed-modules: Text.Regex.Applicative.Text default-language: Haskell2010 regex-applicative-text-0.1.0.1/README.md0000644000000000000000000000105212562323671015714 0ustar0000000000000000# regex-applicative-text [![Build Status](https://travis-ci.org/phadej/regex-applicative-text.svg?branch=master)](https://travis-ci.org/phadej/regex-applicative-text) [![Hackage](https://img.shields.io/hackage/v/regex-applicative-text.svg)](http://hackage.haskell.org/package/regex-applicative-text) `Text` wrappers for [regex-applicative](https://github.com/feuerbach/regex-applicative) [hackage](https://hackage.haskell.org/package/regex-applicative). [Check documention is on the Hackage](http://hackage.haskell.org/package/regex-applicative-text)