regex-rure (empty) → 0.1.0.0
raw patch · 6 files changed
+577/−0 lines, 6 filesdep +basedep +bytestringdep +regex-rure
Dependencies added: base, bytestring, regex-rure, tasty, tasty-hunit
Files
- CHANGELOG.md +3/−0
- LICENSE +14/−0
- regex-rure.cabal +74/−0
- src/Regex/Rure.chs +206/−0
- src/Regex/Rure/FFI.chs +213/−0
- test/Spec.hs +67/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# 0.1.0.0++ * Initial release
+ LICENSE view
@@ -0,0 +1,14 @@+Copyright (C) 2021 Vanessa McHale++This program is free software: you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation, either version 3 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program. If not, see <http://www.gnu.org/licenses/>.
+ regex-rure.cabal view
@@ -0,0 +1,74 @@+cabal-version: 1.18+name: regex-rure+version: 0.1.0.0+license: GPL-3+license-file: LICENSE+maintainer: vamchale@gmail.com+author: Vanessa McHale+synopsis: Bindings to Rust's regex library+description:+ Bindings to Rust's regex library, including a higher-level API.++category: Text, Regex+build-type: Simple+extra-source-files: CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/vmchale/rure++library+ exposed-modules:+ Regex.Rure+ Regex.Rure.FFI++ build-tool-depends: c2hs:c2hs >=0.26.1+ hs-source-dirs: src+ default-language: Haskell2010+ extra-libraries: rure+ ghc-options: -Wall+ build-depends:+ base >=4.10.0.0 && <5,+ bytestring >=0.11.0.0++ if impl(ghc >=8.0)+ ghc-options:+ -Wincomplete-uni-patterns -Wincomplete-record-updates+ -Wredundant-constraints -Widentities++ if impl(ghc >=8.4)+ ghc-options: -Wmissing-export-lists++ if impl(ghc >=8.2)+ ghc-options: -Wcpp-undef++ if impl(ghc >=8.10)+ ghc-options: -Wunused-packages++test-suite regex-rure-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test+ default-language: Haskell2010+ other-extensions: OverloadedStrings+ ghc-options: -Wall+ build-depends:+ base,+ tasty,+ tasty-hunit,+ regex-rure,+ bytestring++ if impl(ghc >=8.0)+ ghc-options:+ -Wincomplete-uni-patterns -Wincomplete-record-updates+ -Wredundant-constraints -Widentities++ if impl(ghc >=8.4)+ ghc-options: -Wmissing-export-lists++ if impl(ghc >=8.2)+ ghc-options: -Wcpp-undef++ if impl(ghc >=8.10)+ ghc-options: -Wunused-packages
+ src/Regex/Rure.chs view
@@ -0,0 +1,206 @@+module Regex.Rure ( -- * Higher-level functions+ hsMatches+ , hsIsMatch+ , hsSetIsMatch+ , hsFind+ , hsSetMatches+ -- * Stateful, functions in 'IO'+ , compile+ , compileSet+ , isMatch+ , setIsMatch+ , setMatches+ , find+ , matches+ , mkIter+ -- * Types+ , RureMatch (..)+ -- ** Pointer types (stateful, 'IO'-based API)+ , RurePtr+ , RureIterPtr+ , RureSetPtr+ -- * Options/flags+ , RureFlags+ , rureFlagCaseI+ , rureFlagMulti+ , rureFlagDotNL+ , rureFlagSwapGreed+ , rureFlagSpace+ , rureFlagUnicode+ , rureDefaultFlags+ ) where++import Data.Coerce (coerce)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Unsafe as BS+import Data.Foldable (traverse_)+import Foreign.C.Types (CSize)+import Foreign.ForeignPtr (castForeignPtr, newForeignPtr, touchForeignPtr)+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+import Foreign.Ptr (castPtr, nullPtr, Ptr)+import Foreign.Storable (sizeOf)+import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.Marshal.Array (peekArray, pokeArray)+import Regex.Rure.FFI+import System.IO.Unsafe (unsafePerformIO)++#include <rure.h>++mkIter :: RurePtr -> IO RureIterPtr+mkIter rePtr =+ castForeignPtr <$> (newForeignPtr rureIterFree . castPtr =<< rureIterNew rePtr)++compileSet :: RureFlags -> [BS.ByteString] -> IO (Either String RureSetPtr)+compileSet flags bss = do+ preErr <- rureErrorNew+ err <- castForeignPtr <$> newForeignPtr rureErrorFree (castPtr preErr)+ preOpt <- rureOptionsNew+ opt <- castForeignPtr <$> newForeignPtr rureOptionsFree (castPtr preOpt)+ allocaBytes lBytes $ \bPtrs ->+ allocaBytes lBytes $ \szs -> do+ pokeArray bPtrs (fmap unsafeForeignPtrToPtr ps)+ pokeArray szs (fromIntegral <$> ss)+ res <- rureCompileSet (castPtr bPtrs) szs (fromIntegral l) flags opt err+ traverse_ touchForeignPtr ps+ if res == nullPtr+ then Left <$> rureErrorMessage err+ else Right . castForeignPtr <$> newForeignPtr rureSetFree (castPtr res)+ where l = length bss+ lBytes = l * sizeOf (undefined :: Ptr a)+ rip (BS.BS psϵ lϵ) = (psϵ, lϵ)+ (ps, ss) = unzip (fmap rip bss)++compile :: RureFlags -> BS.ByteString -> IO (Either String RurePtr)+compile flags re = do+ preErr <- rureErrorNew+ err <- castForeignPtr <$> newForeignPtr rureErrorFree (castPtr preErr)+ preOpt <- rureOptionsNew+ opt <- castForeignPtr <$> newForeignPtr rureOptionsFree (castPtr preOpt)+ BS.unsafeUseAsCStringLen re $ \(p, sz) -> do+ res <- rureCompile (castPtr p) (fromIntegral sz) flags opt err+ if res == nullPtr+ then Left <$> rureErrorMessage err+ else Right . castForeignPtr <$> newForeignPtr rureFree (castPtr res)++{-# NOINLINE hsMatches #-}+hsMatches :: RureFlags+ -> BS.ByteString -- ^ Regex+ -> BS.ByteString -- ^ Haystack (unicode)+ -> Either String [RureMatch]+hsMatches flags re haystack = unsafePerformIO $ do+ rePtr <- compile flags re+ case rePtr of+ Left err -> pure (Left err)+ Right rp -> Right <$> ((\riPtr -> matches riPtr haystack) =<< mkIter rp)++matches :: RureIterPtr+ -> BS.ByteString+ -> IO [RureMatch]+matches reIPtr haystack = do+ res <- iterNext reIPtr haystack+ case res of+ Nothing -> pure []+ Just m -> (m :) <$> matches reIPtr haystack++iterNext :: RureIterPtr+ -> BS.ByteString+ -> IO (Maybe RureMatch)+iterNext reIPtr haystack =+ allocaBytes {# sizeof rure_match #} $ \matchPtr -> do+ res <- BS.unsafeUseAsCStringLen haystack $ \(p, sz) ->+ rureIterNext reIPtr (castPtr p) (fromIntegral sz) matchPtr+ if res+ then Just <$> rureMatchFromPtr matchPtr+ else pure Nothing++rureMatchFromPtr :: Ptr RureMatch -> IO RureMatch+rureMatchFromPtr matchPtr =+ RureMatch+ <$> fmap coerce ({# get rure_match->start #} matchPtr)+ <*> fmap coerce ({# get rure_match->end #} matchPtr)++{-# NOINLINE hsFind #-}+hsFind :: RureFlags+ -> BS.ByteString -- ^ Regex+ -> BS.ByteString -- ^ Haystack+ -> Either String (Maybe (RureMatch))+hsFind flags re haystack = unsafePerformIO $ do+ rePtr <- compile flags re+ case rePtr of+ Left err -> pure (Left err)+ Right rp -> Right <$> find rp haystack 0++find :: RurePtr+ -> BS.ByteString -- ^ Unicode+ -> CSize -- ^ Start+ -> IO (Maybe RureMatch)+find rePtr haystack start' =+ allocaBytes {# sizeof rure_match #} $ \matchPtr -> do+ res <- BS.unsafeUseAsCStringLen haystack $ \(p, sz) ->+ rureFind rePtr (castPtr p) (fromIntegral sz) start' matchPtr+ if res+ then Just <$> rureMatchFromPtr matchPtr+ else pure Nothing++{-# NOINLINE hsSetMatches #-}+hsSetMatches :: RureFlags+ -> [BS.ByteString]+ -> BS.ByteString+ -> Either String [Bool]+hsSetMatches flags res haystack = unsafePerformIO $ do+ resPtr <- compileSet flags res+ case resPtr of+ Left err -> pure (Left err)+ Right rsp -> Right <$> setMatches rsp haystack 0++{-# NOINLINE hsSetIsMatch #-}+hsSetIsMatch :: RureFlags+ -> [BS.ByteString] -- ^ Needles (regex)+ -> BS.ByteString -- ^ Haystack+ -> Either String Bool+hsSetIsMatch flags res haystack = unsafePerformIO $ do+ resPtr <- compileSet flags res+ case resPtr of+ Left err -> pure (Left err)+ Right rsp -> Right <$> setIsMatch rsp haystack 0++{-# NOINLINE hsIsMatch #-}+hsIsMatch :: RureFlags+ -> BS.ByteString -- ^ Regex+ -> BS.ByteString -- ^ Haystack (unicode)+ -> Either String Bool+hsIsMatch flags re haystack = unsafePerformIO $ do+ rePtr <- compile flags re+ case rePtr of+ Left err -> pure (Left err)+ Right rp -> Right <$> isMatch rp haystack 0++setIsMatch :: RureSetPtr+ -> BS.ByteString -- ^ Unicode+ -> CSize -- ^ Start+ -> IO Bool+setIsMatch rsPtr haystack startϵ =+ BS.unsafeUseAsCStringLen haystack $ \(p, sz) ->+ rureSetIsMatch rsPtr (castPtr p) (fromIntegral sz) startϵ++setMatches :: RureSetPtr+ -> BS.ByteString+ -> CSize+ -> IO [Bool]+setMatches rsPtr haystack startϵ =+ BS.unsafeUseAsCStringLen haystack $ \(p, sz) -> do+ l <- fromIntegral <$> rureSetLen rsPtr+ allocaBytes l $ \boolPtr -> do+ rureSetMatches rsPtr (castPtr p) (fromIntegral sz) startϵ boolPtr+ fmap cBoolToBool <$> peekArray l boolPtr+ where cBoolToBool 0 = False+ cBoolToBool _ = True++isMatch :: RurePtr+ -> BS.ByteString -- ^ Unicode+ -> CSize -- ^ Start+ -> IO Bool+isMatch rePtr haystack start' =+ BS.unsafeUseAsCStringLen haystack $ \(p, sz) ->+ rureIsMatch rePtr (castPtr p) (fromIntegral sz) start'
+ src/Regex/Rure/FFI.chs view
@@ -0,0 +1,213 @@+-- | See @rure.h@ for documentation + how to use.+module Regex.Rure.FFI ( -- * Types+ -- ** Abstract types+ Rure+ , RureOptions+ , RureError+ , RureCaptures+ , RureSet+ , RureIter+ -- ** Integer types+ , UInt8+ , UInt32+ -- ** Types+ , RureMatch (..)+ , RureFlags+ -- ** Pointer types (c2hs)+ , RurePtr+ , RureErrorPtr+ , RureOptionsPtr+ , RureIterPtr+ , RureCapturesPtr+ , RureSetPtr+ -- * Functions+ -- ** Allocation+ , rureOptionsNew+ , rureOptionsFree+ , rureErrorNew+ , rureErrorFree+ , rureIterNew+ , rureFree+ , rureIterFree+ , rureCapturesNew+ , rureCapturesFree+ , rureSetFree+ -- ** Options+ , rureOptionsSizeLimit+ , rureOptionsDfaSizeLimit+ , rureErrorMessage+ -- ** Compilation+ , rureCompile+ , rureCompileMust+ , rureCompileSet+ -- ** Matching+ , rureIsMatch+ , rureFind+ , rureIterNext+ , rureIterNextCaptures+ , rureCapturesAt+ , rureCapturesLen+ , rureFindCaptures+ , rureShortestMatch+ , rureCaptureNameIndex+ , rureSetIsMatch+ , rureSetMatches+ , rureSetLen+ -- ** Flags+ , rureFlagCaseI+ , rureFlagMulti+ , rureFlagDotNL+ , rureFlagSwapGreed+ , rureFlagSpace+ , rureFlagUnicode+ , rureDefaultFlags+ -- ** String utilities+ , rureEscapeMust+ , rureCstringFree+ ) where++import Data.Bits (Bits, (.|.), shift)+import Data.Coerce (coerce)+import Data.Int (Int32)+import Data.Semigroup (Semigroup (..))+import Foreign.C.String (CString)+import Foreign.C.Types (CBool, CSize)+import Foreign.Ptr (Ptr, castPtr)++#include <rure.h>++type UInt8 = {# type uint8_t #}+{#typedef uint8_t UInt8#}+{#default in `Ptr UInt8' [uint8_t *] id#} -- TODO: bytestring?++type UInt32 = {# type uint32_t #}++newtype RureFlags = RureFlags UInt32++instance Semigroup RureFlags where+ (<>) (RureFlags x) (RureFlags y) = RureFlags (x .|. y)++data Rure++data RureOptions++data RureMatch = RureMatch { start :: !CSize, end :: !CSize } deriving (Eq, Show)++data RureError++data RureIter++data RureCaptures++data RureSet++(<<) :: Bits a => a -> Int -> a+m << n = m `shift` n++rureFlagCaseI :: RureFlags+rureFlagCaseI = RureFlags ({# const RURE_FLAG_CASEI #})++rureFlagMulti :: RureFlags+rureFlagMulti = RureFlags ({# const RURE_FLAG_MULTI #})++rureFlagDotNL :: RureFlags+rureFlagDotNL = RureFlags ({# const RURE_FLAG_DOTNL #})++rureFlagSwapGreed :: RureFlags+rureFlagSwapGreed = RureFlags ({# const RURE_FLAG_SWAP_GREED #})++rureFlagSpace :: RureFlags+rureFlagSpace = RureFlags ({# const RURE_FLAG_SPACE #})++rureFlagUnicode :: RureFlags+rureFlagUnicode = RureFlags ({# const RURE_FLAG_UNICODE #})++rureDefaultFlags :: RureFlags+rureDefaultFlags = RureFlags ({# const RURE_FLAG_UNICODE #})++{# pointer *rure as RurePtr foreign finalizer rure_free as ^ -> Rure #}+{# pointer *rure_options as RureOptionsPtr foreign finalizer rure_options_free as ^ -> RureOptions #}+{# pointer *rure_error as RureErrorPtr foreign finalizer rure_error_free as ^ -> RureError #}+{# pointer *rure_iter as RureIterPtr foreign finalizer rure_iter_free as ^ -> RureIter #}+{# pointer *rure_captures as RureCapturesPtr foreign finalizer rure_captures_free as ^ -> RureCaptures #}+{# pointer *rure_set as RureSetPtr foreign finalizer rure_set_free as ^ -> RureSet #}++{# fun rure_compile_must as ^ { `CString' } -> `Ptr Rure' id #}+{# fun rure_compile as ^ { `Ptr UInt8'+ , coerce `CSize'+ , coerce `RureFlags'+ , `RureOptionsPtr'+ , `RureErrorPtr'+ } -> `Ptr Rure' id+ #}+{# fun rure_is_match as ^ { `RurePtr', `Ptr UInt8', coerce `CSize', coerce `CSize' } -> `Bool' #}+{# fun rure_find as ^ { `RurePtr'+ , `Ptr UInt8'+ , coerce `CSize'+ , coerce `CSize'+ , castPtr `Ptr RureMatch'+ } -> `Bool'+ #}+{# fun rure_find_captures as ^ { `RurePtr'+ , `Ptr UInt8'+ , coerce `CSize'+ , coerce `CSize'+ , `RureCapturesPtr'+ } -> `Bool'+ #}+{# fun rure_shortest_match as ^ { `RurePtr'+ , `Ptr UInt8'+ , coerce `CSize'+ , coerce `CSize'+ , castPtr `Ptr CSize'+ } -> `Bool'+ #}+{# fun rure_capture_name_index as ^ { `RurePtr'+ , `CString'+ } -> `Int32'+ #}+{# fun rure_iter_new as ^ { `RurePtr' } -> `Ptr RureIter' id #}+{# fun rure_iter_next as ^ { `RureIterPtr'+ , `Ptr UInt8'+ , coerce `CSize'+ , castPtr `Ptr RureMatch'+ } -> `Bool'+ #}+{# fun rure_iter_next_captures as ^ { `RureIterPtr'+ , `Ptr UInt8'+ , coerce `CSize'+ , `RureCapturesPtr'+ } -> `Bool'+ #}+{# fun rure_captures_new as ^ { `RurePtr' } -> `Ptr RureCaptures' id #}+{# fun rure_captures_at as ^ { `RureCapturesPtr', coerce `CSize', castPtr `Ptr RureMatch' } -> `Bool' #}+{# fun rure_captures_len as ^ { `RureCapturesPtr' } -> `CSize' coerce #}+{# fun rure_options_new as ^ { } -> `Ptr RureOptions' id #}+{# fun rure_options_size_limit as ^ { `RureOptionsPtr', coerce `CSize' } -> `()' #}+{# fun rure_options_dfa_size_limit as ^ { `RureOptionsPtr', coerce `CSize' } -> `()' #}+{# fun rure_compile_set as ^ { id `Ptr (Ptr UInt8)'+ , castPtr `Ptr CSize'+ , coerce `CSize'+ , coerce `RureFlags'+ , `RureOptionsPtr'+ , `RureErrorPtr'+ } -> `Ptr RureSet' id+ #}+{# fun rure_set_is_match as ^ { `RureSetPtr'+ , `Ptr UInt8'+ , coerce `CSize'+ , coerce `CSize'+ } -> `Bool'+ #}+{# fun rure_set_matches as ^ { `RureSetPtr'+ , `Ptr UInt8'+ , coerce `CSize'+ , coerce `CSize'+ , castPtr `Ptr CBool'+ } -> `Bool'+ #}+{# fun rure_set_len as ^ { `RureSetPtr' } -> `CSize' coerce #}+{# fun rure_error_new as ^ { } -> `Ptr RureError' id #}+{# fun rure_error_message as ^ { `RureErrorPtr' } -> `String' #}+{# fun rure_escape_must as ^ { `CString' } -> `CString' #}+{# fun rure_cstring_free as ^ { `CString' } -> `()' #}
+ test/Spec.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import qualified Data.ByteString as BS+import Regex.Rure+import Test.Tasty+import Test.Tasty.HUnit++main :: IO ()+main = defaultMain $+ testGroup "High-level interface"+ [ testCase "Matches a file extension" (matchY "\\.awk$" "/usr/share/vim/vim82/tools/mve.awk")+ , testCase "Matches file extensions" $+ matchesY ["\\.y$", "\\.hs$", "\\.chs$", "\\.x$", "\\.lhs"] "Setup.hs"+ , testCase "Matches pattern" $+ matchesSet ["\\.y$", "\\.hs$", "\\.chs$", "\\.x$", "\\.lhs"] "Setup.hs"+ [False, True, False, False, False]+ , testCase "Matches at" (findAt "libj\\.dylib$" "/Applications/j903/bin/libj.dylib" (RureMatch 23 33))+ , testCase "Matches at (plural)" $+ matchesAt "\\d{4}-\\d{2}-\\d{2}" "2012-03-14 2013-01-01 2014-07-05"+ [ RureMatch 0 10+ , RureMatch 11 21+ , RureMatch 22 32+ ]+ ]++matchesAt :: BS.ByteString+ -> BS.ByteString+ -> [RureMatch]+ -> Assertion+matchesAt re haystack expected =+ let (Right actual) = hsMatches rureDefaultFlags re haystack+ in actual @?= expected++findAt :: BS.ByteString+ -> BS.ByteString+ -> RureMatch+ -> Assertion+findAt re haystack expected =+ let (Right actual) = hsFind rureDefaultFlags re haystack+ in actual @?= Just expected++matchesSet :: [BS.ByteString]+ -> BS.ByteString+ -> [Bool]+ -> Assertion+matchesSet res haystack expected =+ case hsSetMatches rureDefaultFlags res haystack of+ Left err -> assertFailure err+ Right actual -> actual @?= expected++matchesY :: [BS.ByteString]+ -> BS.ByteString+ -> Assertion+matchesY res haystack =+ case hsSetIsMatch rureDefaultFlags res haystack of+ Left err -> assertFailure err+ Right b -> assertBool "matches (set)" b++matchY :: BS.ByteString+ -> BS.ByteString+ -> Assertion+matchY re haystack =+ case hsIsMatch rureDefaultFlags re haystack of+ Left err -> assertFailure err+ Right b -> assertBool "matches" b