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

This module is the heart of /Headroom/ as it contains functions for working with
the /license headers/ and the /source code files/.
-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TemplateHaskell   #-}
module Headroom.FileSupport
  ( -- * File info extraction
    extractFileInfo
    -- * License header manipulation
  , addHeader
  , dropHeader
  , replaceHeader
    -- * License header detection
  , findHeader
  , findBlockHeader
  , findLineHeader
  , firstMatching
  , lastMatching
  , splitInput
  )
where

import           Control.Lens.TH                ( makeLensesFor )
import           Headroom.Types                 ( FileInfo(..)
                                                , FileType(..)
                                                , HeaderConfig(..)
                                                , HeaderSyntax(..)
                                                )
import           RIO
import qualified RIO.HashMap                   as HM
import qualified RIO.List                      as L
import qualified RIO.Text                      as T
import           Text.Regex.PCRE.Light          ( Regex
                                                , compile
                                                , match
                                                )
import           Text.Regex.PCRE.Light.Char8    ( utf8 )


makeLensesFor [("fiHeaderPos", "fiHeaderPosL")] ''FileInfo


-- | Extracts info about the processed file to be later used by the header
-- detection/manipulation functions.
extractFileInfo :: FileType     -- ^ type of the detected file
                -> HeaderConfig -- ^ appropriate header configuration
                -> Text         -- ^ text used for detection
                -> FileInfo     -- ^ resulting file info
extractFileInfo :: FileType -> HeaderConfig -> Text -> FileInfo
extractFileInfo fiFileType :: FileType
fiFileType fiHeaderConfig :: HeaderConfig
fiHeaderConfig input :: Text
input =
  let fiHeaderPos :: Maybe (Int, Int)
fiHeaderPos = HeaderConfig -> Text -> Maybe (Int, Int)
findHeader HeaderConfig
fiHeaderConfig Text
input
      fiVariables :: HashMap Text Text
fiVariables = FileType -> HeaderConfig -> Text -> HashMap Text Text
extractVariables FileType
fiFileType HeaderConfig
fiHeaderConfig Text
input
  in  $WFileInfo :: FileType
-> HeaderConfig
-> Maybe (Int, Int)
-> HashMap Text Text
-> FileInfo
FileInfo { .. }


-- | Adds given header at position specified by the 'FileInfo'. Does nothing if
-- any header is already present, use 'replaceHeader' if you need to
-- override it.
addHeader :: FileInfo -- ^ info about file where header is added
          -> Text     -- ^ text of the new header
          -> Text     -- ^ text of the file where to add the header
          -> Text     -- ^ resulting text with added header
addHeader :: FileInfo -> Text -> Text -> Text
addHeader FileInfo {..} _ text :: Text
text | Maybe (Int, Int) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Int, Int)
fiHeaderPos = Text
text
addHeader FileInfo {..} header :: Text
header text :: Text
text                 = Text
result
 where
  (before :: [Text]
before, middle :: [Text]
middle, after :: [Text]
after) = [Text] -> [Text] -> Text -> ([Text], [Text], [Text])
splitInput [Text]
hcPutAfter [Text]
hcPutBefore Text
text
  HeaderConfig {..}       = HeaderConfig
fiHeaderConfig
  before' :: [Text]
before'                 = [Text] -> [Text]
stripLinesEnd [Text]
before
  middle' :: [Text]
middle'                 = [Text] -> [Text]
stripLinesStart [Text]
middle
  margin :: [a] -> Int -> [a]
margin [] _    = []
  margin _  size :: Int
size = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
size ""
  marginBefore :: [Text]
marginBefore = [Text] -> Int -> [Text]
forall a a. IsString a => [a] -> Int -> [a]
margin [Text]
before' Int
hcMarginBefore
  marginAfter :: [Text]
marginAfter  = [Text] -> Int -> [Text]
forall a a. IsString a => [a] -> Int -> [a]
margin ([Text]
middle' [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
after) Int
hcMarginAfter
  result :: Text
result       = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text]]
joined
  joined :: [[Text]]
