{-|
Module      : Headroom.Header.Utils
Description : License header utilities
Copyright   : (c) 2019-2020 Vaclav Svejcar
License     : BSD-3
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

Useful functions for searching specific text fragments in input text, used by
other modules to detect existing license headers in source code files.
-}
{-# LANGUAGE NoImplicitPrelude #-}
module Headroom.Header.Utils
  ( findLine
  , findLineStartingWith
  , linesCountByRegex
  , reML
  )
where

import           Language.Haskell.TH.Quote      ( QuasiQuoter )
import           RIO
import qualified RIO.List                      as L
import qualified RIO.Text                      as T
import           Text.Regex.PCRE.Heavy
import           Text.Regex.PCRE.Light

-- | Finds line in given text that matches given predicate and returns its line
-- number.
findLine :: (Text -> Bool) -- ^ predicate to find line
         -> Text           -- ^ input text
         -> Int            -- ^ number of line that matches given predicate
findLine :: (Text -> Bool) -> Text -> Int
findLine predicate :: Text -> Bool
predicate text :: Text
text =
  Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
L.findIndex (Text -> Bool
predicate (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip) (Text -> [Text]
T.lines Text
text)

-- | Finds line starting with one of given patterns and returns its line number
-- (specialized form of 'findLine').
findLineStartingWith :: [Text] -- ^ patterns to use
                     -> Text   -- ^ input text
                     -> Int    -- ^ number of line starting with one of patterns
findLineStartingWith :: [Text] -> Text -> Int
findLineStartingWith patterns :: [Text]
patterns = (Text -> Bool) -> Text -> Int
findLine Text -> Bool
predicate
  where predicate :: Text -> Bool
predicate line :: Text
line = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Bool
`T.isPrefixOf` Text
line) [Text]
patterns

-- | Count lines that matches the given (multiline) regex. Useful for example to
-- find how many lines are taken by multi-line comment in source code.
linesCountByRegex :: Regex -- ^ regular expression to use
                  -> Text  -- ^ input text
                  -> Int   -- ^ number of lines matching given regex
linesCountByRegex :: Regex -> Text -> Int
linesCountByRegex regex :: Regex
regex text :: Text
text = case [(Text, [Text])] -> Maybe (Text, [Text])
forall a. [a] -> Maybe a
L.headMaybe ([(Text, [Text])] -> Maybe (Text, [Text]))
-> [(Text, [Text])] -> Maybe (Text, [Text])
forall a b. (a -> b) -> a -> b
$ Regex -> Text -> [(Text, [Text])]
forall a.
(ConvertibleStrings SBS a, ConvertibleStrings a SBS) =>
Regex -> a -> [(a, [a])]
scan Regex
regex Text
text of
  Just (comment :: Text
comment, _) -> [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length ([Text] -> Int) -> (Text -> [Text]) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Text
comment
  _                 -> 0

-- | Regex configuration for matching multi-line UTF strings.
reML :: QuasiQuoter
reML :: QuasiQuoter
reML = [PCREOption] -> QuasiQuoter
mkRegexQQ [PCREOption
dotall, PCREOption
utf8]