Added a monoid instance and helper functions to regex flags

Author: Risto-Stevcev

src/Data/String/Regex.js

@@ -25,7 +25,7 @@ exports.source = function (r) {
   return r.source;
 };
 
-exports.flags = function (r) {
+exports["flags'"] = function (r) {
   return {
     multiline: r.multiline,
     ignoreCase: r.ignoreCase,

src/Data/String/Regex.purs

@@ -4,6 +4,7 @@
 module Data.String.Regex
   ( Regex(..)
   , RegexFlags(..)
+  , RegexFlagsRec
   , regex
   , source
   , flags
@@ -16,13 +17,15 @@ module Data.String.Regex
   , search
   , split
   , noFlags
+  , g, i, m, s, u
   ) where
 
 import Prelude
 
 import Data.Either (Either(..))
 import Data.Maybe (Maybe(..))
 import Data.String (contains)
+import Data.Monoid (class Monoid)
 
 -- | Wraps Javascript `RegExp` objects.
 foreign import data Regex :: *
@@ -32,22 +35,89 @@ foreign import showRegex' :: Regex -> String
 instance showRegex :: Show Regex where
   show = showRegex'
 
--- | Flags that control matching.
-type RegexFlags =
-  { global :: Boolean
+type RegexFlagsRec =
+  { global     :: Boolean
   , ignoreCase :: Boolean
-  , multiline :: Boolean
-  , sticky :: Boolean
-  , unicode :: Boolean
+  , multiline  :: Boolean
+  , sticky     :: Boolean
+  , unicode    :: Boolean
   }
 
+-- | Flags that control matching.
+data RegexFlags = RegexFlags RegexFlagsRec
+
 -- | All flags set to false.
 noFlags :: RegexFlags
-noFlags = { global     : false
-          , ignoreCase : false
-          , multiline  : false
-          , sticky     : false
-          , unicode    : false }
+noFlags = RegexFlags
+  { global     : false
+  , ignoreCase : false
+  , multiline  : false
+  , sticky     : false
+  , unicode    : false
+  }
+
+-- | Only global flag set to true
+g :: RegexFlags
+g = RegexFlags
+  { global     : true
+  , ignoreCase : false
+  , multiline  : false
+  , sticky     : false
+  , unicode    : false
+  }
+
+-- | Only ignoreCase flag set to true
+i :: RegexFlags
+i = RegexFlags
+  { global     : false
+  , ignoreCase : true
+  , multiline  : false
+  , sticky     : false
+  , unicode    : false
+  }
+
+-- | Only multiline flag set to true
+m :: RegexFlags
+m = RegexFlags
+  { global     : false
+  , ignoreCase : false
+  , multiline  : true
+  , sticky     : false
+  , unicode    : false
+  }
+
+-- | Only sticky flag set to true
+s :: RegexFlags
+s = RegexFlags
+  { global     : false
+  , ignoreCase : false
+  , multiline  : false
+  , sticky     : true
+  , unicode    : false
+  }
+
+-- | Only unicode flag set to true
+u :: RegexFlags
+u = RegexFlags
+  { global     : false
+  , ignoreCase : false
+  , multiline  : false
+  , sticky     : false
+  , unicode    : true
+  }
+
+instance semigroupRegexFlags :: Semigroup RegexFlags where
+  append (RegexFlags x) (RegexFlags y) = RegexFlags 
+    { global     : x.global     || y.global
+    , ignoreCase : x.ignoreCase || y.ignoreCase
+    , multiline  : x.multiline  || y.multiline
+    , sticky     : x.sticky     || y.sticky
+    , unicode    : x.unicode    || y.unicode
+    }
+
+instance monoidRegexFlags :: Monoid RegexFlags where
+ mempty = noFlags
+
 
 foreign import regex' :: (String -> Either String Regex)
                       -> (Regex -> Either String Regex)
@@ -58,31 +128,37 @@ foreign import regex' :: (String -> Either String Regex)
 -- | Constructs a `Regex` from a pattern string and flags. Fails with
 -- | `Left error` if the pattern contains a syntax error.
 regex :: String -> RegexFlags -> Either String Regex
-regex s f = regex' Left Right s $ renderFlags f
+regex str f = regex' Left Right str $ renderFlags f
 
 -- | Returns the pattern string used to construct the given `Regex`.
 foreign import source :: Regex -> String
 
 -- | Returns the `RegexFlags` used to construct the given `Regex`.
-foreign import flags :: Regex -> RegexFlags
+flags :: Regex -> RegexFlags
+flags = RegexFlags <<< flags'
+
+-- | Returns the `RegexFlags` inner record used to construct the given `Regex`.
+foreign import flags' :: Regex -> RegexFlagsRec
+
+
 
 -- | Returns the string representation of the given `RegexFlags`.
 renderFlags :: RegexFlags -> String
-renderFlags f =
-  (if f.global then "g" else "") <>
+renderFlags (RegexFlags f) =
+  (if f.global     then "g" else "") <>
   (if f.ignoreCase then "i" else "") <>
-  (if f.multiline then "m" else "") <>
-  (if f.sticky then "y" else "") <>
-  (if f.unicode then "u" else "")
+  (if f.multiline  then "m" else "") <>
+  (if f.sticky     then "y" else "") <>
+  (if f.unicode    then "u" else "")
 
 -- | Parses the string representation of `RegexFlags`.
 parseFlags :: String -> RegexFlags
-parseFlags s =
-  { global: contains "g" s
-  , ignoreCase: contains "i" s
-  , multiline: contains "m" s
-  , sticky: contains "y" s
-  , unicode: contains "u" s
+parseFlags str = RegexFlags
+  { global     : contains "g" str
+  , ignoreCase : contains "i" str
+  , multiline  : contains "m" str
+  , sticky     : contains "y" str
+  , unicode    : contains "u" str
   }
 
 -- | Returns `true` if the `Regex` matches the string. In contrast to

test/Test/Data/String/Regex.purs

@@ -1,6 +1,6 @@
 module Test.Data.String.Regex (testStringRegex) where
 
-import Prelude (Unit, ($), bind, (==), not)
+import Prelude (Unit, ($), (<>), bind, (==), not)
 
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, log)
@@ -24,6 +24,11 @@ testStringRegex = do
   assert $ not (test (regex' "^b" noFlags) "abc")
   assert $ isLeft (regex "+" noFlags)
 
+  log "flags"
+  assert $ "quxbarfoobaz" == replace (regex' "foo" noFlags) "qux" "foobarfoobaz"
+  assert $ "quxbarquxbaz" == replace (regex' "foo" g) "qux" "foobarfoobaz"
+  assert $ "quxbarquxbaz" == replace (regex' "foo" (g <> i)) "qux" "foobarFOObaz"
+
   log "match"
   assert $ match (regex' "^abc$" noFlags) "abc" == Just [Just "abc"]