Add Semigroup and Monoid for RE (#13)

meooow25 · Mar 3, 2024 · 019543d · 019543d
1 parent 2323710
commit 019543d
Show file tree

Hide file tree

Showing 2 changed files with 33 additions and 0 deletions.
diff --git a/src/Regex/Internal/Regex.hs b/src/Regex/Internal/Regex.hs
@@ -44,6  44,7 @@ import Control.Applicative
 import Control.DeepSeq (NFData(..), NFData1(..), rnf1)
 import Control.Monad
 import Data.Functor.Classes (Eq1(..), Ord1(..), Show1(..), showsUnaryWith)
 import Data.Semigroup (Semigroup(..))
 import qualified Data.Foldable as F
 
 ---------------------------------
@@ -119,6  120,22 @@ instance Alternative (RE c) where
   some re = liftA2' (:) re (many re)
   many = fmap reverse . foldlMany' (flip (:)) []
 
 -- | @(<>) = liftA2 (<>)@
 instance Semigroup a => Semigroup (RE c a) where
   (<>) = liftA2 (<>)
   sconcat = fmap sconcat . sequenceA
   {-# INLINE sconcat #-}
 
 -- | @mempty = pure mempty@
 instance Monoid a => Monoid (RE c a) where
   mempty = pure mempty
   mconcat = fmap mconcat . sequenceA
   {-# INLINE mconcat #-}
 -- Use the underlying type's sconcat/mconcat because it may be more efficient
 -- than the default right-associative definition.
 -- stimes is not defined here since there is no way to delegate to the stimes
 -- of a.
 
 -- | Parse a @c@ into an @a@ if the given function returns @Just@.
 token :: (c -> Maybe a) -> RE c a
 token = RToken

diff --git a/test/Test.hs b/test/Test.hs
@@ -8,7  8,9 @@ import Control.Monad
 import Data.Char
 import qualified Data.List as L
 import Data.Maybe
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Proxy
 import Data.Semigroup
 import Data.String
 import qualified Numeric as Num
 import Numeric.Natural
@@ -1158,6  1160,20 @@ combinatorTests = testGroup "Combinators"
         testPM "1 <$ a <|> 2 <$ a, a, ok" re "a" (Just 1)
       ]
     ]
   , testGroup "Semigroup,Monoid" $
     let go abc =
           [ testPM "<e>, fail" abc "" Nothing
           , testPM "a, fail" abc "a" Nothing
           , testPM "bc, fail" abc "bc" Nothing
           , testPM "abc, ok" abc "abc" (Just "abc")
           ]
     in
     [ testGroup "<>" $ go (RT.text "a" <> RT.text "bc")
     , testGroup "<> mempty" $ go (RT.text "abc" <> mempty)
     , testGroup "mempty <>" $ go (mempty <> RT.text "abc")
     , testGroup "sconcat" $ go (sconcat (RT.text "a" :| [RT.text "b", RT.text "c"]))
     , testGroup "mconcat" $ go (mconcat [RT.text "a", RT.text "b", RT.text "c"])
     ]
   , testGroup "many" $
     let a = many (RT.char 'a')
         pr = many (pure ())