{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Headroom.FileSupport
(
extractFileInfo
, addHeader
, dropHeader
, replaceHeader
, findHeader
, findBlockHeader
, findLineHeader
, firstMatching
, lastMatching
, splitInput
)
where
import Headroom.Regex ( compile'
, joinPatterns
, match'
)
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 )
extractFileInfo :: FileType
-> HeaderConfig
-> Text
-> FileInfo
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 { .. }
addHeader :: FileInfo
-> Text
-> Text
-> Text
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]
dropHeader :: FileInfo
-> Text
-> Text
(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)
replaceHeader :: FileInfo
-> Text
-> Text
-> Text
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
findHeader :: HeaderConfig
-> Text
-> Maybe (Int, Int)
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
findBlockHeader :: Text
-> Text
-> [Text]
-> Int
-> Maybe (Int, Int)
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
findLineHeader :: Text
-> [Text]
-> Int
-> Maybe (Int, Int)
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
firstMatching :: Regex
-> [Text]
-> Maybe Int
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 [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
regex 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
lastMatching :: Regex
-> [Text]
-> Maybe Int
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 [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
regex 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
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 ps :: [Text]
ps i :: t
i = Text -> Regex
compile' (Text -> Regex) -> Maybe Text -> Maybe Regex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe Text
joinPatterns [Text]
ps 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)
extractVariables :: FileType -> HeaderConfig -> Text -> HashMap Text Text
_ _ _ = 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)
fiHeaderPosL :: Lens' FileInfo (Maybe (Int, Int))
= (FileInfo -> Maybe (Int, Int))
-> (FileInfo -> Maybe (Int, Int) -> FileInfo)
-> Lens' FileInfo (Maybe (Int, Int))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FileInfo -> Maybe (Int, Int)
fiHeaderPos (\x :: FileInfo
x y :: Maybe (Int, Int)
y -> FileInfo
x { fiHeaderPos :: Maybe (Int, Int)
fiHeaderPos = Maybe (Int, Int)
y })