diff --git a/.gitignore b/.gitignore new file mode 100644 --- /dev/null +++ b/.gitignore @@ -0,0 +1,26 @@ +# General +\#*# +.*~ +*~ +.#* +*.swp +.DS_Store +.gdb_history +TAGS +# Object files +*.a +*.o +*.so +*.hi +*.p_hi +a.out +# autotool +autom4te.cache +stamp-h1 +# misc +*.sqlite +Main +dist/ +cabal-dev/ +cabal.sandbox.config +.cabal-sandbox diff --git a/.travis.yml b/.travis.yml new file mode 100644 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,55 @@ +language: haskell + +env: + matrix: + - GHCVER=7.4.2 + - GHCVER=7.6.3 + - GHCVER=7.8.4 + - GHCVER=7.10.1 + - GHCVER=head + +matrix: + allow_failures: + - env: GHCVER=head + +before_install: + - | + if [ $GHCVER = `ghc --numeric-version` ]; then + echo "use system ghc: `which ghc` `ghc --numeric-version`" + else + travis_retry sudo add-apt-repository -y ppa:hvr/ghc + travis_retry sudo apt-get update + travis_retry sudo apt-get install -y --force-yes cabal-install-1.22 ghc-$GHCVER + export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/1.22/bin:$PATH + echo "use ppa:hvr/ghc: `which ghc` `ghc --numeric-version`" + fi + +install: + - export PATH=$HOME/.cabal/bin:$PATH + - which cabal + - travis_retry cabal update + - cabal install --only-dependencies --enable-tests + - ghc-pkg list + +script: + - which cabal + - cabal configure --enable-tests -fbuild-samples + - cabal build + - cabal test --show-details=always + + # tests source distribution package + - cabal sdist + - | + PKGNAME="$(cabal info . | awk '/^\*/{print $2}')" + SRCTGZ="${PKGNAME}.tar.gz" + cd dist/ + if [ -f "$SRCTGZ" ]; then + tar xvzf "$SRCTGZ" + cd "$PKGNAME" + NG=$(git ls-tree HEAD --full-tree -r | while read perm blob hash name; do [ -e "$name" ] || echo NG "$name"; done) + if [ -n "$NG" ]; then + echo "Missing files:" + echo $NG + exit 1 + fi + fi diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +## 0.1.0 + +* Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (C) 2015, Takahiro Himura + +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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +# lens-regex: Lens powered regular expression # + +[![Build Status](https://travis-ci.org/himura/lens-regex.svg?branch=master)](https://travis-ci.org/himura/lens-regex) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/lens-regex.cabal b/lens-regex.cabal new file mode 100644 --- /dev/null +++ b/lens-regex.cabal @@ -0,0 +1,66 @@ +name: lens-regex +version: 0.1.0 +synopsis: Lens powered regular expression +description: Lens powered regular expression +homepage: https://github.com/himura/lens-regex +license: BSD3 +license-file: LICENSE +author: Takahiro HIMURA +maintainer: Takahiro HIMURA +copyright: Copyright (C) 2015 Takahiro HIMURA +category: Text +build-type: Simple +cabal-version: >=1.10 + +extra-source-files: + .gitignore + .travis.yml + README.md + CHANGELOG.md + sample/*.hs + +source-repository head + type: git + location: https://github.com/himura/lens-regex.git + +flag build-samples + description: build samples + default: False + +library + exposed-modules: Text.Regex.Lens + Text.Regex.Quote + build-depends: base >= 4.5 && < 5 + , array + , lens >= 4 && < 5 + , regex-base + , template-haskell + hs-source-dirs: src + ghc-options: -Wall + default-language: Haskell2010 + +executable sample + main-is: sample.hs + hs-source-dirs: sample + + if !flag(build-samples) + buildable: False + else + build-depends: base >= 4.5 && < 5 + , lens + , lens-regex + , regex-posix + ghc-options: -Wall + default-language: Haskell2010 + +test-suite doctests + type: exitcode-stdio-1.0 + main-is: doctests.hs + hs-source-dirs: tests + + build-depends: base + , directory + , doctest + , filepath + , regex-posix + default-language: Haskell2010 diff --git a/sample/sample.hs b/sample/sample.hs new file mode 100644 --- /dev/null +++ b/sample/sample.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE QuasiQuotes #-} + +{- + +OUTPUT: + +################## +## Target String: +target1 = "hoge00 fuga hoge01 neko hoge02" + +## Example: target1 ^.. regex [r|hoge[0-9]+|] +[MatchPart {_matchedString = "hoge00", _captures = []},MatchPart {_matchedString = "hoge01", _captures = []},MatchPart {_matchedString = "hoge02", _captures = []}] + +## Example: target1 ^.. regex [r|hoge[0-9]+|] . matchedString +["hoge00","hoge01","hoge02"] + +## Example: target1 ^? regex [r|hoge[0-9]+|] . index 1 . matchedString +Just "hoge01" + +## Example: target1 ^? regex [r|hoge[0-9]+|] . index 3 . matchedString +Nothing + +## Example: target1 & regex [r|hoge[0-9]+|] . matchedString .~ "HOGE" +"HOGE fuga HOGE neko HOGE" + +## Example: target1 & regex [r|hoge[0-9]+|] .index 1 . matchedString .~ "HOGE" +"hoge00 fuga HOGE neko hoge02" + +## Example: target1 & regex [r|hoge[0-9]+|] .index 1 . matchedString %~ (\s -> "<<" ++ s ++ ">>") +"hoge00 fuga <> neko hoge02" +################## +## Target String: +target2 = "\"shinku" + +## Example: target2 ^.. regex [r|]*>|] . captures . traversed . index 0 +["/image/shinku0721.jpg","/image/shinku141.jpg"] + +-} + +module Main where + +import Control.Lens +import Text.Regex.Lens +import Text.Regex.Posix +import Text.Regex.Quote + +main :: IO () +main = do + let target1 = "hoge00 fuga hoge01 neko hoge02" + putStrLn "##################" + putStrLn "## Target String:" + putStrLn $ "target1 = " ++ show target1 + + putStrLn "\n## Example: target1 ^.. regex [r|hoge[0-9]+|]" + print $ target1 ^.. regex [r|hoge[0-9]+|] + + putStrLn "\n## Example: target1 ^.. regex [r|hoge[0-9]+|] . matchedString" + print $ target1 ^.. regex [r|hoge[0-9]+|] . matchedString + + putStrLn "\n## Example: target1 ^? regex [r|hoge[0-9]+|] . index 1 . matchedString" + print $ target1 ^? regex [r|hoge[0-9]+|] . index 1 . matchedString + + putStrLn "\n## Example: target1 ^? regex [r|hoge[0-9]+|] . index 3 . matchedString" + print $ target1 ^? regex [r|hoge[0-9]+|] . index 3 . matchedString + + putStrLn "\n## Example: target1 & regex [r|hoge[0-9]+|] . matchedString .~ \"HOGE\"" + print $ target1 & regex [r|hoge[0-9]+|] . matchedString .~ "HOGE" + + putStrLn "\n## Example: target1 & regex [r|hoge[0-9]+|] .index 1 . matchedString .~ \"HOGE\"" + print $ target1 & regex [r|hoge[0-9]+|] . index 1 . matchedString .~ "HOGE" + + putStrLn "\n## Example: target1 & regex [r|hoge[0-9]+|] .index 1 . matchedString %~ (\\s -> \"<<\" ++ s ++ \">>\")" + print $ target1 & regex [r|hoge[0-9]+|] . index 1 . matchedString %~ (\s -> "<<" ++ s ++ ">>") + + let target2 = "\"shinku" + putStrLn "##################" + putStrLn "## Target String:" + putStrLn $ "target2 = " ++ show target2 + + putStrLn "\n## Example: target2 ^.. regex [r|]*>|] . captures . traversed . index 0" + print $ target2 ^.. regex [r|]*>|] . captures . traversed . index 0 diff --git a/src/Text/Regex/Lens.hs b/src/Text/Regex/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Text/Regex/Lens.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell #-} + +module Text.Regex.Lens + ( MatchPart(..) + , matchedString + , captures + + , regex + , regex' + , matched + , matched' + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +import Data.Monoid +#endif + +import Control.Lens +import qualified Data.Array as A +import Text.Regex.Base + +-- $setup +-- >>> import Text.Regex.Quote +-- >>> import Text.Regex.Posix +-- >>> :set -XQuasiQuotes + +type RegexResult text = [RegexPartialResult text] +type RegexPartialResult text = Either text (MatchPart text) + +data MatchPart text = MatchPart + { _matchedString :: text + , _captures :: [text] + } deriving Show +makeLensesFor [("_matchedString", "matchedString")] ''MatchPart +makeLensesWith (lensRulesFor [("_captures", "captures")] & generateUpdateableOptics .~ False) ''MatchPart + +-- | An indexed Traversal for matched part with regexp. +-- +-- >>> "foo bar baz" ^? regex [r|b.*r|] +-- Just (MatchPart {_matchedString = "bar", _captures = []}) +-- +-- >>> "foo bar baz" ^? regex [r|hoge|] +-- Nothing +-- +-- You can access to the matched string by using `matchedString`: +-- +-- >>> "foo bar baz" ^? regex [r|b.*r|] . matchedString +-- Just "bar" +-- +-- Multiple result: +-- +-- >>> "foo bar baz" ^.. regex [r|b[^ ]+|] . matchedString +-- ["bar","baz"] +-- +-- Replace: +-- +-- >>> "foo bar baz" & regex [r|b[^ ]+|] . matchedString .~ "nya" +-- "foo nya nya" +-- +-- Indexing: +-- +-- >>> "foo bar baz" ^.. regex [r|b[^ ]+|] . index 1 . matchedString +-- ["baz"] +-- +-- >>> "foo bar baz" & regex [r|b[^ ]+|] . index 1 . matchedString .~ "nya" +-- "foo bar nya" +-- +-- Captures: +-- +-- >>> "foo00 bar01 baz02" ^.. regex [r|([a-z]+)([0-9]+)|] . captures +-- [["foo","00"],["bar","01"],["baz","02"]] +-- +-- >>> "foo00 bar01 baz02" ^.. regex [r|([a-z]+)([0-9]+)|] . captures . traversed . index 1 +-- ["00","01","02"] +-- +-- /Note/: This is /not/ a legal Traversal, unless you are very careful not to invalidate the predicate on the target. +-- For example, if you replace the matched part with a string which is not match with the regex, the second 'Traversal' law is violated. +-- +-- @ +-- let l = regex [r|t.*t|] . matchedString +-- 'Control.Lens.Setter.over' l (++ "peta") '.' 'Control.Lens.Setter.over' l (++ "nya") '/=' 'Control.Lens.Setter.over' l ((++ "peta") . (++ "nya")) +-- 'Control.Lens.Setter.over' l (++ "put") '.' 'Control.Lens.Setter.over' l (++ "hot") '==' 'Control.Lens.Setter.over' l ((++ "put") . (++ "hot")) +-- @ +regex :: (RegexLike regex text, Monoid text) + => regex -- ^ compiled regular expression + -> IndexedTraversal' Int text (MatchPart text) +regex pat = regex' pat . matched + +regex' :: (RegexLike regex text, Monoid text) => regex -> Lens' text (RegexResult text) +regex' pat f target = fromRegexResult <$> f (toRegexResult pat target) + +matched :: (Indexable Int p, Applicative f) + => p (MatchPart text) (f (MatchPart text)) -> RegexResult text -> f (RegexResult text) +matched = conjoined matched' (indexing matched') + +matched' :: Traversal' (RegexResult text) (MatchPart text) +matched' f target = go target + where + go [] = pure [] + go ((Left x):xs) = ((Left x):) <$> go xs + go ((Right x):xs) = (:) <$> (Right <$> f x) <*> go xs + +toRegexResult :: RegexLike regex text => regex -> text -> (RegexResult text) +toRegexResult pat target = go 0 $ matchAll pat target + where + go pos [] = [Left (after pos target)] + go pos (m:ms) = + if posDiff > 0 + then Left (extract (pos, posDiff) target) : cont + else cont + where + (pos', len) = m A.! 0 + posDiff = pos' - pos + (ms0:mss) = map (flip extract target) $ A.elems m + cont = Right (MatchPart ms0 mss) : go (pos' + len) ms + +fromRegexResult :: Monoid text => (RegexResult text) -> text +fromRegexResult = mconcat . map toStr + where + toStr (Right (MatchPart s _)) = s + toStr (Left s) = s diff --git a/src/Text/Regex/Quote.hs b/src/Text/Regex/Quote.hs new file mode 100644 --- /dev/null +++ b/src/Text/Regex/Quote.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Text.Regex.Quote + ( r + ) + where + +import Language.Haskell.TH +import Language.Haskell.TH.Quote +import Text.Regex.Base + +-- | Generate compiled regular expression. +-- +-- This QuasiQuote is shorthand of /makeRegex with type annotations/: +-- +-- @ +-- [r|hogehoge|] == (makeRegex ("hogehoge" :: String) :: Regex) +-- @ +-- +-- The /Regex/ type signature in the above example, is the type +-- which is named as /Regex/ in this translation unit. +-- Therefore, you can choose Regex type by changing imports. +-- +-- For example, the /exp/ variable in the below example has the type of Text.Regex.Posix.Regex: +-- +-- @ +-- import Text.Regex.Posix (Regex) +-- exp = [r|hoge|] +-- @ +-- +-- and, the /exp/ variable in below example has the type of Text.Regex.PCRE.Regex: +-- +-- @ +-- import Text.Regex.PCRE (Regex) +-- exp = [r|hoge|] +-- @ +r :: QuasiQuoter +r = QuasiQuoter + { quoteExp = \str -> do + mk <- [|makeRegex|] + return $ mk `AppE` (LitE (StringL str) `SigE` ConT ''String) `SigE` ConT (mkName "Regex") + , quotePat = error "quotePat is not defined" + , quoteType = error "quoteType is not defined" + , quoteDec = error "quoteDec is not defined" + } diff --git a/tests/doctests.hs b/tests/doctests.hs new file mode 100644 --- /dev/null +++ b/tests/doctests.hs @@ -0,0 +1,29 @@ +module Main where + +import Test.DocTest +import System.Directory +import System.FilePath +import Data.List +import Control.Monad +import Control.Applicative + +main :: IO () +main = do + sources <- findSources + doctest $ + [ "-isrc" + , "-idist/build/autogen" + , "-optP-include" + , "-optPdist/build/autogen/cabal_macros.h" + ] + ++ sources + +findSources :: IO [FilePath] +findSources = filter (isSuffixOf ".hs") <$> go "src" + where + go dir = do + (dirs, files) <- listFiles dir + (files ++) . concat <$> mapM go dirs + listFiles dir = do + entries <- map (dir ) . filter (`notElem` [".", ".."]) <$> getDirectoryContents dir + (,) <$> filterM doesDirectoryExist entries <*> filterM doesFileExist entries