{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
--------------------------------------------------------------------------------
-- | Miscellaneous string manipulation functions.
module Hakyll.Core.Util.String
    ( trim
    , replaceAll
    , splitAll
    , needlePrefix
    , removeWinPathSeparator
    ) where


--------------------------------------------------------------------------------
import Data.Char (isSpace)
import Data.List (isPrefixOf)
import Text.Regex.TDFA ((=~~))


--------------------------------------------------------------------------------
-- | Trim a string (drop spaces, tabs and newlines at both sides).
trim :: String -> String
trim :: String -> String
trim = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
trim' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
trim'
  where
    trim' :: String -> String
trim' = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace


--------------------------------------------------------------------------------
-- | A simple (but inefficient) regex replace funcion
replaceAll :: String              -- ^ Pattern
           -> (String -> String)  -- ^ Replacement (called on match)
           -> String              -- ^ Source string
           -> String              -- ^ Result
replaceAll :: String -> (String -> String) -> String -> String
replaceAll String
pattern String -> String
f String
source = String -> String
replaceAll' String
source
  where
    replaceAll' :: String -> String
replaceAll' String
""  = String
""
    replaceAll' String
src = case String
src String -> String -> Maybe (String, String, String)
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ String
pattern of
        Maybe (String, String, String)
Nothing                       -> String
src
        Just (String
before, String
capture, String
after) -> String
before String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
f String
capture String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
replaceAll' String
after


--------------------------------------------------------------------------------
-- | A simple regex split function. The resulting list will contain no empty
-- strings.
splitAll :: String    -- ^ Pattern
         -> String    -- ^ String to split
         -> [String]  -- ^ Result
splitAll :: String -> String -> [String]
splitAll String
pattern = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitAll'
  where
    splitAll' :: String -> [String]
splitAll' String
""  = []
    splitAll' String
src = case String
src String -> String -> Maybe (String, String, String)
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ String
pattern of
        Maybe (String, String, String)
Nothing                         -> [String
src]
        Just (String
before, String
_::String, String
after) -> String
before String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
splitAll' String
after



--------------------------------------------------------------------------------
-- | Find the first instance of needle (must be non-empty) in haystack. We
-- return the prefix of haystack before needle is matched.
--
-- Examples:
--
-- > needlePrefix "cd" "abcde" = "ab"
--
-- > needlePrefix "ab" "abc" = ""
--
-- > needlePrefix "ab" "xxab" = "xx"
--
-- > needlePrefix "a" "xx" = "xx"
needlePrefix :: String -> String -> Maybe String
needlePrefix :: String -> String -> Maybe String
needlePrefix String
needle String
haystack = String -> String -> Maybe String
go [] String
haystack
  where
    go :: String -> String -> Maybe String
go String
_   []                     = Maybe String
forall a. Maybe a
Nothing
    go String
acc xss :: String
xss@(Char
x:String
xs)
        | String
needle String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xss = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse String
acc
        | Bool
otherwise               = String -> String -> Maybe String
go (Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
acc) String
xs


--------------------------------------------------------------------------------
-- | Translate native Windows path separators '\\' to '/' if present.
removeWinPathSeparator :: String -> String
removeWinPathSeparator :: String -> String
removeWinPathSeparator = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' then [Char
'/'] else [Char
c])