joined       = [[Text]
before', [Text]
marginBefore, [Text
header], [Text]
marginAfter, [Text]
middle', [Text]
after]


-- | Drops header at position specified by the 'FileInfo' from the given text.
-- Does nothing if no header is present.
dropHeader :: FileInfo -- ^ info about the file from which the header will be dropped
           -> Text     -- ^ text of the file from which to drop the header
           -> Text     -- ^ resulting text with dropped header
dropHeader :: FileInfo -> Text -> Text
dropHeader (FileInfo _ _ Nothing             _) text :: Text
text = Text
text
dropHeader (FileInfo _ _ (Just (start :: Int
start, end :: Int
end)) _) text :: Text
text = Text
result
 where
  before :: [Text]
before     = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
start [Text]
inputLines
  after :: [Text]
after      = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) [Text]
inputLines
  inputLines :: [Text]
inputLines = Text -> [Text]
T.lines Text
text
  result :: Text
result     = [Text] -> Text
T.unlines ([Text] -> [Text]
stripLinesEnd [Text]
before [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text] -> [Text]
stripLinesStart [Text]
after)


-- | Replaces existing header at position specified by the 'FileInfo' in the
-- given text. Basically combines 'addHeader' with 'dropHeader'. If no header
-- is present, then the given one is added to the text.
replaceHeader :: FileInfo -- ^ info about the file in which to replace the header
              -> Text     -- ^ text of the new header
              -> Text     -- ^ text of the file where to replace the header
              -> Text     -- ^ resulting text with replaced header
replaceHeader :: FileInfo -> Text -> Text -> Text
replaceHeader fileInfo :: FileInfo
fileInfo header :: Text
header = Text -> Text
addHeader' (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dropHeader'
 where
  addHeader' :: Text -> Text
addHeader'     = FileInfo -> Text -> Text -> Text
addHeader FileInfo
infoWithoutPos Text
header
  dropHeader' :: Text -> Text
dropHeader'    = FileInfo -> Text -> Text
dropHeader FileInfo
fileInfo
  infoWithoutPos :: FileInfo
infoWithoutPos = ASetter FileInfo FileInfo (Maybe (Int, Int)) (Maybe (Int, Int))
-> Maybe (Int, Int) -> FileInfo -> FileInfo
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter FileInfo FileInfo (Maybe (Int, Int)) (Maybe (Int, Int))
Lens' FileInfo (Maybe (Int, Int))
fiHeaderPosL Maybe (Int, Int)
forall a. Maybe a
Nothing FileInfo
fileInfo


-- | Finds header position in given text, where position is represented by
-- line number of first and last line of the header (numbered from zero).
-- Based on the 'HeaderSyntax' specified in given 'HeaderConfig', this function
-- delegates its work to either 'findBlockHeader' or 'findLineHeader'.
--
-- >>> let hc = HeaderConfig ["hs"] 0 0 [] [] (BlockComment "{-" "-}")
-- >>> findHeader hc "foo\nbar\n{- HEADER -}\nbaz"
-- Just (2,2)
findHeader :: HeaderConfig     -- ^ appropriate header configuration
           -> Text             -- ^ text in which to detect the header
           -> Maybe (Int, Int) -- ^ header position @(startLine, endLine)@
findHeader :: HeaderConfig -> Text -> Maybe (Int, Int)
findHeader HeaderConfig {..} input :: Text
input = case HeaderSyntax
hcHeaderSyntax of
  BlockComment start :: Text
start end :: Text
end -> Text -> Text -> [Text] -> Int -> Maybe (Int, Int)
findBlockHeader Text
start Text
end [Text]
inLines Int
splitAt
  LineComment prefix :: Text
prefix     -> Text -> [Text] -> Int -> Maybe (Int, Int)
findLineHeader Text
prefix [Text]
inLines Int
splitAt
 where
  (before :: [Text]
before, headerArea :: [Text]
headerArea, _) = [Text] -> [Text] -> Text -> ([Text], [Text], [Text])
splitInput [Text]
hcPutAfter [Text]
hcPutBefore Text
input
  splitAt :: Int
splitAt                 = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Text]
before
  inLines :: [Text]
