regex-rure 0.1.2.1 → 1.0.0.0
raw patch · 5 files changed
+34/−75 lines, 5 files
Files
- CHANGELOG.md +4/−0
- regex-rure.cabal +1/−1
- src/Regex/Rure.chs +3/−14
- src/Regex/Rure/FFI.chs +17/−37
- test/Spec.hs +9/−23
CHANGELOG.md view
@@ -1,3 +1,7 @@+# 1.0.0.0++ * `RureFlags` via c2hs macro-as-enum capability+ # 0.1.2.1 * Restyle
regex-rure.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: regex-rure-version: 0.1.2.1+version: 1.0.0.0 license: AGPL-3 license-file: COPYING maintainer: vamchale@gmail.com
src/Regex/Rure.chs view
@@ -23,13 +23,7 @@ , RureIterPtr , RureSetPtr -- * Options/flags- , RureFlags- , rureFlagCaseI- , rureFlagMulti- , rureFlagDotNL- , rureFlagSwapGreed- , rureFlagSpace- , rureFlagUnicode+ , RureFlags (..) , rureDefaultFlags ) where @@ -111,9 +105,7 @@ Right rp -> Right <$> ((\riPtr -> matches riPtr haystack) =<< mkIter rp) -- | @since 0.1.2.0-matches' :: RurePtr- -> BS.ByteString- -> IO [RureMatch]+matches' :: RurePtr -> BS.ByteString -> IO [RureMatch] matches' rp haystack = do ri <- mkIter rp matches ri haystack@@ -245,10 +237,7 @@ BS.unsafeUseAsCStringLen haystack $ \(p, sz) -> rureSetIsMatch rsPtr (castPtr p) (fromIntegral sz) startϵ -setMatches :: RureSetPtr- -> BS.ByteString- -> CSize- -> IO [Bool]+setMatches :: RureSetPtr -> BS.ByteString -> CSize -> IO [Bool] setMatches rsPtr haystack startϵ = BS.unsafeUseAsCStringLen haystack $ \(p, sz) -> do l <- fromIntegral <$> rureSetLen rsPtr
src/Regex/Rure/FFI.chs view
@@ -13,7 +13,7 @@ , UInt32 -- ** Types , RureMatch (..)- , RureFlags+ , RureFlags (..) -- ** Pointer types (c2hs) , RurePtr , RureErrorPtr@@ -59,19 +59,13 @@ , rureSetLen , rureIterCaptureNamesNext -- ** Flags- , rureFlagCaseI- , rureFlagMulti- , rureFlagDotNL- , rureFlagSwapGreed- , rureFlagSpace- , rureFlagUnicode , rureDefaultFlags -- ** String utilities , rureEscapeMust , rureCstringFree ) where -import Data.Bits (Bits, (.|.), shift)+import Data.Bits ((.|.)) import Data.Coerce (coerce) import Data.Int (Int32) import Data.Semigroup (Semigroup (..))@@ -87,15 +81,25 @@ type UInt32 = {# type uint32_t #} -newtype RureFlags = RureFlags UInt32- instance Semigroup RureFlags where- (<>) (RureFlags x) (RureFlags y) = RureFlags (x .|. y)+ (<>) x y = toEnum (fromEnum x .|. fromEnum y) data Rure data RureOptions +rureDefaultFlags :: RureFlags+rureDefaultFlags = RureFlagUnicode++{# enum define RureFlags { RURE_FLAG_CASEI as RureFlagCaseI+ , RURE_FLAG_MULTI as RureFlagMulti+ , RURE_FLAG_DOTNL as RureFlagDotNL+ , RURE_FLAG_SWAP_GREED as RureFlagSwapGreed+ , RURE_FLAG_SPACE as RureFlagSpace+ , RURE_FLAG_UNICODE as RureFlagUnicode+ }+ #}+ data RureMatch = RureMatch { start :: !CSize, end :: !CSize } deriving (Eq, Show) data RureError@@ -108,30 +112,6 @@ 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 #}@@ -143,7 +123,7 @@ {# fun unsafe rure_compile_must as ^ { `CString' } -> `Ptr Rure' id #} {# fun unsafe rure_compile as ^ { `Ptr UInt8' , coerce `CSize'- , coerce `RureFlags'+ , `RureFlags' , `RureOptionsPtr' , `RureErrorPtr' } -> `Ptr Rure' id@@ -198,7 +178,7 @@ {# fun unsafe rure_compile_set as ^ { id `Ptr (Ptr UInt8)' , castPtr `Ptr CSize' , coerce `CSize'- , coerce `RureFlags'+ , `RureFlags' , `RureOptionsPtr' , `RureErrorPtr' } -> `Ptr RureSet' id
test/Spec.hs view
@@ -48,7 +48,7 @@ -> [RureMatch] -> Assertion capturess re haystack ix expected = do- (Right rp) <- compile rureDefaultFlags re+ Right rp <- compile rureDefaultFlags re actual <- captures rp haystack ix actual @?= expected @@ -58,47 +58,33 @@ -> RureMatch -> Assertion captures' re haystack ix expected = do- (Right rp) <- compile rureDefaultFlags re- actual <- findCaptures rp haystack ix 0- actual @?= Just expected-+ Right rp <- compile rureDefaultFlags re+ Just actual <- findCaptures rp haystack ix 0+ actual @?= expected -matchesAt :: BS.ByteString- -> BS.ByteString- -> [RureMatch]- -> Assertion+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 :: 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 :: [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 :: [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 :: BS.ByteString -> BS.ByteString -> Assertion matchY re haystack = case hsIsMatch rureDefaultFlags re haystack of Left err -> assertFailure err