{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TemplateHaskell   #-}

{-|
Module      : Headroom.FileSupport
Description : License header manipulation
Copyright   : (c) 2019-2020 Vaclav Svejcar
License     : BSD-3-Clause
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/.
-}

module Headroom.FileSupport
  ( -- * File info extraction
    extractFileInfo
    -- * License header manipulation
  , addHeader
  , dropHeader
  , replaceHeader
    -- * License header detection
  , 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


suffixLensesFor ["fiHeaderPos"] ''FileInfo


-- | Extracts info about the processed file to be later used by the header
-- detection/manipulation functions.
extractFileInfo :: FileType
                -- ^ type of the detected file
                -> CtHeaderConfig
                -- ^ license header configuration
                -> Maybe TemplateMeta
                -- ^ metadata extracted from /template/
                -> Text
                -- ^ text used for detection
                -> FileInfo
                -- ^ resulting file info
extractFileInfo :: FileType
-> CtHeaderConfig -> Maybe TemplateMeta -> Text -> FileInfo
extractFileInfo 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
.. }


-- | 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 {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]


-- | 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 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)


-- | 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 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'.
--
-- >>> :set -XFlexibleContexts
-- >>> :set -XTypeFamilies
-- >>> let hc = HeaderConfig ["hs"] 0 0 [] [] (BlockComment "{-" "-}")
-- >>> findHeader hc "foo\nbar\n{- HEADER -}\nbaz"
-- Just (2,2)
findHeader :: CtHeaderConfig
           -- ^ appropriate header configuration
           -> Text
           -- ^ text in which to detect the header
           -> Maybe (Int, Int)
           -- ^ header position @(startLine, endLine)@
findHeader :: CtHeaderConfig -> Text -> Maybe (Int, Int)
findHeader 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


-- | 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 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


-- | 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 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


-- | Finds very first line that matches the given /regex/ (numbered from zero).
--
-- >>> import Headroom.Data.Regex (re)
-- >>> :set -XQuasiQuotes
-- >>> firstMatching [[re|^foo|]] ["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]
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


-- | Finds very last line that matches the given /regex/ (numbered from zero).
--
-- >>> import Headroom.Data.Regex (re)
-- >>> :set -XQuasiQuotes
-- >>> lastMatching [[re|^foo|]] ["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]
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


-- | 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.
--
-- >>> import Headroom.Data.Regex (re)
-- >>> :set -XQuasiQuotes
--
-- >>> splitInput [[re|->|]] [[re|<-|]] "text\n->\nRESULT\n<-\nfoo"
-- (["text","->"],["RESULT"],["<-","foo"])
--
-- >>> splitInput [] [[re|<-|]] "text\n->\nRESULT\n<-\nfoo"
-- ([],["text","->","RESULT"],["<-","foo"])
--
-- >>> splitInput [] [] "one\ntwo"
-- ([],["one","two"],[])
splitInput :: [Regex]
           -- ^ patterns for first split
           -> [Regex]
           -- ^ patterns for second split
           -> Text
           -- ^ text to split
           -> ([Text], [Text], [Text])
           -- ^ result lines as @([before1stSplit], [middle], [after2ndSplit])@
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