inLines                 = Text -> Text
T.strip (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
headerArea


-- | Finds header in the form of /multi-line comment/ syntax, which is delimited
-- with starting and ending pattern.
--
-- >>> findBlockHeader "{-" "-}" ["", "{- HEADER -}", "", ""] 0
-- Just (1,1)
findBlockHeader :: Text             -- ^ starting pattern (e.g. @{-@ or @/*@)
                -> Text             -- ^ ending pattern (e.g. @-}@ or @*/@)
                -> [Text]           -- ^ lines of text in which to detect the header
                -> Int              -- ^ line number offset (adds to resulting position)
                -> Maybe (Int, Int) -- ^ header position @(startLine + offset, endLine + offset)@
findBlockHeader :: Text -> Text -> [Text] -> Int -> Maybe (Int, Int)
findBlockHeader startsWith :: Text
startsWith endsWith :: Text
endsWith = Maybe Int -> Maybe Any -> [Text] -> Int -> Maybe (Int, Int)
forall a a.
Num a =>
Maybe a -> Maybe a -> [Text] -> a -> Maybe (a, a)
go Maybe Int
forall a. Maybe a
Nothing Maybe Any
forall a. Maybe a
Nothing
 where
  isStart :: Text -> Bool
isStart = Text -> Text -> Bool
T.isPrefixOf Text
startsWith
  isEnd :: Text -> Bool
isEnd   = Text -> Text -> Bool
T.isSuffixOf Text
endsWith
  go :: Maybe a -> Maybe a -> [Text] -> a -> Maybe (a, a)
go _ _ (x :: Text
x : _) i :: a
i | Text -> Bool
isStart Text
x Bool -> Bool -> Bool
&& Text -> Bool
isEnd Text
x = (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a
i, a
i)
  go _ _ (x :: Text
x : xs :: [Text]
xs) i :: a
i | Text -> Bool
isStart Text
x           = Maybe a -> Maybe a -> [Text] -> a -> Maybe (a, a)
go (a -> Maybe a
forall a. a -> Maybe a
Just a
i) Maybe a
forall a. Maybe a
Nothing [Text]
xs (a
i a -> a -> a
forall a. Num a => a -> a -> a
+ 1)
  go (Just start :: a
start) _ (x :: Text
x : _) i :: a
i | Text -> Bool
isEnd Text
x   = (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a
start, a
i)
  go start :: Maybe a
start end :: Maybe a
end (_ : xs :: [Text]
xs) i :: a
i                 = Maybe a -> Maybe a -> [Text] -> a -> Maybe (a, a)
go Maybe a
start Maybe a
end [Text]
xs (a
i a -> a -> a
forall a. Num a => a -> a -> a
+ 1)
  go _     _   []       _                 = Maybe (a, a)
forall a. Maybe a
Nothing


-- | Finds header in the form of /single-line comment/ syntax, which is
-- delimited with the prefix pattern.
--
-- >>> findLineHeader "--" ["", "a", "-- first", "-- second", "foo"] 0
-- Just (2,3)
findLineHeader :: Text             -- ^ prefix pattern (e.g. @--@ or @//@)
               -> [Text]           -- ^ lines of text in which to detect the header
               -> Int              -- ^ line number offset (adds to resulting position)
               -> Maybe (Int, Int) -- ^ header position @(startLine + offset, endLine + offset)@
findLineHeader :: Text -> [Text] -> Int -> Maybe (Int, Int)
findLineHeader prefix :: Text
prefix = Maybe Int -> [Text] -> Int -> Maybe (Int, Int)
forall b. Num b => Maybe b -> [Text] -> b -> Maybe (b, b)
go Maybe Int
forall a. Maybe a
Nothing
 where
  isPrefix :: Text -> Bool
isPrefix = Text -> Text -> Bool
T.isPrefixOf Text
prefix
  go :: Maybe b -> [Text] -> b -> Maybe (b, b)
go Nothing (x :: Text
x : xs :: [Text]
xs) i :: b
i | Text -> Bool
isPrefix Text
x      = Maybe b -> [Text] -> b -> Maybe (b, b)
go (b -> Maybe b
forall a. a -> Maybe a
Just b
i) [Text]
xs (b
i b -> b -> b
forall a. Num a => a -> a -> a
+ 1)
  go Nothing (_ : xs :: [Text]
xs) i :: b
i                   = Maybe b -> [Text] -> b -> Maybe (b, b)
go Maybe b
forall a. Maybe a
Nothing [Text]
xs (b
i b -> b -> b
forall a. Num a => a -> a -> a
+ 1)
  go (Just start :: b
start) (x :: Text
x : xs :: [Text]
xs) i :: b
i | Text -> Bool
isPrefix Text
x = Maybe b -> [Text] -> b -> Maybe (b, b)
go (b -> Maybe b
forall a. a -> Maybe a
Just b
start) [Text]
xs (b
i b -> b -> b
forall a. Num a => a -> a -> a
+ 1)
  go (Just start :: b
start) _  i :: b
i                    = (b, b) -> Maybe (b, b)
forall a. a -> Maybe a
Just (b
start, b
i b -> b -> b
forall a. Num a => a -> a -> a
- 1)
  go _            [] _                    = Maybe (b, b)
forall a. Maybe a
Nothing


-- | Finds very first line that matches the given /regex/ (numbered from zero).
--
-- >>> firstMatching (compile "^foo" [utf8]) ["some text", "foo bar", "foo baz", "last"]
-- Just 1
firstMatching :: Regex        -- /regex/ used for matching
              -> [Text]       -- input lines
              -> Maybe Int    -- matching line number
firstMatching :: Regex -> [Text] -> Maybe Int
firstMatching regex :: Regex
regex input :: [Text]
input = [Text] -> Int -> Maybe Int
forall t. Num t => [Text] -> t -> Maybe t
go [Text]
input 0
 where
  cond :: Text -> Bool
cond x :: Text
x = Maybe [ByteString] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [ByteString] -> Bool) -> Maybe [ByteString] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> ByteString -> [PCREExecOption] -> Maybe [ByteString]
match Regex
regex (Text -> ByteString
encodeUtf8 Text
x) []
  go :: [Text] -> t -> Maybe t
go (x :: Text
x : _) i :: t
i | Text -> Bool
cond Text
x = t -> Maybe t
forall a. a -> Maybe a
Just t
i
  go (_ : xs :: [Text]
xs) i :: t
i         = [Text] -> t -> Maybe t
go [Text]
xs (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ 1)
  go []       _         = Maybe t
forall a. Maybe a
Nothing


-- | Finds very last line that matches the given /regex/ (numbered from zero).
--
-- >>> lastMatching (compile "^foo" [utf8]) ["some text", "foo bar", "foo baz", "last"]
-- Just 2
lastMatching :: Regex        -- /regex/ used for matching
             -> [Text]       -- input lines
             -> Maybe Int    -- matching line number
lastMatching :: Regex -> [Text] -> Maybe Int
lastMatching regex :: Regex
regex input :: [Text]
input = [Text] -> Int -> Maybe Int -> Maybe Int
forall a. Num a => [Text] -> a -> Maybe a -> Maybe a
go [Text]
input 0 Maybe Int
forall a. Maybe a
Nothing
 where
  cond :: Text -> Bool
cond x :: Text
x = Maybe [ByteString] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [ByteString] -> Bool) -> Maybe [ByteString] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> ByteString -> [PCREExecOption] -> Maybe [ByteString]
match Regex
regex (Text -> ByteString
encodeUtf8 Text
x) []
  go :: [Text] -> a -> Maybe a -> Maybe a
go (x :: Text
x : xs :: [Text]
xs) i :: a
i _ | Text -> Bool
cond Text
x = [Text] -> a -> Maybe a -> Maybe a
go [Text]
xs (a
i a -> a -> a
forall a. Num a => a -> a -> a
+ 1) (a -> Maybe a
forall a. a -> Maybe a
Just a
i)
  go (_ : xs :: [Text]
xs) i :: a
i pos :: Maybe a
pos        = [Text] -> a -> Maybe a -> Maybe a
go [Text]
xs (a
i a -> a -> a
forall a. Num a => a -> a -> a
+ 1) Maybe a
pos
  go []       _ pos :: Maybe a
pos        = Maybe a
pos


-- | Splits input lines into three parts:
--
--     1. list of all lines located before the very last occurence of one of
--        the conditions from the first condition list
--     2. list of all lines between the first and last lists
--     3. list of all lines located after the very first occurence of one of
--        the conditions from the second condition list
--
-- If both first and second patterns are empty, then all lines are returned in
-- the middle list.
--
-- >>> splitInput ["->"] ["<-"] "text\n->\nRESULT\n<-\nfoo"
-- (["text","->"],["RESULT"],["<-","foo"])
--
-- >>> splitInput [] ["<-"] "text\n->\nRESULT\n<-\nfoo"
-- ([],["text","->","RESULT"],["<-","foo"])
--
-- >>> splitInput [] [] "one\ntwo"
-- ([],["one","two"],[])
splitInput :: [Text] -> [Text] -> Text -> ([Text], [Text], [Text])
splitInput :: [Text] -> [Text] -> Text -> ([Text], [Text], [Text])
splitInput []       []       input :: Text
input = ([], Text -> [Text]
T.lines Text
input, [])
splitInput fstSplit :: [Text]
fstSplit sndSplit :: [Text]
sndSplit input :: Text
input = ([Text]
before, [Text]
middle, [Text]
after)
 where
  (middle' :: [Text]
middle', after :: [Text]
after ) = Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
L.splitAt Int
sndSplitAt [Text]
inLines
  (before :: [Text]
before , middle :: [Text]
middle) = Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
L.splitAt Int
fstSplitAt [Text]
middle'
  fstSplitAt :: Int
fstSplitAt        = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe 0 (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) ((Regex -> [Text] -> Maybe Int) -> [Text] -> [Text] -> Maybe Int
forall t b. (Regex -> t -> Maybe b) -> [Text] -> t -> Maybe b
findSplit Regex -> [Text] -> Maybe Int
lastMatching [Text]
fstSplit [Text]
middle')
  sndSplitAt :: Int
sndSplitAt        = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
len ((Regex -> [Text] -> Maybe Int) -> [Text] -> [Text] -> Maybe Int
forall t b. (Regex -> t -> Maybe b) -> [Text] -> t -> Maybe b
findSplit Regex -> [Text] -> Maybe Int
firstMatching [Text]
sndSplit [Text]
inLines)
  inLines :: [Text]
inLines           = Text -> [Text]
T.lines Text
input
  len :: Int
len               = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Text]
inLines
  findSplit :: (Regex -> t -> Maybe b) -> [Text] -> t -> Maybe b
findSplit f :: Regex -> t -> Maybe b
f r :: [Text]
r i :: t
i = [Text] -> Maybe Regex
compile' [Text]
r Maybe Regex -> (Regex -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Regex -> t -> Maybe b
`f` t
i)
  compile' :: [Text] -> Maybe Regex
compile' [] = Maybe Regex
forall a. Maybe a
Nothing
  compile' ps :: [Text]
ps = Regex -> Maybe Regex
forall a. a -> Maybe a
Just (Regex -> Maybe Regex) -> Regex -> Maybe Regex
forall a b. (a -> b) -> a -> b
$ ByteString -> [PCREOption] -> Regex
compile (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate "|" [Text]
ps) [PCREOption
utf8]


-- TODO: https://github.com/vaclavsvejcar/headroom/issues/25
extractVariables :: FileType -> HeaderConfig -> Text -> HashMap Text Text
extractVariables :: FileType -> HeaderConfig -> Text -> HashMap Text Text
extractVariables _ _ _ = HashMap Text Text
forall k v. HashMap k v
HM.empty


stripLinesEnd :: [Text] -> [Text]
stripLinesEnd :: [Text] -> [Text]
stripLinesEnd = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip)


stripLinesStart :: [Text] -> [Text]
stripLinesStart :: [Text] -> [Text]
stripLinesStart = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Text -> Bool
T.null (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip)