{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Headroom.FileSupport
(
extractFileInfo
, addHeader
, dropHeader
, replaceHeader
, findHeader
, findBlockHeader
, findLineHeader
, firstMatching
, lastMatching
, splitInput
)
where
import Headroom.Configuration.Types ( CtHeaderConfig
, HeaderConfig(..)
, HeaderSyntax(..)
)
import Headroom.Data.Lens ( suffixLensesFor )
import Headroom.Data.Regex ( Regex
, match
)
import Headroom.Data.TextExtra ( fromLines
, toLines
)
import Headroom.Ext ( extractVariables )
import Headroom.FileSupport.Types ( FileInfo(..) )
import Headroom.FileType.Types ( FileType(..) )
import Headroom.Types ( TemplateMeta(..) )
import RIO
import qualified RIO.List as L
import qualified RIO.Text as T
extractFileInfo :: FileType
-> CtHeaderConfig
-> Maybe TemplateMeta
-> Text
-> FileInfo
FileType
fiFileType CtHeaderConfig
fiHeaderConfig Maybe TemplateMeta
meta Text
text =
let fiHeaderPos :: Maybe (Int, Int)
fiHeaderPos = CtHeaderConfig -> Text -> Maybe (Int, Int)
findHeader CtHeaderConfig
fiHeaderConfig Text
text
fiVariables :: Variables
fiVariables =
FileType
-> CtHeaderConfig
-> Maybe TemplateMeta
-> Maybe (Int, Int)
-> Text
-> Variables
extractVariables FileType
fiFileType CtHeaderConfig
fiHeaderConfig Maybe TemplateMeta
meta Maybe (Int, Int)
fiHeaderPos Text
text
in FileInfo :: FileType
-> CtHeaderConfig -> Maybe (Int, Int) -> Variables -> FileInfo
FileInfo { Maybe (Int, Int)
FileType
Variables
CtHeaderConfig
fiVariables :: Variables
fiHeaderPos :: Maybe (Int, Int)
fiHeaderConfig :: CtHeaderConfig
fiFileType :: FileType
fiVariables :: Variables
fiHeaderPos :: Maybe (Int, Int)
fiHeaderConfig :: CtHeaderConfig
fiFileType :: FileType
.. }
addHeader :: FileInfo
-> Text
-> Text
-> Text
FileInfo {Maybe (Int, Int)
FileType
Variables
CtHeaderConfig
fiVariables :: Variables
fiHeaderPos :: Maybe (Int, Int)
fiHeaderConfig :: CtHeaderConfig
fiFileType :: FileType
fiVariables :: FileInfo -> Variables
fiHeaderPos :: FileInfo -> Maybe (Int, Int)
fiHeaderConfig :: FileInfo -> CtHeaderConfig
fiFileType :: FileInfo -> FileType
..} Text
_ Text
text | Maybe (Int, Int) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Int, Int)
fiHeaderPos = Text
text
addHeader FileInfo {Maybe (Int, Int)
FileType
Variables
CtHeaderConfig
fiVariables :: Variables
fiHeaderPos :: Maybe (Int, Int)
fiHeaderConfig :: CtHeaderConfig
fiFileType :: FileType
fiVariables :: FileInfo -> Variables
fiHeaderPos :: FileInfo -> Maybe (Int, Int)
fiHeaderConfig :: FileInfo -> CtHeaderConfig
fiFileType :: FileInfo -> FileType
..} Text
header Text
text = Text
result
where
([Text]
before, [Text]
middle, [Text]
after) = [Regex] -> [Regex] -> Text -> ([Text], [Text], [Text])
splitInput [Regex]
hcPutAfter [Regex]
hcPutBefore Text
text
HeaderConfig {'Complete ::: Int
'Complete ::: [Text]
'Complete ::: [Regex]
'Complete ::: HeaderSyntax
hcHeaderSyntax :: forall (p :: Phase). HeaderConfig p -> p ::: HeaderSyntax
hcPutBefore :: forall (p :: Phase). HeaderConfig p -> p ::: [Regex]
hcPutAfter :: forall (p :: Phase). HeaderConfig p -> p ::: [Regex]
hcMarginBefore :: forall (p :: Phase). HeaderConfig p -> p ::: Int
hcMarginAfter :: forall (p :: Phase). HeaderConfig p -> p ::: Int
hcFileExtensions :: forall (p :: Phase). HeaderConfig p -> p ::: [Text]
hcHeaderSyntax :: 'Complete ::: HeaderSyntax
hcMarginBefore :: 'Complete ::: Int
hcMarginAfter :: 'Complete ::: Int
hcFileExtensions :: 'Complete ::: [Text]
hcPutBefore :: 'Complete ::: [Regex]
hcPutAfter :: 'Complete ::: [Regex]
..} = CtHeaderConfig
fiHeaderConfig
before' :: [Text]
before' = [Text] -> [Text]
stripLinesEnd [Text]
before
middle' :: [Text]
middle' = [Text] -> [Text]
stripLinesStart [Text]
middle
margin :: [a] -> Int -> [a]
margin [] Int
_ = []
margin [a]
_ Int
size = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
size a
""
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
fromLines ([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]
dropHeader :: FileInfo
-> Text
-> Text
(FileInfo FileType
_ CtHeaderConfig
_ Maybe (Int, Int)
Nothing Variables
_) Text
text = Text
text
dropHeader (FileInfo FileType
_ CtHeaderConfig
_ (Just (Int
start, Int
end)) Variables
_) 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
+ Int
1) [Text]
inputLines
inputLines :: [Text]
inputLines = Text -> [Text]
toLines Text
text
result :: Text
result = [Text] -> Text
fromLines ([Text] -> [Text]
stripLinesEnd [Text]
before [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text] -> [Text]
stripLinesStart [Text]
after)
replaceHeader :: FileInfo
-> Text
-> Text
-> Text
FileInfo
fileInfo 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
findHeader :: CtHeaderConfig
-> Text
-> Maybe (Int, Int)
HeaderConfig {'Complete ::: Int
'Complete ::: [Text]
'Complete ::: [Regex]
'Complete ::: HeaderSyntax
hcHeaderSyntax :: 'Complete ::: HeaderSyntax
hcPutBefore :: 'Complete ::: [Regex]
hcPutAfter :: 'Complete ::: [Regex]
hcMarginBefore :: 'Complete ::: Int
hcMarginAfter :: 'Complete ::: Int
hcFileExtensions :: 'Complete ::: [Text]
hcHeaderSyntax :: forall (p :: Phase). HeaderConfig p -> p ::: HeaderSyntax
hcPutBefore :: forall (p :: Phase). HeaderConfig p -> p ::: [Regex]
hcPutAfter :: forall (p :: Phase). HeaderConfig p -> p ::: [Regex]
hcMarginBefore :: forall (p :: Phase). HeaderConfig p -> p ::: Int
hcMarginAfter :: forall (p :: Phase). HeaderConfig p -> p ::: Int
hcFileExtensions :: forall (p :: Phase). HeaderConfig p -> p ::: [Text]
..} Text
input = case 'Complete ::: HeaderSyntax
hcHeaderSyntax of
BlockComment start end -> Text -> Text -> [Text] -> Int -> Maybe (Int, Int)
findBlockHeader Text
start Text
end [Text]
inLines Int
splitAt
LineComment prefix -> Text -> [Text] -> Int -> Maybe (Int, Int)
findLineHeader Text
prefix [Text]
inLines Int
splitAt
where
([Text]
before, [Text]
headerArea, [Text]
_) = [Regex] -> [Regex] -> Text -> ([Text], [Text], [Text])
splitInput [Regex]
'Complete ::: [Regex]
hcPutAfter [Regex]
'Complete ::: [Regex]
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
findBlockHeader :: Text
-> Text
-> [Text]
-> Int
-> Maybe (Int, Int)
Text
startsWith 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 Maybe a
_ Maybe a
_ (Text
x : [Text]
_) 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 Maybe a
_ Maybe a
_ (Text
x : [Text]
xs) 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
+ a
1)
go (Just a
start) Maybe a
_ (Text
x : [Text]
_) a
i | Text -> Bool
isEnd Text
x = (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a
start, a
i)
go Maybe a
start Maybe a
end (Text
_ : [Text]
xs) 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
+ a
1)
go Maybe a
_ Maybe a
_ [] a
_ = Maybe (a, a)
forall a. Maybe a
Nothing
findLineHeader :: Text
-> [Text]
-> Int
-> Maybe (Int, Int)
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 Maybe b
Nothing (Text
x : [Text]
xs) 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
+ b
1)
go Maybe b
Nothing (Text
_ : [Text]
xs) 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
+ b
1)
go (Just b
start) (Text
x : [Text]
xs) 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
+ b
1)
go (Just b
start) [Text]
_ 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
- b
1)
go Maybe b
_ [] b
_ = Maybe (b, b)
forall a. Maybe a
Nothing
firstMatching :: [Regex]
-> [Text]
-> Maybe Int
firstMatching :: [Regex] -> [Text] -> Maybe Int
firstMatching [Regex]
patterns [Text]
input = [Text] -> Int -> Maybe Int
forall t. Num t => [Text] -> t -> Maybe t
go [Text]
input Int
0
where
cond :: Text -> Bool
cond Text
x = (Regex -> Bool) -> [Regex] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Regex
r -> Maybe [Text] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [Text] -> Bool) -> Maybe [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> Text -> Maybe [Text]
match Regex
r Text
x) [Regex]
patterns
go :: [Text] -> t -> Maybe t
go (Text
x : [Text]
_) t
i | Text -> Bool
cond Text
x = t -> Maybe t
forall a. a -> Maybe a
Just t
i
go (Text
_ : [Text]
xs) t
i = [Text] -> t -> Maybe t
go [Text]
xs (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
go [] t
_ = Maybe t
forall a. Maybe a
Nothing
lastMatching :: [Regex]
-> [Text]
-> Maybe Int
lastMatching :: [Regex] -> [Text] -> Maybe Int
lastMatching [Regex]
patterns [Text]
input = [Text] -> Int -> Maybe Int -> Maybe Int
forall a. Num a => [Text] -> a -> Maybe a -> Maybe a
go [Text]
input Int
0 Maybe Int
forall a. Maybe a
Nothing
where
cond :: Text -> Bool
cond Text
x = (Regex -> Bool) -> [Regex] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Regex
r -> Maybe [Text] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [Text] -> Bool) -> Maybe [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> Text -> Maybe [Text]
match Regex
r Text
x) [Regex]
patterns
go :: [Text] -> a -> Maybe a -> Maybe a
go (Text
x : [Text]
xs) a
i Maybe a
_ | 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
+ a
1) (a -> Maybe a
forall a. a -> Maybe a
Just a
i)
go (Text
_ : [Text]
xs) a
i Maybe a
pos = [Text] -> a -> Maybe a -> Maybe a
go [Text]
xs (a
i a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) Maybe a
pos
go [] a
_ Maybe a
pos = Maybe a
pos
splitInput :: [Regex]
-> [Regex]
-> Text
-> ([Text], [Text], [Text])
splitInput :: [Regex] -> [Regex] -> Text -> ([Text], [Text], [Text])
splitInput [] [] Text
input = ([], Text -> [Text]
toLines Text
input, [])
splitInput [Regex]
fstSplit [Regex]
sndSplit Text
input = ([Text]
before, [Text]
middle, [Text]
after)
where
([Text]
middle', [Text]
after ) = Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
L.splitAt Int
sndSplitAt [Text]
inLines
([Text]
before , [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 Int
0 (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([Regex] -> [Text] -> Maybe Int
lastMatching [Regex]
fstSplit [Text]
middle')
sndSplitAt :: Int
sndSplitAt = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
len ([Regex] -> [Text] -> Maybe Int
firstMatching [Regex]
sndSplit [Text]
inLines)
inLines :: [Text]
inLines = Text -> [Text]
toLines Text
input
len :: Int
len = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Text]
inLines
stripLinesEnd :: [Text] -> [Text]
stripLinesEnd :: [Text] -> [Text]
stripLinesEnd = Text -> [Text]
toLines (Text -> [Text]) -> ([Text] -> Text) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.stripEnd (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
fromLines
stripLinesStart :: [Text] -> [Text]
stripLinesStart :: [Text] -> [Text]
stripLinesStart = Text -> [Text]
toLines (Text -> [Text]) -> ([Text] -> Text) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.stripStart (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
fromLines