{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

{-|
Module      : Headroom.Regex
Description : Helper functions for regular expressions
Copyright   : (c) 2019-2020 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

Provides wrappers mainly around functions from "Text.Regex.PCRE.Light" that more
suits the needs of this application.
-}

module Headroom.Regex
  ( compile'
  , joinPatterns
  , match'
  )
where

import           RIO
import qualified RIO.Text                      as T
import           Text.Regex.PCRE.Light          ( Regex
                                                , compile
                                                )
import           Text.Regex.PCRE.Light.Char8    ( match
                                                , utf8
                                                )



-- | Same as 'compile', but takes 'Text' on input and enables 'utf8' option
-- by default.
compile' :: Text  -- ^ regular expression to be compiled
         -> Regex -- ^ compiled regular expression
compile' :: Text -> Regex
compile' regex :: Text
regex = ByteString -> [PCREOption] -> Regex
compile (Text -> ByteString
encodeUtf8 Text
regex) [PCREOption
utf8]


-- | Joins list of patterns into single regex string. If the input list is
-- empty, 'Nothing' is returned.
--
-- >>> joinPatterns ["^foo", "^bar"]
-- Just "^foo|^bar"
joinPatterns :: [Text]     -- ^ list of patterns to join
             -> Maybe Text -- ^ joined patterns
joinPatterns :: [Text] -> Maybe Text
joinPatterns [] = Maybe Text
forall a. Maybe a
Nothing
joinPatterns ps :: [Text]
ps = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate "|" [Text]
ps


-- | Same as 'match', but works with 'Text' and uses no additional options.
match' :: Regex        -- ^ a PCRE regular expression value produced by compile
       -> Text         -- ^ the subject text to match against
       -> Maybe [Text] -- ^ the result value
match' :: Regex -> Text -> Maybe [Text]
match' regex :: Regex
regex subject :: Text
subject = (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack ([String] -> [Text]) -> Maybe [String] -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Regex -> String -> [PCREExecOption] -> Maybe [String]
match Regex
regex (Text -> String
T.unpack Text
subject) []