Copyright | (c) 2019-2021 Vaclav Svejcar |
---|---|
License | BSD-3-Clause |
Maintainer | vaclav.svejcar@gmail.com |
Stability | experimental |
Portability | POSIX |
Safe Haskell | None |
Language | Haskell2010 |
This module is the heart of Headroom as it contains functions for working with the license headers and the source code files.
Synopsis
- extractHeaderInfo :: HeaderTemplate -> SourceCode -> HeaderInfo
- extractHeaderTemplate :: CtHeadersConfig -> FileType -> TemplateType -> HeaderTemplate
- addHeader :: HeaderInfo -> Text -> SourceCode -> SourceCode
- dropHeader :: HeaderInfo -> SourceCode -> SourceCode
- replaceHeader :: HeaderInfo -> Text -> SourceCode -> SourceCode
- findHeader :: CtHeaderConfig -> SourceCode -> Maybe (Int, Int)
- findBlockHeader :: Regex -> Regex -> SourceCode -> Int -> Maybe (Int, Int)
- findLineHeader :: Regex -> SourceCode -> Int -> Maybe (Int, Int)
- splitSource :: [Regex] -> [Regex] -> SourceCode -> (SourceCode, SourceCode, SourceCode)
Header Info Extraction
:: HeaderTemplate | template info |
-> SourceCode | text used for detection |
-> HeaderInfo | resulting file info |
Extracts info about the processed file to be later used by the header detection/manipulation functions.
extractHeaderTemplate Source #
:: CtHeadersConfig | configuration for license headers |
-> FileType | type of source code files this template is for |
-> TemplateType | parsed template |
-> HeaderTemplate | resulting template info |
Constructs new HeaderTemplate
from provided data.
License header manipulation
:: HeaderInfo | additional info about the header |
-> Text | text of the new header |
-> SourceCode | source code where to add the header |
-> SourceCode | resulting source code with added header |
Adds given header at position specified by the HeaderInfo
. Does nothing
if any header is already present, use replaceHeader
if you need to
override it.
:: HeaderInfo | additional info about the header |
-> SourceCode | text of the file from which to drop the header |
-> SourceCode | resulting text with dropped header |
Drops header at position specified by the HeaderInfo
from the given
source code. Does nothing if no header is present.
:: HeaderInfo | additional info about the header |
-> Text | text of the new header |
-> SourceCode | text of the file where to replace the header |
-> SourceCode | resulting text with replaced header |
Replaces existing header at position specified by the HeaderInfo
in the
given text. Basically combines addHeader
with dropHeader
. If no header
is present, then the given one is added to the text.
Copyright Header Detection
:: CtHeaderConfig | appropriate header configuration |
-> SourceCode | text in which to detect the header |
-> Maybe (Int, Int) | header position |
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 -XTypeFamilies -XQuasiQuotes
>>>
import Headroom.Data.Regex (re)
>>>
let hc = HeaderConfig ["hs"] 0 0 0 0 [] [] (BlockComment [re|^{-|] [re|(?<!#)-}$|] Nothing)
>>>
findHeader hc $ SourceCode [(Code, "foo"), (Code, "bar"), (Comment, "{- HEADER -}")]
Just (2,2)
:: Regex | starting pattern (e.g. |
-> Regex | ending pattern (e.g. |
-> SourceCode | source code in which to detect the header |
-> Int | line number offset (adds to resulting position) |
-> Maybe (Int, Int) | header position |
Finds header in the form of multi-line comment syntax, which is delimited with starting and ending pattern.
>>>
:set -XQuasiQuotes
>>>
import Headroom.Data.Regex (re)
>>>
let sc = SourceCode [(Code, ""), (Comment, "{- HEADER -}"), (Code, ""), (Code,"")]
>>>
findBlockHeader [re|^{-|] [re|(?<!#)-}$|] sc 0
Just (1,1)
:: Regex | prefix pattern (e.g. |
-> SourceCode | source code in which to detect the header |
-> Int | line number offset (adds to resulting position) |
-> Maybe (Int, Int) | header position |
Finds header in the form of single-line comment syntax, which is delimited with the prefix pattern.
>>>
:set -XQuasiQuotes
>>>
import Headroom.Data.Regex (re)
>>>
let sc = SourceCode [(Code, ""), (Code, "a"), (Comment, "-- first"), (Comment, "-- second"), (Code, "foo")]
>>>
findLineHeader [re|^--|] sc 0
Just (2,3)
splitSource :: [Regex] -> [Regex] -> SourceCode -> (SourceCode, SourceCode, SourceCode) Source #
Splits input source code into three parts:
- all lines located before the very last occurence of one of the conditions from the first condition list
- all lines between the first and last lists
- 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 part.
>>>
:set -XQuasiQuotes
>>>
import Headroom.Data.Regex (re)
>>>
let ls = [(Code, "text"), (Code, "->"), (Code, "RESULT"), (Code, "<-"), (Code, "foo")]
>>>
splitSource [[re|->|]] [[re|<-|]] $ SourceCode ls
(SourceCode [(Code,"text"),(Code,"->")],SourceCode [(Code,"RESULT")],SourceCode [(Code,"<-"),(Code,"foo")])
>>>
let ls = [(Code, "text"), (Code, "->"), (Code, "RESULT"), (Code, "<-"), (Code, "foo")]
>>>
splitSource [] [[re|<-|]] $ SourceCode ls
(SourceCode [],SourceCode [(Code,"text"),(Code,"->"),(Code,"RESULT")],SourceCode [(Code,"<-"),(Code,"foo")])
>>>
splitSource [] [] $ SourceCode [(Code,"foo"), (Code,"bar")]
(SourceCode [],SourceCode [(Code,"foo"),(Code,"bar")],SourceCode [])