{-
    Copyright 2012-2019 Vidar Holen

    This file is part of ShellCheck.
    https://www.shellcheck.net

    ShellCheck 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.

    ShellCheck 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 <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE FlexibleContexts #-}

-- Basically Text.Regex based on regex-tdfa instead of the buggy regex-posix.
module ShellCheck.Regex where

import Data.List
import Data.Maybe
import Control.Monad
import Text.Regex.TDFA

-- Precompile the regex
mkRegex :: String -> Regex
mkRegex :: String -> Regex
mkRegex String
str =
    let make :: String -> Regex
        make :: String -> Regex
make = String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
makeRegex
    in
        String -> Regex
make String
str

-- Does the regex match?
matches :: String -> Regex -> Bool
matches :: String -> Regex -> Bool
matches = (Regex -> String -> Bool) -> String -> Regex -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Regex -> String -> Bool
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match

-- Get all subgroups of the first match
matchRegex :: Regex -> String -> Maybe [String]
matchRegex :: Regex -> String -> Maybe [String]
matchRegex Regex
re String
str = do
    (String
_, String
_, String
_, [String]
groups) <- Regex -> String -> Maybe (String, String, String, [String])
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM Regex
re String
str :: Maybe (String,String,String,[String])
    [String] -> Maybe [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
groups

-- Get all full matches
matchAllStrings :: Regex -> String -> [String]
matchAllStrings :: Regex -> String -> [String]
matchAllStrings Regex
re = (String -> Maybe (String, String)) -> String -> [String]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr String -> Maybe (String, String)
f
  where
    f :: String -> Maybe (String, String)
    f :: String -> Maybe (String, String)
f String
str = do
        (String
_, String
match, String
rest, [String]
_) <- Regex -> String -> Maybe (String, String, String, [String])
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM Regex
re String
str :: Maybe (String, String, String, [String])
        (String, String) -> Maybe (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
match, String
rest)

-- Get all subgroups from all matches
matchAllSubgroups :: Regex -> String -> [[String]]
matchAllSubgroups :: Regex -> String -> [[String]]
matchAllSubgroups Regex
re = (String -> Maybe ([String], String)) -> String -> [[String]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr String -> Maybe ([String], String)
f
  where
    f :: String -> Maybe ([String], String)
    f :: String -> Maybe ([String], String)
f String
str = do
        (String
_, String
_, String
rest, [String]
groups) <- Regex -> String -> Maybe (String, String, String, [String])
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM Regex
re String
str :: Maybe (String, String, String, [String])
        ([String], String) -> Maybe ([String], String)
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
groups, String
rest)

-- Replace regex in input with string
subRegex :: Regex -> String -> String -> String
subRegex :: Regex -> String -> String -> String
subRegex Regex
re String
input String
replacement = String -> String
f String
input
  where
    f :: String -> String
f String
str = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
str (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ do
        (String
before, String
match, String
after) <- Regex -> String -> Maybe (String, String, String)
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM Regex
re String
str :: Maybe (String, String, String)
        Bool -> Maybe () -> Maybe ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
match) (Maybe () -> Maybe ()) -> Maybe () -> Maybe ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe ()
forall a. HasCallStack => String -> a
error (String
"Internal error: substituted empty in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str)
        String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
before String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
replacement String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
f String
after

-- Split a string based on a regex.
splitOn :: String -> Regex -> [String]
splitOn :: String -> Regex -> [String]
splitOn String
input Regex
re =
    case Regex -> String -> Maybe (String, String, String)
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM Regex
re String
input :: Maybe (String, String, String) of
        Just (String
before, String
match, String
after) -> String
before String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
after String -> Regex -> [String]
`splitOn` Regex
re
        Maybe (String, String, String)
Nothing -> [String
input]