headroom 0.3.2.0 → 0.4.0.0

raw patch · 119 files changed

+5550/−2501 lines, 119 filesdep +generic-datadep +mtldep +string-interpolatedep −data-default-classPVP ok

version bump matches the API change (PVP)

Dependencies added: generic-data, mtl, string-interpolate

Dependencies removed: data-default-class

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• LICENSE +1/−1
• README.md +22/−3
• app/Main.hs +15/−15
• embedded/config-file.yaml +7/−0
• embedded/default-config.yaml +90/−47
• headroom.cabal +51/−16
• src/Headroom/Command.hs +39/−17
• src/Headroom/Command/Gen.hs +46/−22
• src/Headroom/Command/Init.hs +95/−73
• src/Headroom/Command/Readers.hs +21/−23
• src/Headroom/Command/Run.hs +109/−134
• src/Headroom/Command/Types.hs +8/−8
• src/Headroom/Command/Utils.hs +1/−1
• src/Headroom/Configuration.hs +48/−40
• src/Headroom/Configuration/Compat.hs +139/−0
• src/Headroom/Configuration/Enrich.hs +111/−0
• src/Headroom/Configuration/Types.hs +129/−150
• src/Headroom/Data/Coerce.hs +43/−0
• src/Headroom/Data/EnumExtra.hs +5/−4
• src/Headroom/Data/Has.hs +8/−1
• src/Headroom/Data/Lens.hs +9/−9
• src/Headroom/Data/Regex.hs +63/−29
• src/Headroom/Data/Text.hs +165/−0
• src/Headroom/Data/TextExtra.hs +0/−112
• src/Headroom/Embedded.hs +7/−7
• src/Headroom/Embedded/TH.hs +12/−12
• src/Headroom/Ext.hs +0/−72
• src/Headroom/Ext/Haskell.hs +0/−111
• src/Headroom/Ext/Haskell/Haddock.hs +0/−286
• src/Headroom/Ext/Java.hs +0/−68
• src/Headroom/Ext/PureScript.hs +0/−47
• src/Headroom/FileSupport.hs +70/−274
• src/Headroom/FileSupport/C.hs +44/−0
• src/Headroom/FileSupport/CPP.hs +44/−0
• src/Headroom/FileSupport/CSS.hs +44/−0
• src/Headroom/FileSupport/HTML.hs +44/−0
• src/Headroom/FileSupport/Haskell.hs +131/−0
• src/Headroom/FileSupport/Haskell/Haddock.hs +278/−0
• src/Headroom/FileSupport/JS.hs +44/−0
• src/Headroom/FileSupport/Java.hs +85/−0
• src/Headroom/FileSupport/PureScript.hs +88/−0
• src/Headroom/FileSupport/Rust.hs +44/−0
• src/Headroom/FileSupport/Scala.hs +44/−0
• src/Headroom/FileSupport/Shell.hs +44/−0
• src/Headroom/FileSupport/TemplateData.hs +48/−0
• src/Headroom/FileSupport/Types.hs +72/−18
• src/Headroom/FileSystem.hs +20/−20
• src/Headroom/FileType.hs +9/−9
• src/Headroom/FileType/Types.hs +2/−2
• src/Headroom/Header.hs +309/−0
• src/Headroom/Header/Sanitize.hs +128/−0
• src/Headroom/Header/Types.hs +56/−0
• src/Headroom/HeaderFn.hs +20/−21
• src/Headroom/HeaderFn/Types.hs +1/−1
• src/Headroom/HeaderFn/UpdateCopyright.hs +12/−12
• src/Headroom/Meta.hs +51/−12
• src/Headroom/Meta/Version.hs +139/−0
• src/Headroom/Serialization.hs +8/−8
• src/Headroom/SourceCode.hs +157/−0
• src/Headroom/Template.hs +38/−24
• src/Headroom/Template/Mustache.hs +20/−17
• src/Headroom/Types.hs +2/−21
• src/Headroom/UI.hs +1/−1
• src/Headroom/UI/Progress.hs +4/−4
• src/Headroom/Variables.hs +16/−12
• src/Headroom/Variables/Types.hs +1/−1
• test-data/code-samples/c/sample1.c +4/−0
• test-data/code-samples/cpp/sample1.cpp +5/−0
• test-data/code-samples/css/sample1.css +4/−0
• test-data/code-samples/haskell/full.hs +22/−0
• test-data/code-samples/haskell/sample3.hs +23/−0
• test-data/code-samples/html/sample1.html +3/−0
• test-data/code-samples/java/sample1.java +1/−0
• test-data/code-samples/js/sample1.js +1/−0
• test-data/code-samples/purescript/full.purs +6/−0
• test-data/code-samples/rust/sample1.rs +1/−0
• test-data/code-samples/scala/sample1.scala +1/−0
• test/Headroom/Command/InitSpec.hs +10/−10
• test/Headroom/Command/ReadersSpec.hs +12/−15
• test/Headroom/Command/RunSpec.hs +29/−39
• test/Headroom/Configuration/CompatSpec.hs +50/−0
• test/Headroom/Configuration/EnrichSpec.hs +48/−0
• test/Headroom/ConfigurationSpec.hs +1/−1
• test/Headroom/Data/CoerceSpec.hs +24/−0
• test/Headroom/Data/RegexSpec.hs +9/−0
• test/Headroom/Data/TextExtraSpec.hs +0/−57
• test/Headroom/Data/TextSpec.hs +96/−0
• test/Headroom/Ext/Haskell/HaddockSpec.hs +0/−82
• test/Headroom/Ext/HaskellSpec.hs +0/−58
• test/Headroom/Ext/JavaSpec.hs +0/−36
• test/Headroom/Ext/PureScriptSpec.hs +0/−30
• test/Headroom/ExtSpec.hs +0/−58
• test/Headroom/FileSupport/CPPSpec.hs +36/−0
• test/Headroom/FileSupport/CSSSpec.hs +34/−0
• test/Headroom/FileSupport/CSpec.hs +36/−0
• test/Headroom/FileSupport/HTMLSpec.hs +34/−0
• test/Headroom/FileSupport/Haskell/HaddockSpec.hs +84/−0
• test/Headroom/FileSupport/HaskellSpec.hs +124/−0
• test/Headroom/FileSupport/JSSpec.hs +36/−0
• test/Headroom/FileSupport/JavaSpec.hs +81/−0
• test/Headroom/FileSupport/PureScriptSpec.hs +81/−0
• test/Headroom/FileSupport/RustSpec.hs +36/−0
• test/Headroom/FileSupport/ScalaSpec.hs +36/−0
• test/Headroom/FileSupport/ShellSpec.hs +33/−0
• test/Headroom/FileSupportSpec.hs +243/−320
• test/Headroom/FileSystemSpec.hs +5/−4
• test/Headroom/FileTypeSpec.hs +6/−6
• test/Headroom/Header/SanitizeSpec.hs +129/−0
• test/Headroom/HeaderFn/TypesSpec.hs +2/−2
• test/Headroom/HeaderFn/UpdateCopyrightSpec.hs +4/−4
• test/Headroom/HeaderFnSpec.hs +8/−8
• test/Headroom/HeaderSpec.hs +624/−0
• test/Headroom/Meta/VersionSpec.hs +44/−0
• test/Headroom/SerializationSpec.hs +1/−1
• test/Headroom/SourceCodeSpec.hs +106/−0
• test/Headroom/Template/MustacheSpec.hs +1/−1
• test/Headroom/TypesSpec.hs +1/−1
• test/Headroom/VariablesSpec.hs +4/−3

@@ -1,6 +1,15 @@ # Changelog All notable changes to this project will be documented in this file. +## 0.4.0.0 (in development)+- [#57] FIXED: put-before/put-after in commented code breaks header detection+- [#58] BREAKING CHANGE: Extend configuration for defining header margins+- [#59] Check compatibility of loaded YAML configuration+- [#61] BREAKING CHANGE: Use regular expressions to specify headers start/end+- [#62] Sanitize block comment headers with line prefixes+- [#64] Add command line option for displaying version+- Bump _LTS Haskell_ to `17.5`+ ## 0.3.2.0 (released 2020-11-26) - [#56] Move CI from Travis to GitHub Actions - Minor improvements & bugfixes

@@ -1,6 +1,6 @@ BSD 3-Clause License -Copyright (c) 2019-2020, Vaclav Svejcar+Copyright (c) 2019-2021, Vaclav Svejcar All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -1,6 +1,6 @@ Would you like to have nice, up-to-date license/copyright headers in your source code files but hate to manage them manually? Then __Headroom__ is the right tool for you. Define your license header as [Mustache][web:mustache] template, put any template variables into [YAML][wiki:yaml] configuarion file, and you're ready to go! -__Headroom__ also offers much more than just [adding, replacing or dropping][doc:running-headroom] license headers. It can also [update years in copyrights][doc:post-processing] for you, provides [extended functionality][doc:extended-functionality] for some source code file types, and much more!+__Headroom__ also offers much more than just [adding, replacing or dropping][doc:running-headroom] license headers. It can also [update years in copyrights][doc:post-processing] for you, provides [content-aware templates][doc:templates] for some source code file types, and much more!  [![asciicast](https://asciinema.org/a/4Pfxdss0V4msFjjt2z6mgCZCp.svg)](https://asciinema.org/a/4Pfxdss0V4msFjjt2z6mgCZCp) @@ -9,9 +9,15 @@ - __Powerful Customization__ - Default [configuration][doc:configuration] should cover most use-cases, but if you need to put empty lines before/after generated header, use different comment style of headers, you can customize the configuration to match exactly your needs. - __Built-in OSS License Headers__ - If you want to use license header for one of the popular OSS licenses, then __Headroom__ can [generate them for you][doc:running-headroom#gen-command] - no need to search for them on web. - __Automatic Initialization for OSS Projects__ - Setting up external tools like _Headroom_ for your project can be boring. Fortunately, _Headroom_ can [initialize itself][doc:running-headroom#init-command] for your project, by generating configuration file and template files.-- __Extended Functionality__ - _Headroom_ supports [extended functionality][doc:extended-functionality] for selected types of source code files, such as extracting extra data from processed source code files.+- __Content-aware Templates__ - for selected file types, _Headroom_ [exposes additional info][doc:templates] about processed file using template variables, so you can use info like _Java_ package name in your templates. - __Copyright Year Updater__ - _Headroom_ is good not only for basic license header management, but also for further processing of generated headers. Do you need to [update years in your copyrights][doc:post-processing]? No problem! +## Installation+You can get _Headroom_ via one of the following options:+1. download pre-built binary for _GNU/Linux_ or _macOS_ (x64) from [releases page][meta:releases]+1. install using [Homebrew][web:homebrew]: `brew install norcane/tools/headroom`+1. build from source code - see [project microsite][web:headroom] for more details+ ## Adopters Here is the list of projects using _Headroom_. If you're using _Headroom_ and aren't on the list, feel free to [submit new issue][meta:new-issue] or [pull request][meta:pulls]. @@ -23,16 +29,29 @@ * for end-user documentation, [official project microsite][web:headroom] * for _Haskell API_ documentation, see [Headroom on Hackage][hackage:headroom] +### Running microsite locally+If you need to show microsite documetation for unreleased version of _Headroom_ (e.g. for `master` branch), you can run it locally using [MkDocs][web:mkdocs] tool:++```+$ cd doc/microsite/+$ mkdcs serve+```++Documentation is then available on http://127.0.0.1:8000.+ [i25]: https://github.com/vaclavsvejcar/headroom/issues/25 [hackage:headroom]: https://hackage.haskell.org/package/headroom [meta:new-issue]: https://github.com/vaclavsvejcar/headroom/issues/new [meta:pulls]: https://github.com/vaclavsvejcar/headroom/pulls+[meta:releases]: https://github.com/vaclavsvejcar/headroom/releases [web:headroom]: https://doc.norcane.com/headroom/latest/+[web:homebrew]: https://brew.sh [doc:configuration]: https://doc.norcane.com/headroom/latest/documentation/configuration/-[doc:extended-functionality]: https://doc.norcane.com/headroom/latest/documentation/extended-functionality/+[doc:templates]: https://doc.norcane.com/headroom/latest/documentation/templates/ [doc:post-processing]: https://doc.norcane.com/headroom/latest/documentation/post-processing/ [doc:running-headroom]: https://doc.norcane.com/headroom/latest/documentation/running-headroom/ [doc:running-headroom#gen-command]: https://doc.norcane.com/headroom/latest/documentation/running-headroom/#gen-command [doc:running-headroom#init-command]: https://doc.norcane.com/headroom/latest/documentation/running-headroom/#init-command+[web:mkdocs]: https://www.mkdocs.org [web:mustache]: https://mustache.github.io [wiki:yaml]: https://en.wikipedia.org/wiki/YAML

@@ -6,7 +6,7 @@ {-| Module      : Main Description : Main application launcher-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -18,21 +18,21 @@  module Main where -import           Headroom.Command               ( commandParser )-import           Headroom.Command.Gen           ( commandGen-                                                , parseGenMode-                                                )-import           Headroom.Command.Init          ( commandInit )-import           Headroom.Command.Run           ( commandRun )-import           Headroom.Command.Types         ( Command(..)-                                                , CommandGenOptions(..)-                                                , CommandInitOptions(..)-                                                , CommandRunOptions(..)-                                                )-import           Headroom.Types                 ( HeadroomError(..) )-import           Options.Applicative            ( execParser )+import           Headroom.Command                    ( commandParser )+import           Headroom.Command.Gen                ( commandGen+                                                     , parseGenMode+                                                     )+import           Headroom.Command.Init               ( commandInit )+import           Headroom.Command.Run                ( commandRun )+import           Headroom.Command.Types              ( Command(..)+                                                     , CommandGenOptions(..)+                                                     , CommandInitOptions(..)+                                                     , CommandRunOptions(..)+                                                     )+import           Headroom.Types                      ( HeadroomError(..) )+import           Options.Applicative                 ( execParser ) import           RIO-import           System.IO                      ( hPutStrLn )+import           System.IO                           ( hPutStrLn )   main :: IO ()

@@ -1,6 +1,13 @@ ## This is the configuration file for Headroom. ## See https://github.com/vaclavsvejcar/headroom for more details. +## Defines with which version of Headroom this configuration is compatible.+## Headroom uses this field to detect whether your configuration doesn't need+## any manual migration steps in case that it's older than your current Headroom+## version. You don't need to touch this field unless explicitly stated in+## migration guide during upgrading Headroom to new version.+version: ""+ ## Defines the behaviour how to handle license headers, possible options are: ## ##   - add     = (default) adds license header to files with no existing header

@@ -1,6 +1,13 @@ ## This is the configuration file for Headroom. ## See https://github.com/vaclavsvejcar/headroom for more details. +## Defines with which version of Headroom this configuration is compatible.+## Headroom uses this field to detect whether your configuration doesn't need+## any manual migration steps in case that it's older than your current Headroom+## version. You don't need to touch this field unless explicitly stated in+## migration guide during upgrading Headroom to new version.+# version: ""+ ## Defines the behaviour how to handle license headers, possible options are: ## ##   - add     = (default) adds license header to files with no existing header@@ -53,10 +60,18 @@ ## configuration keys are: ## ##  - file-extensions    = List of file extensions valid for given file type.-##  - margin-after       = Number of blank lines to put AFTER the rendered-##                         license header text.-##  - margin-before      = Number of blank lines to put BEFORE the rendered-##                         license header text.+##  - margin-top-code    = Margin (in no. of empty lines) between generated+##                         header and code above it, but only IF header is NOT+##                         the first thing in file.+##  - margin-top-file    = Margin (in no. of empty lines) between generated+##                         header the very top of the file, but only IF header+##                         IS the first thing in file.+##  - margin-bottom-code = Margin (in no. of empty lines) between generated+##                         header and code below it, but only IF header is NOT+##                         the last thing in file.+##  - margin-bottom-file = Margin (in no. of empty lines) between generated+##                         header the very end of the file, but only IF header+##                         IS the last thing in file. ##  - put-after          = List of regexp patterns, where the license header is ##                         placed AFTER the very last line matching one of the ##                         given regular expressions. If no match found, header@@ -69,131 +84,156 @@ ##                         multi-line (block) comment syntax (such as '/* */'). ##                         Has two mandatory fields: ##      starts-with        = Defines how the license header comment starts.+##                           Expects valid regular expression. ##      ends-with          = Defines how the license header comment ends.+##                           Expects valid regular expression. ##                         NOTE: cannot be used together with 'line-comment'. ##  - line-comment       = Defines that the license header is rendered using the ##                         single-line comment syntax (such as '//'). ##                         Has one mandatory field: ##      prefixed-by        = Defines how the license header comment starts.+##                           Expects valid regular expression. license-headers:   ## C configuration   c:     file-extensions: ["c"]-    margin-after: 0-    margin-before: 0+    margin-top-code: 0+    margin-top-file: 0+    margin-bottom-code: 0+    margin-bottom-file: 0     put-after: []     put-before: ["^#include"]     block-comment:-      starts-with: "/*"-      ends-with: "*/"+      starts-with: ^\/\*+      ends-with: \*\/$    ## C++ configuration   cpp:     file-extensions: ["cpp"]-    margin-after: 0-    margin-before: 0+    margin-top-code: 0+    margin-top-file: 0+    margin-bottom-code: 0+    margin-bottom-file: 0     put-after: []     put-before: ["^#include"]     block-comment:-      starts-with: "/*"-      ends-with: "*/"+      starts-with: ^\/\*+      ends-with: \*\/$    ## CSS configuration   css:     file-extensions: ["css"]-    margin-after: 0-    margin-before: 0+    margin-top-code: 0+    margin-top-file: 0+    margin-bottom-code: 0+    margin-bottom-file: 0     put-after: []     put-before: ['([^\r\n,{}]+)(,(?=[^}]*{)|\s*{)']     block-comment:-      starts-with: "/*"-      ends-with: "*/"+      starts-with: ^\/\*+      ends-with: \*\/$    ## Haskell configuration   haskell:     file-extensions: ["hs"]-    margin-after: 0-    margin-before: 0+    margin-top-code: 0+    margin-top-file: 0+    margin-bottom-code: 0+    margin-bottom-file: 0     put-after: []     put-before: ["^module"]     block-comment:-      starts-with: "{-|"-      ends-with: "-}"+      starts-with: ^{-\|+      ends-with: (?<!#)-}$    ## HTML configuration   html:     file-extensions: ["htm", "html"]-    margin-after: 0-    margin-before: 0+    margin-top-code: 0+    margin-top-file: 0+    margin-bottom-code: 0+    margin-bottom-file: 0     put-after: []     put-before: ["^(<!DOCTYPE|<[a-zA-Z])"]     block-comment:-      starts-with: "<!--"-      ends-with: "-->"+      starts-with: ^<!--+      ends-with: -->$    ## Java configuration   java:     file-extensions: ["java"]-    margin-after: 0-    margin-before: 0+    margin-top-code: 0+    margin-top-file: 0+    margin-bottom-code: 0+    margin-bottom-file: 0     put-after: []     put-before: ["^package"]     block-comment:-      starts-with: "/*"-      ends-with: "*/"+      starts-with: ^\/\*+      ends-with: \*\/$    ## JS configuration   js:     file-extensions: ["js"]-    margin-after: 0-    margin-before: 0+    margin-top-code: 0+    margin-top-file: 0+    margin-bottom-code: 0+    margin-bottom-file: 0     put-after: []     put-before: []     block-comment:-      starts-with: "/*"-      ends-with: "*/"+      starts-with: ^\/\*+      ends-with: \*\/$    ## PureScript configuration   purescript:     file-extensions: ["purs"]-    margin-after: 0-    margin-before: 0+    margin-top-code: 0+    margin-top-file: 0+    margin-bottom-code: 0+    margin-bottom-file: 0     put-after: []     put-before: ["^module"]     line-comment:-      prefixed-by: "--"+      prefixed-by: ^--    ## Rust configuration   rust:     file-extensions: ["rs"]-    margin-after: 0-    margin-before: 0+    margin-top-code: 0+    margin-top-file: 0+    margin-bottom-code: 0+    margin-bottom-file: 0     put-after: []     put-before: ["^use"]     block-comment:-      starts-with: "/*"-      ends-with: "*/"+      starts-with: ^\/\*+      ends-with: \*\/$    ## Scala configuration   scala:     file-extensions: ["scala"]-    margin-after: 0-    margin-before: 0+    margin-top-code: 0+    margin-top-file: 0+    margin-bottom-code: 0+    margin-bottom-file: 0     put-after: []     put-before: ["^package"]     block-comment:-      starts-with: "/*"-      ends-with: "*/"+      starts-with: ^\/\*+      ends-with: \*\/$    ## Shell configuration   shell:     file-extensions: ["sh"]-    margin-after: 1-    margin-before: 1+    margin-top-code: 1+    margin-top-file: 0+    margin-bottom-code: 1+    margin-bottom-file: 0     put-after: ["^#!"]     put-before: []     line-comment:-      prefixed-by: "#"+      prefixed-by: ^#  ## Configuration for post-processing license header functions. These functions ## allows to modify/enhance already rendered license headers, e.g. update years@@ -208,5 +248,8 @@   update-copyright:     enabled: false     config:-      ## If used, updates copyright statements of selected authors only.+      ## If used, updates copyright statements of selected authors only. You can+      ## not only use list of concrete names, but also any variable defined in+      ## 'variables' section.       # selected-authors-only: ["John Smith"]+      # selected-authors-only: ["{{ author }}"]

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 3ad29fd26d8cdd22903560fba5cdce69121c53c5065bb10a4a63978bc1d139a7+-- hash: 4c5eb45fc45946807c2cbd5814cbf57038cb7e09f142e29767fede026dbdd86f  name:           headroom-version:        0.3.2.0+version:        0.4.0.0 synopsis:       License Header Manager description:    Would you like to have nice, up-to-date license/copyright headers in your source code files but hate to manage them by hand? Then Headroom is the right tool for you! Now you can define your license header as Mustache template, put all the variables (such as author's name, year, etc.) into the YAML config file and Headroom will take care to add such license headers to all your source code files. category:       Utils@@ -15,7 +15,7 @@ bug-reports:    https://github.com/vaclavsvejcar/headroom/issues author:         Vaclav Svejcar maintainer:     vaclav.svejcar@gmail.com-copyright:      Copyright (c) 2019-2020 Vaclav Svejcar+copyright:      Copyright (c) 2019-2021 Vaclav Svejcar license:        BSD-3-Clause license-file:   LICENSE build-type:     Simple@@ -102,6 +102,7 @@     test-data/code-samples/haskell/header.hs     test-data/code-samples/haskell/sample1.hs     test-data/code-samples/haskell/sample2.hs+    test-data/code-samples/haskell/sample3.hs     test-data/code-samples/html/sample1.html     test-data/code-samples/html/sample2.html     test-data/code-samples/java/sample1.java@@ -134,29 +135,45 @@       Headroom.Command.Types       Headroom.Command.Utils       Headroom.Configuration+      Headroom.Configuration.Compat+      Headroom.Configuration.Enrich       Headroom.Configuration.Types+      Headroom.Data.Coerce       Headroom.Data.EnumExtra       Headroom.Data.Has       Headroom.Data.Lens       Headroom.Data.Regex-      Headroom.Data.TextExtra+      Headroom.Data.Text       Headroom.Embedded       Headroom.Embedded.TH-      Headroom.Ext-      Headroom.Ext.Haskell-      Headroom.Ext.Haskell.Haddock-      Headroom.Ext.Java-      Headroom.Ext.PureScript       Headroom.FileSupport+      Headroom.FileSupport.C+      Headroom.FileSupport.CPP+      Headroom.FileSupport.CSS+      Headroom.FileSupport.Haskell+      Headroom.FileSupport.Haskell.Haddock+      Headroom.FileSupport.HTML+      Headroom.FileSupport.Java+      Headroom.FileSupport.JS+      Headroom.FileSupport.PureScript+      Headroom.FileSupport.Rust+      Headroom.FileSupport.Scala+      Headroom.FileSupport.Shell+      Headroom.FileSupport.TemplateData       Headroom.FileSupport.Types       Headroom.FileSystem       Headroom.FileType       Headroom.FileType.Types+      Headroom.Header+      Headroom.Header.Sanitize+      Headroom.Header.Types       Headroom.HeaderFn       Headroom.HeaderFn.Types       Headroom.HeaderFn.UpdateCopyright       Headroom.Meta+      Headroom.Meta.Version       Headroom.Serialization+      Headroom.SourceCode       Headroom.Template       Headroom.Template.Mustache       Headroom.Types@@ -174,16 +191,18 @@   build-depends:       aeson     , base >=4.7 && <5-    , data-default-class     , either     , file-embed+    , generic-data     , microlens     , microlens-th+    , mtl     , mustache     , optparse-applicative     , pcre-heavy     , pcre-light     , rio+    , string-interpolate     , template-haskell     , time     , yaml@@ -225,22 +244,36 @@       Headroom.Command.InitSpec       Headroom.Command.ReadersSpec       Headroom.Command.RunSpec+      Headroom.Configuration.CompatSpec+      Headroom.Configuration.EnrichSpec       Headroom.ConfigurationSpec+      Headroom.Data.CoerceSpec       Headroom.Data.EnumExtraSpec       Headroom.Data.RegexSpec-      Headroom.Data.TextExtraSpec-      Headroom.Ext.Haskell.HaddockSpec-      Headroom.Ext.HaskellSpec-      Headroom.Ext.JavaSpec-      Headroom.Ext.PureScriptSpec-      Headroom.ExtSpec+      Headroom.Data.TextSpec+      Headroom.FileSupport.CPPSpec+      Headroom.FileSupport.CSpec+      Headroom.FileSupport.CSSSpec+      Headroom.FileSupport.Haskell.HaddockSpec+      Headroom.FileSupport.HaskellSpec+      Headroom.FileSupport.HTMLSpec+      Headroom.FileSupport.JavaSpec+      Headroom.FileSupport.JSSpec+      Headroom.FileSupport.PureScriptSpec+      Headroom.FileSupport.RustSpec+      Headroom.FileSupport.ScalaSpec+      Headroom.FileSupport.ShellSpec       Headroom.FileSupportSpec       Headroom.FileSystemSpec       Headroom.FileTypeSpec+      Headroom.Header.SanitizeSpec       Headroom.HeaderFn.TypesSpec       Headroom.HeaderFn.UpdateCopyrightSpec       Headroom.HeaderFnSpec+      Headroom.HeaderSpec+      Headroom.Meta.VersionSpec       Headroom.SerializationSpec+      Headroom.SourceCodeSpec       Headroom.Template.MustacheSpec       Headroom.TypesSpec       Headroom.UI.ProgressSpec@@ -257,8 +290,10 @@     , base >=4.7 && <5     , headroom     , hspec+    , mtl     , optparse-applicative     , pcre-light     , rio+    , string-interpolate     , time   default-language: Haskell2010

@@ -5,7 +5,7 @@ {-| Module      : Headroom.Command Description : Support for parsing command line arguments-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -20,31 +20,50 @@   ) where -import           Headroom.Command.Readers       ( licenseReader-                                                , licenseTypeReader-                                                , regexReader-                                                )-import           Headroom.Command.Types         ( Command(..) )-import           Headroom.Configuration.Types   ( LicenseType-                                                , RunMode(..)-                                                , TemplateSource(..)-                                                )-import           Headroom.Data.EnumExtra        ( EnumExtra(..) )-import           Headroom.Meta                  ( productDesc-                                                , productInfo-                                                )+import           Headroom.Command.Readers            ( licenseReader+                                                     , licenseTypeReader+                                                     , regexReader+                                                     )+import           Headroom.Command.Types              ( Command(..) )+import           Headroom.Configuration.Types        ( LicenseType+                                                     , RunMode(..)+                                                     , TemplateSource(..)+                                                     )+import           Headroom.Data.EnumExtra             ( EnumExtra(..) )+import           Headroom.Meta                       ( buildVersion+                                                     , productDesc+                                                     , productInfo+                                                     )+import           Headroom.Meta.Version               ( printVersion ) import           Options.Applicative import           RIO-import qualified RIO.Text                      as T+import qualified RIO.Text                           as T  +------------------------------  PUBLIC FUNCTIONS  ------------------------------+ -- | Parses command line arguments. commandParser :: ParserInfo Command commandParser = info-  (commands <**> helper)+  (helper <*> versionP <*> commandP)   (fullDesc <> progDesc (T.unpack productDesc) <> header (T.unpack productInfo))+++------------------------------  PRIVATE FUNCTIONS  -----------------------------++versionP :: Parser (a -> a)+versionP = versionInfoP <*> versionNumP  where-  commands   = subparser (runCommand <> genCommand <> initCommand)+  versionInfoP = infoOption (T.unpack productInfo)+                            (long "version" <> help "show version info")+  versionNumP = infoOption+    (T.unpack . printVersion $ buildVersion)+    (long "numeric-version" <> help "show only version number")+++commandP :: Parser Command+commandP = subparser (runCommand <> genCommand <> initCommand)+ where   runCommand = command     "run"     (info (runOptions <**> helper)@@ -61,6 +80,7 @@           (progDesc "initialize current project for Headroom")     ) + runOptions :: Parser Command runOptions =   Run@@ -125,6 +145,7 @@     <*> switch (long "debug" <> help "produce more verbose output")     <*> switch (long "dry-run" <> help "execute dry run (no changes to files)") + genOptions :: Parser Command genOptions =   Gen@@ -141,6 +162,7 @@             <> help "generate template for license and file type"             )           )+  initOptions :: Parser Command initOptions =

@@ -2,12 +2,13 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude     #-} {-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE QuasiQuotes           #-} {-# LANGUAGE TemplateHaskell       #-}  {-| Module      : Headroom.Command.Gen Description : Handler for the @gen@ command.-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -25,23 +26,33 @@ where  -import           Headroom.Command.Types         ( Command(..)-                                                , CommandGenOptions(..)-                                                )-import           Headroom.Command.Utils         ( bootstrap )-import           Headroom.Configuration.Types   ( GenMode(..) )-import           Headroom.Data.Lens             ( suffixLensesFor )-import           Headroom.Embedded              ( configFileStub-                                                , licenseTemplate-                                                )-import           Headroom.Types                 ( fromHeadroomError-                                                , toHeadroomError-                                                )-import           Prelude                        ( putStrLn )+import           Data.String.Interpolate             ( iii )+import           Headroom.Command.Types              ( Command(..)+                                                     , CommandGenOptions(..)+                                                     )+import           Headroom.Command.Utils              ( bootstrap )+import           Headroom.Configuration.Enrich       ( Enrich(..)+                                                     , replaceEmptyValue+                                                     , withText+                                                     )+import           Headroom.Configuration.Types        ( GenMode(..) )+import           Headroom.Data.Lens                  ( suffixLensesFor )+import           Headroom.Embedded                   ( configFileStub+                                                     , licenseTemplate+                                                     )+import           Headroom.Meta                       ( buildVersion )+import           Headroom.Meta.Version               ( printVersion )+import           Headroom.Types                      ( fromHeadroomError+                                                     , toHeadroomError+                                                     )+import           Prelude                             ( putStrLn ) import           RIO-import qualified RIO.Text                      as T+import qualified RIO.Text                           as T  ++---------------------------------  DATA TYPES  ---------------------------------+ data Env = Env   { envLogFunc    :: !LogFunc   -- ^ logging function@@ -51,12 +62,17 @@  suffixLensesFor ["envLogFunc"] ''Env + instance HasLogFunc Env where   logFuncL = envLogFuncL + env' :: CommandGenOptions -> LogFunc -> IO Env env' opts logFunc = pure $ Env { envLogFunc = logFunc, envGenOptions = opts } ++------------------------------  PUBLIC FUNCTIONS  ------------------------------+ -- | Parses 'GenMode' from combination of options from given 'Command'. parseGenMode :: MonadThrow m              => Command@@ -68,6 +84,7 @@   Gen False (Just license) -> pure $ GenLicense license   _                        -> throwM NoGenModeSelected + -- | Handler for /Generator/ command. commandGen :: CommandGenOptions            -- ^ /Generator/ command options@@ -77,11 +94,17 @@   GenConfigFile             -> liftIO printConfigFile   GenLicense (lType, fType) -> liftIO . putStrLn $ licenseTemplate lType fType ++------------------------------  PRIVATE FUNCTIONS  -----------------------------+ printConfigFile :: IO ()-printConfigFile = putStrLn configFileStub+printConfigFile = putStrLn . T.unpack $ enrich modify configFileStub+ where+  modify = replaceEmptyValue "version" $ withText ver+  ver    = printVersion buildVersion  ----------------------------------  Error Types  --------------------------------+---------------------------------  ERROR TYPES  --------------------------------  -- | Exception specific to the @gen@ command. data CommandGenError = NoGenModeSelected@@ -94,8 +117,9 @@   fromException    = fromHeadroomError  displayException' :: CommandGenError -> String-displayException' = T.unpack . \case-  NoGenModeSelected -> mconcat-    [ "Please select at least one option what to generate "-    , "(see --help for details)"-    ]+displayException' = \case+  NoGenModeSelected -> [iii|+      Please select at least one option what to generate+      (see --help for details)+    |]+

@@ -4,6 +4,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude     #-} {-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE QuasiQuotes           #-} {-# LANGUAGE RecordWildCards       #-} {-# LANGUAGE StrictData            #-} {-# LANGUAGE TemplateHaskell       #-}@@ -13,7 +14,7 @@ {-| Module      : Headroom.Command.Init Description : Handler for the @init@ command-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -33,46 +34,55 @@   ) where -import           Headroom.Command.Types         ( CommandInitOptions(..) )-import           Headroom.Command.Utils         ( bootstrap )-import           Headroom.Configuration         ( makeHeadersConfig-                                                , parseConfiguration-                                                )-import           Headroom.Configuration.Types   ( Configuration(..)-                                                , LicenseType(..)-                                                )-import           Headroom.Data.Has              ( Has(..) )-import           Headroom.Data.Lens             ( suffixLenses )-import           Headroom.Embedded              ( configFileStub-                                                , defaultConfig-                                                , licenseTemplate-                                                )-import           Headroom.FileSystem            ( FileSystem(..)-                                                , fileExtension-                                                , findFiles-                                                , mkFileSystem-                                                )-import           Headroom.FileType              ( fileTypeByExt )-import           Headroom.FileType.Types        ( FileType(..) )-import           Headroom.Meta                  ( TemplateType )-import           Headroom.Serialization         ( prettyPrintYAML )-import           Headroom.Template              ( Template(..) )-import           Headroom.Types                 ( fromHeadroomError-                                                , toHeadroomError-                                                )-import           Headroom.UI                    ( Progress(..)-                                                , zipWithProgress-                                                )+import           Data.String.Interpolate             ( iii )+import           Headroom.Command.Types              ( CommandInitOptions(..) )+import           Headroom.Command.Utils              ( bootstrap )+import           Headroom.Configuration              ( makeHeadersConfig+                                                     , parseConfiguration+                                                     )+import           Headroom.Configuration.Enrich       ( Enrich(..)+                                                     , replaceEmptyValue+                                                     , withArray+                                                     , withText+                                                     )+import           Headroom.Configuration.Types        ( Configuration(..)+                                                     , LicenseType(..)+                                                     )+import           Headroom.Data.Has                   ( Has(..) )+import           Headroom.Data.Lens                  ( suffixLenses )+import           Headroom.Embedded                   ( configFileStub+                                                     , defaultConfig+                                                     , licenseTemplate+                                                     )+import           Headroom.FileSystem                 ( FileSystem(..)+                                                     , fileExtension+                                                     , findFiles+                                                     , mkFileSystem+                                                     )+import           Headroom.FileType                   ( fileTypeByExt )+import           Headroom.FileType.Types             ( FileType(..) )+import           Headroom.Meta                       ( TemplateType+                                                     , buildVersion+                                                     , configFileName+                                                     )+import           Headroom.Meta.Version               ( printVersion )+import           Headroom.Template                   ( Template(..) )+import           Headroom.Types                      ( fromHeadroomError+                                                     , toHeadroomError+                                                     )+import           Headroom.UI                         ( Progress(..)+                                                     , zipWithProgress+                                                     ) import           RIO-import qualified RIO.Char                      as C-import           RIO.FilePath                   ( (</>) )-import qualified RIO.List                      as L-import qualified RIO.Map                       as M-import qualified RIO.NonEmpty                  as NE-import qualified RIO.Text                      as T-import qualified RIO.Text.Partial              as TP+import qualified RIO.Char                           as C+import           RIO.FilePath                        ( (</>) )+import qualified RIO.List                           as L+import qualified RIO.NonEmpty                       as NE+import qualified RIO.Text                           as T  +---------------------------------  DATA TYPES  ---------------------------------+ -- | /RIO/ Environment for the @init@ command. data Env = Env   { envLogFunc     :: LogFunc@@ -81,6 +91,7 @@   , envPaths       :: Paths   } + -- | Paths to various locations of file system. data Paths = Paths   { pConfigFile   :: FilePath@@ -89,23 +100,26 @@  suffixLenses ''Env + instance HasLogFunc Env where   logFuncL = envLogFuncL + instance Has CommandInitOptions Env where   hasLens = envInitOptionsL + instance Has (FileSystem (RIO Env)) Env where   hasLens = envFileSystemL + instance Has Paths Env where   hasLens = envPathsL ---------------------------------------------------------------------------------  env' :: CommandInitOptions -> LogFunc -> IO Env env' opts logFunc = do-  let paths = Paths { pConfigFile   = ".headroom.yaml"+  let paths = Paths { pConfigFile   = configFileName                     , pTemplatesDir = "headroom-templates"                     }   pure $ Env { envLogFunc     = logFunc@@ -114,6 +128,9 @@              , envPaths       = paths              } ++------------------------------  PUBLIC FUNCTIONS  ------------------------------+ -- | Handler for @init@ command. commandInit :: CommandInitOptions             -- ^ @init@ command options@@ -129,6 +146,7 @@     paths <- viewL     throwM . AppConfigAlreadyExists $ pConfigFile paths + -- | Recursively scans provided source paths for known file types for which -- templates can be generated. findSupportedFileTypes :: (Has CommandInitOptions env, HasLogFunc env)@@ -149,6 +167,22 @@       logInfo $ "Found supported file types: " <> displayShow fileTypes       pure fileTypes ++-- | Checks whether application config file already exists.+doesAppConfigExist :: ( HasLogFunc env+                      , Has (FileSystem (RIO env)) env+                      , Has Paths env+                      )+                   => RIO env Bool+doesAppConfigExist = do+  FileSystem {..} <- viewL+  Paths {..}      <- viewL+  logInfo "Verifying that there's no existing Headroom configuration..."+  fsDoesFileExist pConfigFile+++------------------------------  PRIVATE FUNCTIONS  -----------------------------+ createTemplates :: (Has CommandInitOptions env, HasLogFunc env, Has Paths env)                 => [FileType]                 -> RIO env ()@@ -158,6 +192,7 @@   mapM_ (\(p, lf) -> createTemplate pTemplatesDir lf p)         (zipWithProgress $ fmap (cioLicenseType opts, ) fileTypes) + createTemplate :: (HasLogFunc env)                => FilePath                -> (LicenseType, FileType)@@ -172,38 +207,22 @@     [display progress, " Creating template file in ", fromString filePath]   writeFileUtf8 filePath template + createConfigFile :: (Has CommandInitOptions env, HasLogFunc env, Has Paths env)                  => RIO env () createConfigFile = do   opts         <- viewL   p@Paths {..} <- viewL   logInfo $ "Creating YAML config file in " <> fromString pConfigFile-  writeFileUtf8 pConfigFile (configuration opts p)+  writeFileUtf8 pConfigFile $ enrich (modify opts p) configFileStub  where-  configuration opts paths =-    let withSourcePaths = TP.replace-          "source-paths: []"-          (toYamlList "source-paths" $ cioSourcePaths opts)-        withTemplatePaths = TP.replace-          "template-paths: []"-          (toYamlList "template-paths" [pTemplatesDir paths])-    in  withTemplatePaths . withSourcePaths $ configFileStub-  toYamlList field list =-    T.stripEnd . prettyPrintYAML $ M.fromList [(field :: Text, list)]+  modify opts paths = mconcat+    [ replaceEmptyValue "version" $ withText (printVersion buildVersion)+    , replaceEmptyValue "source-paths" $ withArray (cioSourcePaths opts)+    , replaceEmptyValue "template-paths" $ withArray [pTemplatesDir paths]+    ] --- | Checks whether application config file already exists.-doesAppConfigExist :: ( HasLogFunc env-                      , Has (FileSystem (RIO env)) env-                      , Has Paths env-                      )-                   => RIO env Bool-doesAppConfigExist = do-  FileSystem {..} <- viewL-  Paths {..}      <- viewL-  logInfo "Verifying that there's no existing Headroom configuration..."-  fsDoesFileExist pConfigFile --- | Creates directory for template files. makeTemplatesDir :: ( HasLogFunc env                     , Has (FileSystem (RIO env)) env                     , Has Paths env@@ -216,7 +235,7 @@   fsCreateDirectory pTemplatesDir  ----------------------------------  Error Types  --------------------------------+---------------------------------  ERROR TYPES  --------------------------------  -- | Exception specific to the "Headroom.Command.Init" module data CommandInitError@@ -228,18 +247,21 @@   -- ^ no supported file types found on source paths   deriving (Eq, Show) + instance Exception CommandInitError where   displayException = displayException'   toException      = toHeadroomError   fromException    = fromHeadroomError + displayException' :: CommandInitError -> String-displayException' = T.unpack . \case-  AppConfigAlreadyExists path -> appConfigAlreadyExists path-  NoProvidedSourcePaths       -> noProvidedSourcePaths-  NoSupportedFileType         -> noSupportedFileType- where-  appConfigAlreadyExists path =-    mconcat ["Configuration file '", T.pack path, "' already exists"]-  noProvidedSourcePaths = "No source code paths (files or directories) defined"-  noSupportedFileType   = "No supported file type found in scanned source paths"+displayException' = \case+  AppConfigAlreadyExists path -> [iii|+      Configuration file '#{path}' already exists+    |]+  NoProvidedSourcePaths -> [iii|+      No source code paths (files or directories) defined+    |]+  NoSupportedFileType -> [iii|+      No supported file type found in scanned source paths+    |]

@@ -5,7 +5,7 @@ {-| Module      : Headroom.Command.Readers Description : Custom readers for /optparse-applicative/ library-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -19,28 +19,28 @@   ( licenseReader   , licenseTypeReader   , regexReader-  , parseLicenseAndFileType+  , parseLicense   ) where -import           Data.Either.Combinators        ( maybeToRight )-import           Headroom.Configuration.Types   ( LicenseType )-import           Headroom.Data.EnumExtra        ( EnumExtra(..) )-import           Headroom.Data.Regex            ( Regex(..)-                                                , compile-                                                )-import           Headroom.FileType.Types        ( FileType(..) )+import           Data.Either.Combinators             ( maybeToRight )+import           Headroom.Configuration.Types        ( LicenseType )+import           Headroom.Data.EnumExtra             ( EnumExtra(..) )+import           Headroom.Data.Regex                 ( Regex(..)+                                                     , compile+                                                     )+import           Headroom.FileType.Types             ( FileType(..) ) import           Options.Applicative import           RIO-import qualified RIO.Text                      as T-import qualified RIO.Text.Partial              as TP+import qualified RIO.Text                           as T+import qualified RIO.Text.Partial                   as TP   -- | Reader for tuple of 'LicenseType' and 'FileType'. licenseReader :: ReadM (LicenseType, FileType)-licenseReader = eitherReader parseLicense+licenseReader = eitherReader parseLicense'  where-  parseLicense raw = maybeToRight errMsg (parseLicenseAndFileType $ T.pack raw)+  parseLicense' raw = maybeToRight errMsg (parseLicense $ T.pack raw)   errMsg = T.unpack $ mconcat     [ "invalid license/file type, must be in format 'licenseType:fileType' "     , "(e.g. bsd3:haskell)"@@ -64,19 +64,17 @@  -- | Reader for 'Regex'. regexReader :: ReadM Regex-regexReader = eitherReader parse-  where parse input = mapLeft displayException (compile . T.pack $ input)+regexReader =+  let parse input = mapLeft displayException (compile . T.pack $ input)+  in  eitherReader parse   -- | Parses 'LicenseType' and 'FileType' from the input string, -- formatted as @licenseType:fileType@. ----- >>> parseLicenseAndFileType "bsd3:haskell"+-- >>> parseLicense "bsd3:haskell" -- Just (BSD3,Haskell)-parseLicenseAndFileType :: Text -> Maybe (LicenseType, FileType)-parseLicenseAndFileType raw-  | [rawLicenseType, rawFileType] <- TP.splitOn ":" raw = do-    licenseType <- textToEnum rawLicenseType-    fileType    <- textToEnum rawFileType-    pure (licenseType, fileType)-  | otherwise = Nothing+parseLicense :: Text -> Maybe (LicenseType, FileType)+parseLicense raw+  | [lt, ft] <- TP.splitOn ":" raw = (,) <$> textToEnum lt <*> textToEnum ft+  | otherwise                      = Nothing

@@ -12,7 +12,7 @@ {-| Module      : Headroom.Command.Run Description : Handler for the @run@ command.-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -29,93 +29,95 @@   , typeOfTemplate     -- * License Header Post-processing   , postProcessHeader'-  , sanitizeHeader   ) where -import           Data.Time.Calendar             ( toGregorian )-import           Data.Time.Clock                ( getCurrentTime )-import           Data.Time.Clock.POSIX          ( getPOSIXTime )-import           Data.Time.LocalTime            ( getCurrentTimeZone-                                                , localDay-                                                , utcToLocalTime-                                                )-import           Headroom.Command.Types         ( CommandRunOptions(..) )-import           Headroom.Command.Utils         ( bootstrap )-import           Headroom.Configuration         ( loadConfiguration-                                                , makeConfiguration-                                                , parseConfiguration-                                                )-import           Headroom.Configuration.Types   ( Configuration(..)-                                                , CtConfiguration-                                                , CtHeaderFnConfigs-                                                , HeaderConfig(..)-                                                , HeaderSyntax(..)-                                                , LicenseType(..)-                                                , PtConfiguration-                                                , RunMode(..)-                                                , TemplateSource(..)-                                                )-import           Headroom.Data.EnumExtra        ( EnumExtra(..) )-import           Headroom.Data.Has              ( Has(..) )-import           Headroom.Data.Lens             ( suffixLenses-                                                , suffixLensesFor-                                                )-import           Headroom.Data.TextExtra        ( mapLines )-import           Headroom.Embedded              ( defaultConfig-                                                , licenseTemplate-                                                )-import           Headroom.Ext                   ( extractTemplateMeta )-import           Headroom.FileSupport           ( addHeader-                                                , dropHeader-                                                , extractFileInfo-                                                , replaceHeader-                                                )-import           Headroom.FileSupport.Types     ( FileInfo(..) )-import           Headroom.FileSystem            ( FileSystem(..)-                                                , excludePaths-                                                , fileExtension-                                                , mkFileSystem-                                                )-import           Headroom.FileType              ( configByFileType-                                                , fileTypeByExt-                                                )-import           Headroom.FileType.Types        ( FileType(..) )-import           Headroom.HeaderFn              ( mkConfiguredEnv-                                                , postProcessHeader-                                                )-import           Headroom.Meta                  ( TemplateType-                                                , productInfo-                                                )-import           Headroom.Template              ( Template(..) )-import           Headroom.Types                 ( CurrentYear(..)-                                                , TemplateMeta(..)-                                                )-import           Headroom.UI                    ( Progress(..)-                                                , zipWithProgress-                                                )-import           Headroom.Variables             ( compileVariables-                                                , dynamicVariables-                                                , parseVariables-                                                )-import           Headroom.Variables.Types       ( Variables(..) )+import           Data.Time.Calendar                  ( toGregorian )+import           Data.Time.Clock                     ( getCurrentTime )+import           Data.Time.Clock.POSIX               ( getPOSIXTime )+import           Data.Time.LocalTime                 ( getCurrentTimeZone+                                                     , localDay+                                                     , utcToLocalTime+                                                     )+import           Headroom.Command.Types              ( CommandRunOptions(..) )+import           Headroom.Command.Utils              ( bootstrap )+import           Headroom.Configuration              ( loadConfiguration+                                                     , makeConfiguration+                                                     , parseConfiguration+                                                     )+import           Headroom.Configuration.Types        ( Configuration(..)+                                                     , CtConfiguration+                                                     , CtHeaderFnConfigs+                                                     , HeaderConfig(..)+                                                     , HeaderSyntax(..)+                                                     , LicenseType(..)+                                                     , PtConfiguration+                                                     , RunMode(..)+                                                     , TemplateSource(..)+                                                     )+import           Headroom.Data.EnumExtra             ( EnumExtra(..) )+import           Headroom.Data.Has                   ( Has(..) )+import           Headroom.Data.Lens                  ( suffixLenses+                                                     , suffixLensesFor+                                                     )+import           Headroom.Embedded                   ( defaultConfig+                                                     , licenseTemplate+                                                     )+import           Headroom.FileSupport                ( analyzeSourceCode+                                                     , fileSupport+                                                     )+import           Headroom.FileSystem                 ( FileSystem(..)+                                                     , excludePaths+                                                     , fileExtension+                                                     , mkFileSystem+                                                     )+import           Headroom.FileType                   ( fileTypeByExt )+import           Headroom.FileType.Types             ( FileType(..) )+import           Headroom.Header                     ( addHeader+                                                     , dropHeader+                                                     , extractHeaderInfo+                                                     , extractHeaderTemplate+                                                     , replaceHeader+                                                     )+import           Headroom.Header.Sanitize            ( sanitizeSyntax )+import           Headroom.Header.Types               ( HeaderInfo(..)+                                                     , HeaderTemplate(..)+                                                     )+import           Headroom.HeaderFn                   ( mkConfiguredEnv+                                                     , postProcessHeader+                                                     )+import           Headroom.Meta                       ( TemplateType+                                                     , configFileName+                                                     , productInfo+                                                     )+import           Headroom.SourceCode                 ( SourceCode+                                                     , toText+                                                     )+import           Headroom.Template                   ( Template(..) )+import           Headroom.Types                      ( CurrentYear(..) )+import           Headroom.UI                         ( Progress(..)+                                                     , zipWithProgress+                                                     )+import           Headroom.Variables                  ( compileVariables+                                                     , dynamicVariables+                                                     , parseVariables+                                                     )+import           Headroom.Variables.Types            ( Variables(..) ) import           RIO-import           RIO.FilePath                   ( takeBaseName )-import qualified RIO.List                      as L-import qualified RIO.Map                       as M-import qualified RIO.Text                      as T+import           RIO.FilePath                        ( takeBaseName )+import qualified RIO.List                           as L+import qualified RIO.Map                            as M+import qualified RIO.Text                           as T   suffixLensesFor ["cHeaderFnConfigs"] ''Configuration  -type TemplatesMap = Map FileType (Maybe TemplateMeta, TemplateType)- -- | Action to be performed based on the selected 'RunMode'. data RunAction = RunAction   { raProcessed    :: Bool   -- ^ whether the given file was processed-  , raFunc         :: Text -> Text+  , raFunc         :: SourceCode -> SourceCode   -- ^ function to process the file   , raProcessedMsg :: Text   -- ^ message to show when file was processed@@ -199,7 +201,7 @@   let isCheck = cRunMode == Check   warnOnDryRun   startTS            <- liftIO getPOSIXTime-  templates          <- withTemplateMeta <$> loadTemplates+  templates          <- loadTemplates   sourceFiles        <- findSourceFiles (M.keys templates)   (total, processed) <- processSourceFiles templates sourceFiles   endTS              <- liftIO getPOSIXTime@@ -253,24 +255,21 @@                       , Has CurrentYear env                       , HasLogFunc env                       )-                   => TemplatesMap+                   => Map FileType HeaderTemplate                    -> [FilePath]                    -> RIO env (Int, Int) processSourceFiles templates paths = do   Configuration {..} <- viewL   year               <- viewL   let dVars        = dynamicVariables year-      withFileType = mapMaybe (findFileType cLicenseHeaders) paths-      withTemplate = mapMaybe (uncurry findTemplate) withFileType+      withTemplate = mapMaybe (template cLicenseHeaders) paths   cVars     <- compileVariables (dVars <> cVariables)   processed <- mapM (process cVars dVars) (zipWithProgress withTemplate)   pure (L.length withTemplate, L.length . filter (== True) $ processed)  where-  findFileType conf path =-    fmap (, path) (fileExtension path >>= fileTypeByExt conf)-  findTemplate ft p = (, ft, p) <$> M.lookup ft templates-  process cVars dVars (pr, ((tm, tt), ft, p)) =-    processSourceFile cVars dVars pr tm tt ft p+  fileType c p = fileExtension p >>= fileTypeByExt c+  template c p = (, p) <$> (fileType c p >>= \ft -> M.lookup ft templates)+  process cVars dVars (pr, (ht, p)) = processSourceFile cVars dVars pr ht p   processSourceFile :: ( Has CommandRunOptions env@@ -282,42 +281,39 @@                   => Variables                   -> Variables                   -> Progress-                  -> Maybe TemplateMeta-                  -> TemplateType-                  -> FileType+                  -> HeaderTemplate                   -> FilePath                   -> RIO env Bool-processSourceFile cVars dVars progress meta template fileType path = do+processSourceFile cVars dVars progress ht@HeaderTemplate {..} path = do   Configuration {..}     <- viewL @CtConfiguration   CommandRunOptions {..} <- viewL   fileContent            <- readFileUtf8 path-  let fileInfo@FileInfo {..} = extractFileInfo-        fileType-        (configByFileType cLicenseHeaders fileType)-        meta-        fileContent-      variables = dVars <> cVars <> fiVariables-      syntax    = hcHeaderSyntax fiHeaderConfig-  header'        <- renderTemplate variables template+  let fs                         = fileSupport htFileType+      source                     = analyzeSourceCode fs fileContent+      headerInfo@HeaderInfo {..} = extractHeaderInfo ht source+      variables                  = dVars <> cVars <> hiVariables+      syntax                     = hcHeaderSyntax hiHeaderConfig+  header'        <- renderTemplate variables htTemplate   header         <- postProcessHeader' syntax variables header'-  RunAction {..} <- chooseAction fileInfo header-  let result  = raFunc fileContent-      changed = raProcessed && (fileContent /= result)+  RunAction {..} <- chooseAction headerInfo header+  let result  = raFunc source+      changed = raProcessed && (source /= result)       message = if changed then raProcessedMsg else raSkippedMsg       isCheck = cRunMode == Check-  logDebug $ "File info: " <> displayShow fileInfo+  logDebug $ "Header info: " <> displayShow headerInfo   logInfo $ mconcat [display progress, " ", display message, fromString path]-  when (not croDryRun && not isCheck && changed) (writeFileUtf8 path result)+  when (not croDryRun && not isCheck && changed)+       (writeFileUtf8 path $ toText result)   pure changed   chooseAction :: (Has CtConfiguration env)-             => FileInfo+             => HeaderInfo              -> Text              -> RIO env RunAction chooseAction info header = do   Configuration {..} <- viewL @CtConfiguration-  let hasHeader = isJust $ fiHeaderPos info+  let hasHeader = isJust $ hiHeaderPos info   pure $ go cRunMode hasHeader  where   go runMode hasHeader = case runMode of@@ -358,7 +354,7 @@   withTypes <- catMaybes <$> mapM (\p -> fmap (, p) <$> typeOfTemplate p) paths   parsed    <- mapM     (\(t, p) ->-      (t, ) <$> ((T.strip <$> fsLoadFile p) >>= parseTemplate (Just $ T.pack p))+      (t, ) <$> (fsLoadFile p >>= parseTemplate (Just $ T.pack p) . T.strip)     )     withTypes   logInfo@@ -387,17 +383,13 @@                  , Has (FileSystem (RIO env)) env                  , HasLogFunc env                  )-              => RIO env (Map FileType TemplateType)+              => RIO env (Map FileType HeaderTemplate) loadTemplates = do   Configuration {..} <- viewL @CtConfiguration-  case cTemplateSource of+  templates          <- case cTemplateSource of     TemplateFiles    paths       -> loadTemplateFiles paths     BuiltInTemplates licenseType -> loadBuiltInTemplates licenseType---withTemplateMeta :: Map FileType TemplateType -> TemplatesMap-withTemplateMeta = M.fromList . go . M.toList-  where go = fmap (\(k, v) -> (k, (extractTemplateMeta k v, v)))+  pure $ M.mapWithKey (extractHeaderTemplate cLicenseHeaders) templates   -- | Takes path to the template file and returns detected type of the template.@@ -425,7 +417,9 @@       , fromString path       , "' not found. You can either specify all required parameter by "       , "command line arguments, or generate one using "-      , "'headroom gen -c >.headroom.yaml'. See official documentation "+      , "'headroom gen -c >"+      , configFileName+      , "'. See official documentation "       , "for more details."       ]     pure Nothing@@ -437,7 +431,7 @@   logInfo $ display productInfo   defaultConfig' <- Just <$> parseConfiguration defaultConfig   cmdLineConfig  <- Just <$> optionsToConfiguration-  yamlConfig     <- loadConfigurationSafe ".headroom.yaml"+  yamlConfig     <- loadConfigurationSafe configFileName   let mergedConfig =         mconcat . catMaybes $ [defaultConfig', yamlConfig, cmdLineConfig]   config <- makeConfiguration mergedConfig@@ -476,7 +470,7 @@ -- | Performs post-processing on rendered /license header/, based on given -- configuration. Currently the main points are to: -----  1. sanitize possibly corrupted comment syntax ('sanitizeHeader')+--  1. sanitize possibly corrupted comment syntax ('sanitizeSyntax') --  2. apply /license header functions/ ('postProcessHeader') postProcessHeader' :: (Has CtHeaderFnConfigs env, Has CurrentYear env)                    => HeaderSyntax@@ -491,23 +485,4 @@   configs <- viewL @CtHeaderFnConfigs   year    <- viewL   cEnv    <- mkConfiguredEnv year vars configs-  let processed = sanitizeHeader syntax . postProcessHeader cEnv $ rawHeader-  pure processed----- | Ensures that all lines in license header starts with /line-comment/ syntax--- if such syntax is used for license header.------ >>> sanitizeHeader (LineComment "--") "-- foo\nbar\n-- baz"--- "-- foo\n-- bar\n-- baz"-sanitizeHeader :: HeaderSyntax-               -- ^ syntax of the license header comments-               -> Text-               -- ^ input text to sanitize-               -> Text-               -- ^ sanitized text-sanitizeHeader (BlockComment _ _      ) text = text-sanitizeHeader (LineComment prefixedBy) text = mapLines process text- where-  process line | T.isPrefixOf prefixedBy line = line-               | otherwise                    = prefixedBy <> " " <> line+  pure . sanitizeSyntax syntax . postProcessHeader cEnv $ rawHeader

@@ -4,7 +4,7 @@ {-| Module      : Headroom.Command.Types Description : Data types for "Headroom.Command"-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -21,13 +21,13 @@   ) where -import           Headroom.Configuration.Types   ( GenMode-                                                , LicenseType-                                                , RunMode-                                                , TemplateSource-                                                )-import           Headroom.Data.Regex            ( Regex )-import           Headroom.FileType.Types        ( FileType )+import           Headroom.Configuration.Types        ( GenMode+                                                     , LicenseType+                                                     , RunMode+                                                     , TemplateSource+                                                     )+import           Headroom.Data.Regex                 ( Regex )+import           Headroom.FileType.Types             ( FileType ) import           RIO  

@@ -3,7 +3,7 @@ {-| Module      : Headroom.Command.Utils Description : Shared code for individual command handlers-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental

@@ -7,7 +7,7 @@ {-| Module      : Headroom.Configuration Description : Configuration handling (loading, parsing, validating)-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -30,34 +30,38 @@   ) where -import           Data.Monoid                    ( Last(..) )-import qualified Data.Yaml                     as Y-import           Headroom.Configuration.Types   ( Configuration(..)-                                                , ConfigurationError(..)-                                                , ConfigurationKey(..)-                                                , CtConfiguration-                                                , CtHeaderConfig-                                                , CtHeaderFnConfig-                                                , CtHeaderFnConfigs-                                                , CtHeadersConfig-                                                , CtUpdateCopyrightConfig-                                                , HeaderConfig(..)-                                                , HeaderFnConfig(..)-                                                , HeaderFnConfigs(..)-                                                , HeadersConfig(..)-                                                , Phase(..)-                                                , PtConfiguration-                                                , PtHeaderConfig-                                                , PtHeaderFnConfig-                                                , PtHeaderFnConfigs-                                                , PtHeadersConfig-                                                , PtUpdateCopyrightConfig-                                                , UpdateCopyrightConfig(..)-                                                )-import           Headroom.Data.Lens             ( suffixLenses )-import           Headroom.FileType.Types        ( FileType(..) )+import           Data.Monoid                         ( Last(..) )+import qualified Data.Yaml                          as Y+import           Headroom.Configuration.Compat       ( checkCompatibility )+import           Headroom.Configuration.Types        ( Configuration(..)+                                                     , ConfigurationError(..)+                                                     , ConfigurationKey(..)+                                                     , CtConfiguration+                                                     , CtHeaderConfig+                                                     , CtHeaderFnConfig+                                                     , CtHeaderFnConfigs+                                                     , CtHeadersConfig+                                                     , CtUpdateCopyrightConfig+                                                     , HeaderConfig(..)+                                                     , HeaderFnConfig(..)+                                                     , HeaderFnConfigs(..)+                                                     , HeadersConfig(..)+                                                     , Phase(..)+                                                     , PtConfiguration+                                                     , PtHeaderConfig+                                                     , PtHeaderFnConfig+                                                     , PtHeaderFnConfigs+                                                     , PtHeadersConfig+                                                     , PtUpdateCopyrightConfig+                                                     , UpdateCopyrightConfig(..)+                                                     )+import           Headroom.Data.Lens                  ( suffixLenses )+import           Headroom.FileType.Types             ( FileType(..) )+import           Headroom.Meta                       ( buildVersion+                                                     , configBreakingChanges+                                                     ) import           RIO-import qualified RIO.ByteString                as B+import qualified RIO.ByteString                     as B   suffixLenses ''HeaderFnConfig@@ -65,18 +69,19 @@ suffixLenses ''UpdateCopyrightConfig  +------------------------------  PUBLIC FUNCTIONS  ------------------------------+ -- | Loads and parses application configuration from given /YAML/ file.-loadConfiguration :: MonadIO m-                  => FilePath-                  -- ^ path to /YAML/ configuration file-                  -> m PtConfiguration-                  -- ^ parsed configuration-loadConfiguration path = liftIO $ B.readFile path >>= parseConfiguration+loadConfiguration :: (MonadIO m, MonadThrow m) => FilePath -> m PtConfiguration+loadConfiguration path = do+  content <- liftIO $ B.readFile path+  _       <- checkCompatibility configBreakingChanges buildVersion content+  parseConfiguration content   -- | Parses application configuration from given raw input in /YAML/ format. parseConfiguration :: MonadThrow m-                   => B.ByteString+                   => ByteString                    -- ^ raw input to parse                    -> m PtConfiguration                    -- ^ parsed application configuration@@ -132,14 +137,20 @@ makeHeaderConfig fileType pt = do   hcFileExtensions <- lastOrError (CkFileExtensions fileType)                                   (hcFileExtensions pt)-  hcMarginAfter  <- lastOrError (CkMarginAfter fileType) (hcMarginAfter pt)-  hcMarginBefore <- lastOrError (CkMarginBefore fileType) (hcMarginBefore pt)+  hcMarginTopCode <- lastOrError (CkMarginTopCode fileType) (hcMarginTopCode pt)+  hcMarginTopFile <- lastOrError (CkMarginTopFile fileType) (hcMarginTopFile pt)+  hcMarginBottomCode <- lastOrError (CkMarginBottomCode fileType)+                                    (hcMarginBottomCode pt)+  hcMarginBottomFile <- lastOrError (CkMarginBottomFile fileType)+                                    (hcMarginBottomFile pt)   hcPutAfter     <- lastOrError (CkPutAfter fileType) (hcPutAfter pt)   hcPutBefore    <- lastOrError (CkPutBefore fileType) (hcPutBefore pt)   hcHeaderSyntax <- lastOrError (CkHeaderSyntax fileType) (hcHeaderSyntax pt)   pure HeaderConfig { .. }  +------------------------------  PRIVATE FUNCTIONS  -----------------------------+ makeHeaderFnConfigs :: MonadThrow m => PtHeaderFnConfigs -> m CtHeaderFnConfigs makeHeaderFnConfigs pt = do   hfcsUpdateCopyright <- makeHeaderFnConfig (pt ^. hfcsUpdateCopyrightL)@@ -163,9 +174,6 @@ makeUpdateCopyrightConfig pt = do   let uccSelectedAuthors = lastOrNothing $ pt ^. uccSelectedAuthorsL   pure UpdateCopyrightConfig { .. }---------------------------------  Private Functions  -----------------------------   lastOrError :: MonadThrow m => ConfigurationKey -> Last a -> m a

@@ -0,0 +1,139 @@+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE StrictData        #-}++{-|+Module      : Headroom.Configuration.Compat+Description : Compatibility checks for YAML configuration+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++This module contains functions and data types used for checking compatibility of+user's YAML configuration with current version of Headroom.+-}++module Headroom.Configuration.Compat+  ( VersionError(..)+  , checkCompatibility+  )+where++import           Data.Aeson                          ( FromJSON(..)+                                                     , withObject+                                                     , (.:)+                                                     )+import           Data.String.Interpolate             ( iii )+import qualified Data.Yaml                          as Y+import           Headroom.Meta                       ( buildVersion+                                                     , configFileName+                                                     , productName+                                                     , webDocMigration+                                                     )+import           Headroom.Meta.Version               ( Version(..)+                                                     , printVersionP+                                                     , pvp+                                                     )+import           Headroom.Types                      ( fromHeadroomError+                                                     , toHeadroomError+                                                     )+import           RIO+import qualified RIO.List                           as L+++---------------------------------  DATA TYPES  ---------------------------------++newtype VersionObj = VersionObj Version deriving (Eq, Show)++instance FromJSON VersionObj where+  parseJSON = withObject "VersionObj" $ \obj -> do+    version <- obj .: "version"+    pure $ VersionObj version+++---------------------------------  ERROR TYPES  --------------------------------++-- | Exception specific to the "Headroom.Configuration.Compat" module.+data VersionError+  = CannotParseVersion+  -- ^ cannot parse version info from given YAML configuration+  | NewerVersionDetected Version+  -- ^ configuration has newer version than Headroom+  | UnsupportedVersion [Version] Version+  -- ^ given YAML configuration is not compatible+  deriving (Eq, Show)+++instance Exception VersionError where+  displayException = displayException'+  toException      = toHeadroomError+  fromException    = fromHeadroomError+++------------------------------  PUBLIC FUNCTIONS  ------------------------------++-- | Checks whether the given not yet parsed YAML configuration is compatible,+-- using list of versions that caused breaking changes into configuration.+checkCompatibility :: MonadThrow m+                   => [Version]+                   -- ^ list of versions with breaking changes in configuration+                   -> Version+                   -- ^ current Headroom version+                   -> ByteString+                   -- ^ raw, not yet parsed YAML configuration+                   -> m Version+                   -- ^ detected compatible version or error+checkCompatibility breakingVersions current raw = do+  VersionObj version <- parseObj+  _                  <- checkBreakingChanges breakingVersions version+  _                  <- checkNewerVersion current version+  pure version+ where+  parseObj = either (const . throwM $ CannotParseVersion) pure decoded+  decoded  = Y.decodeEither' raw+++------------------------------  PRIVATE FUNCTIONS  -----------------------------++checkBreakingChanges :: MonadThrow m => [Version] -> Version -> m ()+checkBreakingChanges vs v = case L.filter (v <) . L.sort $ vs of+  []    -> pure ()+  newer -> throwM $ UnsupportedVersion newer v+++checkNewerVersion :: MonadThrow m => Version -> Version -> m ()+checkNewerVersion current checked =+  if current < checked then throwM $ NewerVersionDetected checked else pure ()+++displayException' :: VersionError -> String+displayException' = \case+  CannotParseVersion -> [iii|+      Cannot find 'version' key in #{configFileName :: String} configuration+      file. This field is required to check whether your current configuration+      is compatible with installed version of #{productName}. This functionality+      has been added in version 0.4.0.0, please see following migration guide+      for more details on how to proceed:+      #{"\n\t" <> webDocMigration v0400}+    |]+  NewerVersionDetected version -> [iii|+      The version set in your #{configFileName :: String} configuration file+      (#{printVersionP version}) is newer than version of installed+      #{productName} (#{printVersionP buildVersion}). Please upgrade+      #{productName} first.+    |]+  UnsupportedVersion versions version -> [iii|+      Your #{configFileName :: String} configuration file has version+      #{printVersionP version}, which is incompatible with current version of+      #{productName} (#{printVersionP buildVersion}). Please perform steps+      described in these migration guides first (in given order):+      #{migrationGuides versions}+    |]+ where+  v0400           = [pvp|0.4.0.0|]+  migrationGuides = mconcat . fmap (\v -> "\n\t- " <> webDocMigration v)

@@ -0,0 +1,111 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData        #-}++{-|+Module      : Headroom.Configuration.Enrich+Description : Simple enrichment of YAML configuration stubs+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++This module contains mini-DSL for enrichment of generated /YAML/ configurations,+i.e. replacing default values with real ones, etc. This is intentionally done+without the "Data.Yaml" and parsing, because that way all comments inside YAML+file would be lost.+-}++module Headroom.Configuration.Enrich+  ( -- * Data Types+    Enrich(..)+  , ValueType(..)+    -- * Field Generators+  , withArray+  , withText+    -- * Field Manipulation+  , replaceEmptyValue+  )+where++import           Data.Aeson                          ( ToJSON(..) )+import           Headroom.Serialization              ( prettyPrintYAML )+import           RIO+import qualified RIO.Map                            as M+import qualified RIO.Text                           as T+import qualified RIO.Text.Partial                   as TP+++---------------------------------  DATA TYPES  ---------------------------------++-- | Simple wrapper representing single step of enrichment.+newtype Enrich = Enrich+  { enrich :: Text -> Text+  -- ^ takes input text and does enrichment+  }+++instance Semigroup Enrich where+  Enrich fnA <> Enrich fnB = Enrich $ fnA . fnB+++instance Monoid Enrich where+  mempty = Enrich id+++-- | Represents type of the field value.+data ValueType+  = Array+  -- ^ type of /YAML/ array+  | String+  -- ^ type of /YAML/ string+  deriving (Eq, Show)+++------------------------------  PUBLIC FUNCTIONS  ------------------------------++-- | Generates /YAML/ array field from given list and field name.+withArray :: ToJSON a+          => [a]+          -- ^ input list used as value+          -> Text+          -- ^ field name+          -> (ValueType, Text)+          -- ^ generated fields as @(valueType, generatedField)@+withArray list field = (Array, asYAML field list)+++-- | Generates /YAML/ string from given text value and field name.+withText :: Text+         -- ^ input text value+         -> Text+         -- ^ field name+         -> (ValueType, Text)+         -- ^ generated fields as @(valueType, generatedField)@+withText text field = (String, asYAML field text)+++-- | Replaces empty value of given field with actual generated value.+replaceEmptyValue :: Text+                  -- ^ field name+                  -> (Text -> (ValueType, Text))+                  -- ^ field value generator function+                  -> Enrich+                  -- ^ resulting enrichment step+replaceEmptyValue field replaceFn = Enrich $ \doc -> do+  TP.replace old new doc+ where+  (tpe, new) = replaceFn field+  old        = field <> ": " <> emptyValue tpe+++------------------------------  PRIVATE FUNCTIONS  -----------------------------++asYAML :: ToJSON a => Text -> a -> Text+asYAML field value = T.stripEnd . prettyPrintYAML $ M.fromList [(field, value)]+++emptyValue :: ValueType -> Text+emptyValue Array  = "[]"+emptyValue String = "\"\""

@@ -1,11 +1,13 @@ {-# LANGUAGE DataKinds            #-} {-# LANGUAGE DeriveAnyClass       #-} {-# LANGUAGE DeriveGeneric        #-}+{-# LANGUAGE DerivingVia          #-} {-# LANGUAGE FlexibleContexts     #-} {-# LANGUAGE FlexibleInstances    #-} {-# LANGUAGE LambdaCase           #-} {-# LANGUAGE NoImplicitPrelude    #-} {-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE QuasiQuotes          #-} {-# LANGUAGE RecordWildCards      #-} {-# LANGUAGE StandaloneDeriving   #-} {-# LANGUAGE StrictData           #-}@@ -16,7 +18,7 @@ {-| Module      : Headroom.Configuration.Types Description : Data types for /Headroom/ configuration-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -69,25 +71,30 @@   ) where -import           Control.Exception              ( throw )-import           Data.Aeson                     ( FromJSON(..)-                                                , Value(String)-                                                , genericParseJSON-                                                , withObject-                                                , (.!=)-                                                , (.:?)-                                                )-import           Data.Monoid                    ( Last(..) )-import           Headroom.Data.EnumExtra        ( EnumExtra(..) )-import           Headroom.Data.Regex            ( Regex(..) )-import           Headroom.FileType.Types        ( FileType )-import           Headroom.Serialization         ( aesonOptions )-import           Headroom.Types                 ( fromHeadroomError-                                                , toHeadroomError-                                                )-import           Headroom.Variables.Types       ( Variables(..) )+import           Control.Exception                   ( throw )+import           Data.Aeson                          ( FromJSON(..)+                                                     , Value(String)+                                                     , genericParseJSON+                                                     , withObject+                                                     , (.!=)+                                                     , (.:?)+                                                     )+import           Data.Monoid                         ( Last(..) )+import           Data.String.Interpolate             ( i+                                                     , iii+                                                     )+import           Generic.Data                        ( Generically(..) )+import           Headroom.Data.EnumExtra             ( EnumExtra(..) )+import           Headroom.Data.Regex                 ( Regex(..) )+import           Headroom.FileType.Types             ( FileType )+import           Headroom.Meta                       ( webDocConfigCurr )+import           Headroom.Serialization              ( aesonOptions )+import           Headroom.Types                      ( fromHeadroomError+                                                     , toHeadroomError+                                                     )+import           Headroom.Variables.Types            ( Variables(..) ) import           RIO-import qualified RIO.Text                      as T+import qualified RIO.Text                           as T   ------------------------------------  Phase  -----------------------------------@@ -112,17 +119,17 @@  -- | Syntax of the license header comment. data HeaderSyntax-  = BlockComment Text Text+  = BlockComment Regex Regex (Maybe Text)   -- ^ block (multi-line) comment syntax (e.g. @/* */@)-  | LineComment Text+  | LineComment Regex (Maybe Text)   -- ^ single line comment syntax (e.g. @//@)   deriving (Eq, Show)  -- | Internal representation of the block style of 'HeaderSyntax'. data BlockComment' = BlockComment'-  { bcStartsWith :: Text+  { bcStartsWith :: Regex   -- ^ starting pattern (e.g. @/*@)-  , bcEndsWith   :: Text+  , bcEndsWith   :: Regex   -- ^ ending pattern (e.g. @*/@)   }   deriving (Eq, Generic, Show)@@ -132,7 +139,7 @@  -- | Internal representation of the line style of 'HeaderSyntax'. newtype LineComment' = LineComment'-  { lcPrefixedBy :: Text+  { lcPrefixedBy :: Regex   -- ^ prefix of the comment line (e.g. @//@)   }   deriving (Eq, Generic, Show)@@ -226,21 +233,18 @@ deriving instance Eq PtUpdateCopyrightConfig deriving instance Show CtUpdateCopyrightConfig deriving instance Show PtUpdateCopyrightConfig+deriving instance Generic PtUpdateCopyrightConfig +deriving via (Generically PtUpdateCopyrightConfig)+         instance Semigroup PtUpdateCopyrightConfig+deriving via (Generically PtUpdateCopyrightConfig)+         instance Monoid PtUpdateCopyrightConfig+ instance FromJSON PtUpdateCopyrightConfig where   parseJSON = withObject "PtUpdateCopyrightConfig" $ \obj -> do     uccSelectedAuthors <- Last <$> obj .:? "selected-authors-only"     pure UpdateCopyrightConfig { .. } -instance Semigroup PtUpdateCopyrightConfig where-  x <> y = UpdateCopyrightConfig-    { uccSelectedAuthors = uccSelectedAuthors x <> uccSelectedAuthors y-    }--instance Monoid PtUpdateCopyrightConfig where-  mempty = UpdateCopyrightConfig mempty-- -------------------------------  HeaderFnConfig  -------------------------------  -- | Configuration for selected /license header function/.@@ -262,14 +266,12 @@ deriving instance (Eq (c 'Partial)) => Eq (PtHeaderFnConfig c) deriving instance (Show (c 'Complete)) => Show (CtHeaderFnConfig c) deriving instance (Show (c 'Partial)) => Show (PtHeaderFnConfig c)--instance Semigroup (c 'Partial) => Semigroup (PtHeaderFnConfig c) where-  x <> y = HeaderFnConfig { hfcEnabled = hfcEnabled x <> hfcEnabled y-                          , hfcConfig  = hfcConfig x <> hfcConfig y-                          }+deriving instance Generic (PtHeaderFnConfig c) -instance Monoid (c 'Partial) => Monoid (PtHeaderFnConfig c) where-  mempty = HeaderFnConfig mempty mempty+deriving via (Generically (PtHeaderFnConfig c))+         instance Semigroup (c 'Partial) => Semigroup (PtHeaderFnConfig c)+deriving via (Generically (PtHeaderFnConfig c))+         instance Monoid (c 'Partial) => Monoid (PtHeaderFnConfig c)  instance (FromJSON (c 'Partial), Monoid (c 'Partial)) => FromJSON (PtHeaderFnConfig c) where   parseJSON = withObject "PtHeaderFnConfig" $ \obj -> do@@ -297,14 +299,12 @@ deriving instance Eq PtHeaderFnConfigs deriving instance Show CtHeaderFnConfigs deriving instance Show PtHeaderFnConfigs--instance Semigroup PtHeaderFnConfigs where-  x <> y = HeaderFnConfigs-    { hfcsUpdateCopyright = hfcsUpdateCopyright x <> hfcsUpdateCopyright y-    }+deriving instance Generic PtHeaderFnConfigs -instance Monoid PtHeaderFnConfigs where-  mempty = HeaderFnConfigs mempty+deriving via (Generically PtHeaderFnConfigs)+         instance Semigroup PtHeaderFnConfigs+deriving via (Generically PtHeaderFnConfigs)+         instance Monoid PtHeaderFnConfigs  instance FromJSON PtHeaderFnConfigs where   parseJSON = withObject "PtHeaderFnConfigs" $ \obj -> do@@ -342,7 +342,14 @@ deriving instance Eq PtConfiguration deriving instance Show CtConfiguration deriving instance Show PtConfiguration+deriving instance Generic PtConfiguration +deriving via (Generically PtConfiguration)+         instance Semigroup PtConfiguration+deriving via (Generically PtConfiguration)+         instance Monoid PtConfiguration++ instance FromJSON PtConfiguration where   parseJSON = withObject "PtConfiguration" $ \obj -> do     cRunMode         <- Last <$> obj .:? "run-mode"@@ -355,36 +362,26 @@     pure Configuration { .. }     where get = fmap . fmap -instance Semigroup PtConfiguration where-  x <> y = Configuration-    { cRunMode         = cRunMode x <> cRunMode y-    , cSourcePaths     = cSourcePaths x <> cSourcePaths y-    , cExcludedPaths   = cExcludedPaths x <> cExcludedPaths y-    , cTemplateSource  = cTemplateSource x <> cTemplateSource y-    , cVariables       = cVariables x <> cVariables y-    , cLicenseHeaders  = cLicenseHeaders x <> cLicenseHeaders y-    , cHeaderFnConfigs = cHeaderFnConfigs x <> cHeaderFnConfigs y-    } -instance Monoid PtConfiguration where-  mempty = Configuration mempty mempty mempty mempty mempty mempty mempty-- --------------------------------  HeaderConfig  --------------------------------  -- | Configuration for specific license header. data HeaderConfig (p :: Phase) = HeaderConfig-  { hcFileExtensions :: p ::: [Text]+  { hcFileExtensions   :: p ::: [Text]   -- ^ list of file extensions (without dot)-  , hcMarginAfter    :: p ::: Int-  -- ^ number of empty lines to put after header-  , hcMarginBefore   :: p ::: Int-  -- ^ number of empty lines to put before header-  , hcPutAfter       :: p ::: [Regex]+  , hcMarginTopCode    :: p ::: Int+  -- ^ margin between header top and preceding code (if present)+  , hcMarginTopFile    :: p ::: Int+  -- ^ margin between header top and start of file (if no code is between)+  , hcMarginBottomCode :: p ::: Int+  -- ^ margin between header bottom and following code (if present)+  , hcMarginBottomFile :: p ::: Int+  -- ^ margin between header bottom and end of file (if no code is between)+  , hcPutAfter         :: p ::: [Regex]   -- ^ /regexp/ patterns after which to put the header-  , hcPutBefore      :: p ::: [Regex]+  , hcPutBefore        :: p ::: [Regex]   -- ^ /regexp/ patterns before which to put the header-  , hcHeaderSyntax   :: p ::: HeaderSyntax+  , hcHeaderSyntax     :: p ::: HeaderSyntax   -- ^ syntax of the license header comment   } @@ -398,37 +395,31 @@ deriving instance Eq PtHeaderConfig deriving instance Show CtHeaderConfig deriving instance Show PtHeaderConfig+deriving instance Generic PtHeaderConfig +deriving via (Generically PtHeaderConfig)+         instance Semigroup PtHeaderConfig+deriving via (Generically PtHeaderConfig)+         instance Monoid PtHeaderConfig+ instance FromJSON PtHeaderConfig where   parseJSON = withObject "PartialHeaderConfig" $ \obj -> do-    hcFileExtensions <- Last <$> obj .:? "file-extensions"-    hcMarginAfter    <- Last <$> obj .:? "margin-after"-    hcMarginBefore   <- Last <$> obj .:? "margin-before"-    hcPutAfter       <- Last <$> obj .:? "put-after"-    hcPutBefore      <- Last <$> obj .:? "put-before"-    blockComment     <- obj .:? "block-comment"-    lineComment      <- obj .:? "line-comment"-    hcHeaderSyntax   <- pure . Last $ headerSyntax blockComment lineComment+    hcFileExtensions   <- Last <$> obj .:? "file-extensions"+    hcMarginTopCode    <- Last <$> obj .:? "margin-top-code"+    hcMarginTopFile    <- Last <$> obj .:? "margin-top-file"+    hcMarginBottomCode <- Last <$> obj .:? "margin-bottom-code"+    hcMarginBottomFile <- Last <$> obj .:? "margin-bottom-file"+    hcPutAfter         <- Last <$> obj .:? "put-after"+    hcPutBefore        <- Last <$> obj .:? "put-before"+    blockComment       <- obj .:? "block-comment"+    lineComment        <- obj .:? "line-comment"+    hcHeaderSyntax     <- pure . Last $ syntax blockComment lineComment     pure HeaderConfig { .. }    where-    headerSyntax (Just (BlockComment' s e)) Nothing = Just $ BlockComment s e-    headerSyntax Nothing (Just (LineComment' p)) = Just $ LineComment p-    headerSyntax Nothing Nothing = Nothing-    headerSyntax _ _ = throw MixedHeaderSyntax--instance Monoid PtHeaderConfig where-  mempty = HeaderConfig mempty mempty mempty mempty mempty mempty--instance Semigroup PtHeaderConfig where-  x <> y = HeaderConfig-    { hcFileExtensions = hcFileExtensions x <> hcFileExtensions y-    , hcMarginAfter    = hcMarginAfter x <> hcMarginAfter y-    , hcMarginBefore   = hcMarginBefore x <> hcMarginBefore y-    , hcPutAfter       = hcPutAfter x <> hcPutAfter y-    , hcPutBefore      = hcPutBefore x <> hcPutBefore y-    , hcHeaderSyntax   = hcHeaderSyntax x <> hcHeaderSyntax y-    }-+    syntax (Just (BlockComment' s e)) Nothing = Just $ BlockComment s e Nothing+    syntax Nothing (Just (LineComment' p)) = Just $ LineComment p Nothing+    syntax Nothing Nothing = Nothing+    syntax _ _ = throw MixedHeaderSyntax  --------------------------------  HeadersConfig  ------------------------------- @@ -468,7 +459,13 @@ deriving instance Eq PtHeadersConfig deriving instance Show CtHeadersConfig deriving instance Show PtHeadersConfig+deriving instance Generic PtHeadersConfig +deriving via (Generically PtHeadersConfig)+         instance Semigroup PtHeadersConfig+deriving via (Generically PtHeadersConfig)+         instance Monoid PtHeadersConfig+ instance FromJSON PtHeadersConfig where   parseJSON = withObject "PartialHeadersConfig" $ \obj -> do     hscC          <- obj .:? "c" .!= mempty@@ -485,35 +482,6 @@     pure HeadersConfig { .. }  -instance Semigroup PtHeadersConfig where-  x <> y = HeadersConfig { hscC          = hscC x <> hscC y-                         , hscCpp        = hscCpp x <> hscCpp y-                         , hscCss        = hscCss x <> hscCss y-                         , hscHaskell    = hscHaskell x <> hscHaskell y-                         , hscHtml       = hscHtml x <> hscHtml y-                         , hscJava       = hscJava x <> hscJava y-                         , hscJs         = hscJs x <> hscJs y-                         , hscPureScript = hscPureScript x <> hscPureScript y-                         , hscRust       = hscRust x <> hscRust y-                         , hscScala      = hscScala x <> hscScala y-                         , hscShell      = hscShell x <> hscShell y-                         }---instance Monoid PtHeadersConfig where-  mempty = HeadersConfig mempty-                         mempty-                         mempty-                         mempty-                         mempty-                         mempty-                         mempty-                         mempty-                         mempty-                         mempty-                         mempty-- ---------------------------------  Error Types  --------------------------------  -- | Represents single key in the configuration.@@ -522,10 +490,14 @@   -- ^ no configuration for @file-extensions@   | CkHeaderSyntax FileType   -- ^ no configuration for header syntax-  | CkMarginAfter FileType-  -- ^ no configuration for @margin-after@-  | CkMarginBefore FileType-  -- ^ no configuration for @margin-before@+  | CkMarginTopCode FileType+  -- ^ no configuration for margin between header top and preceding code+  | CkMarginTopFile FileType+  -- ^ no configuration for margin between header top and start of file+  | CkMarginBottomCode FileType+  -- ^ no configuration for margin between header bottom and following code+  | CkMarginBottomFile FileType+  -- ^ no configuration for margin between header bottom and end of file   | CkPutAfter FileType   -- ^ no configuration for @put-after@   | CkPutBefore FileType@@ -558,6 +530,7 @@   toException      = toHeadroomError   fromException    = fromHeadroomError + displayException' :: ConfigurationError -> String displayException' = T.unpack . \case   MissingConfiguration key -> case key of@@ -569,13 +542,22 @@       (withFT "comment-syntax" fileType)       (Just "block-comment|line-comment")       Nothing-    CkMarginAfter fileType -> missingConfig (withFT "margin-after" fileType)-                                            (Just "margin-after")-                                            Nothing-    CkMarginBefore fileType -> missingConfig-      (withFT "margin-before" fileType)-      (Just "margin-before")+    CkMarginTopCode fileType -> missingConfig+      (withFT "margin-top-code" fileType)+      (Just "margin-top-code")       Nothing+    CkMarginTopFile fileType -> missingConfig+      (withFT "margin-top-file" fileType)+      (Just "margin-top-file")+      Nothing+    CkMarginBottomCode fileType -> missingConfig+      (withFT "margin-bottom-code" fileType)+      (Just "margin-bottom-code")+      Nothing+    CkMarginBottomFile fileType -> missingConfig+      (withFT "margin-bottom-file" fileType)+      (Just "margin-bottom-file")+      Nothing     CkPutAfter fileType ->       missingConfig (withFT "put-after" fileType) (Just "put-after") Nothing     CkPutBefore fileType ->@@ -602,24 +584,21 @@     CkEnabled -> missingConfig "enabled" (Just "enabled") Nothing   MixedHeaderSyntax -> mixedHeaderSyntax  where-  withFT msg fileType = msg <> " (" <> T.pack (show fileType) <> ")"-  mixedHeaderSyntax = mconcat-    [ "Invalid configuration, combining 'block-comment' with 'line-comment' "-    , "is not allowed. Either use 'block-comment' to define multi-line "-    , "comment header, or 'line-comment' to define header composed of "-    , "multiple single-line comments."-    ]+  withFT msg fileType = [i|#{msg :: Text} (#{fileType})|]+  mixedHeaderSyntax = [iii|+      Invalid configuration, combining 'block-comment' with 'line-comment'+      is not allowed. Either use 'block-comment' to define multi-line+      comment header, or 'line-comment' to define header composed of+      multiple single-line comments.+    |]   missingConfig :: Text -> Maybe Text -> Maybe Text -> Text-missingConfig desc yaml cli = mconcat-  [ "Missing configuration for '"-  , desc-  , "' ("-  , options-  , "). See official documentation for more details."-  ]+missingConfig desc yaml cli = [iii|+    Missing configuration for '#{desc}' (#{options}). See following page for+    more details: #{webDocConfigCurr}+  |]  where-  cliText  = fmap (\c -> "command line option '" <> c <> "'") cli-  yamlText = fmap (\y -> "YAML option '" <> y <> "'") yaml+  cliText  = fmap (\c -> [i|command line option '#{c}'|]) cli+  yamlText = fmap (\c -> [i|YAML option '#{c}'|]) yaml   options  = T.intercalate " or " . catMaybes $ [cliText, yamlText]

@@ -0,0 +1,43 @@+{-# LANGUAGE NoImplicitPrelude #-}++{-|+Module      : Headroom.Data.Coerce+Description : Extra functionality for coercion+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++This module provides some extra functionality extending the "Data.Coerce"+module.+-}++module Headroom.Data.Coerce+  ( coerce+  , inner+  )+where++import           Data.Coerce                         ( Coercible+                                                     , coerce+                                                     )+import           RIO+++-- | Allows to map the coercible value. This might be useful for example to+-- change the value within @newtype@, without manually unwrapping and wrapping+-- the value.+--+-- >>> import qualified RIO.Text as T+-- >>> newtype Foo = Foo Text deriving (Eq, Show)+-- >>> inner T.toUpper (Foo "hello")+-- Foo "HELLO"+inner :: (Coercible a b)+      => (b -> b)+      -- ^ function to modify coerced value+      -> a+      -- ^ value to modify+      -> a+      -- ^ modified value+inner f = coerce . f . coerce

@@ -6,21 +6,22 @@ {-| Module      : Headroom.Data.EnumExtra Description : Extra functionality for enum types-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental Portability : POSIX -Provides extended functionality for enum-like types, e.g. reading/writing+Provides extra functionality for enum-like types, e.g. reading/writing from/to textual representation, etc. -}  module Headroom.Data.EnumExtra where  import           RIO-import qualified RIO.List                      as L-import qualified RIO.Text                      as T+import qualified RIO.List                           as L+import qualified RIO.Text                           as T+  -- | Enum data type, capable to (de)serialize itself from/to string -- representation. Can be automatically derived by /GHC/ using the

@@ -4,7 +4,7 @@ {-| Module      : Headroom.Data.Has Description : Simplified variant of @Data.Has@-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -21,17 +21,24 @@  import           RIO + -- | Implementation of the /Has type class/ pattern. class Has a t where+   {-# MINIMAL getter, modifier | hasLens #-}++   getter :: t -> a   getter = getConst . hasLens Const +   modifier :: (a -> a) -> t -> t   modifier f t = runIdentity (hasLens (Identity . f) t) +   hasLens :: Lens' t a   hasLens afa t = (\a -> modifier (const a) t) <$> afa (getter t)+    viewL :: MonadReader t m => m a   viewL = view hasLens

@@ -3,7 +3,7 @@ {-| Module      : Headroom.Data.Lens Description : Custom functionality related to /lens/-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -18,14 +18,14 @@   ) where -import qualified Language.Haskell.TH.Lib       as TH-import qualified Language.Haskell.TH.Syntax    as TH-import           Lens.Micro.TH                  ( DefName(..)-                                                , lensField-                                                , lensRules-                                                , lensRulesFor-                                                , makeLensesWith-                                                )+import qualified Language.Haskell.TH.Lib            as TH+import qualified Language.Haskell.TH.Syntax         as TH+import           Lens.Micro.TH                       ( DefName(..)+                                                     , lensField+                                                     , lensRules+                                                     , lensRulesFor+                                                     , makeLensesWith+                                                     ) import           RIO  

@@ -9,7 +9,7 @@ {-| Module      : Headroom.Data.Regex Description : Helper functions for regular expressions-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -26,34 +26,48 @@     -- * Regex Functions   , compile   , match+  , isMatch   , re   , replace+  , replaceFirst   , scan     -- * Unsafe Functions   , compileUnsafe   ) where -import           Data.Aeson                     ( FromJSON(..)-                                                , Value(String)-                                                )-import           Headroom.Types                 ( fromHeadroomError-                                                , toHeadroomError-                                                )-import           Language.Haskell.TH     hiding ( match )-import           Language.Haskell.TH.Quote      ( QuasiQuoter(..) )+import           Data.Aeson                          ( FromJSON(..)+                                                     , Value(String)+                                                     )+import           Data.String.Interpolate             ( iii )+import           Headroom.Data.Coerce                ( coerce )+import           Headroom.Types                      ( fromHeadroomError+                                                     , toHeadroomError+                                                     )+import           Language.Haskell.TH.Quote           ( QuasiQuoter(..) ) import           RIO-import qualified RIO.Text                      as T-import qualified Text.Regex.PCRE.Heavy         as PH-import qualified Text.Regex.PCRE.Light         as PL-import qualified Text.Regex.PCRE.Light.Char8   as PLC+import qualified RIO.Text                           as T+import qualified Text.Regex.PCRE.Heavy              as PH+import qualified Text.Regex.PCRE.Light              as PL+import qualified Text.Regex.PCRE.Light.Base         as PL+                                                     ( Regex(..) )+import qualified Text.Regex.PCRE.Light.Char8        as PLC   ---------------------------------  DATA TYPES  ---------------------------------  -- | Represents compiled /regex/, encapsulates the actual implementation.-newtype Regex = Regex PL.Regex deriving (Eq, Show)+newtype Regex = Regex PL.Regex ++instance Eq Regex where+  Regex (PL.Regex _ r1) == Regex (PL.Regex _ r2) = r1 == r2+++instance Show Regex where+  show (Regex (PL.Regex _ r)) = show r++ instance FromJSON Regex where   parseJSON (String s) = pure . compileUnsafe $ s   parseJSON val = error $ "Invalid value: expected regex, found: " <> show val@@ -73,7 +87,7 @@   where compile' = Regex <$> PH.compileM (encodeUtf8 raw) [PLC.utf8]  --- | Same as 'match', but works with 'Text' and uses no additional options.+-- | Same as 'PLC.match', but works with 'Text' and uses no additional options. match :: Regex       -- ^ a PCRE regular expression value produced by compile       -> Text@@ -83,6 +97,17 @@ match (Regex r) subject = fmap T.pack <$> PLC.match r (T.unpack subject) []  +-- | Same as 'match', but instead of returning matched text it only indicates+-- whether the given text matches the pattern or not.+isMatch :: Regex+        -- ^ a PCRE regular expression value produced by compile+        -> Text+        -- ^ the subject text to match against+        -> Bool+        -- ^ the result value+isMatch regex subject = isJust $ match regex subject++ -- | A QuasiQuoter for regular expressions that does a compile time check. re :: QuasiQuoter re = QuasiQuoter { quoteExp  = quoteExpRegex@@ -90,20 +115,35 @@                  , quoteType = undefined                  , quoteDec  = undefined                  }+ where+  quoteExpRegex txt = [| compileUnsafe . T.pack $ txt |]+    where !_ = compileUnsafe . T.pack $ txt -- check at compile time   -- | Replaces all occurences of given /regex/. replace :: Regex-        -- ^ /regex/ to match what to replace+        -- ^ pattern to replace         -> (Text -> [Text] -> Text)         -- ^ replacement function (as @fullMatch -> [groups] -> result@)         -> Text         -- ^ text to replace in         -> Text         -- ^ resulting text-replace (Regex regex) = PH.gsub regex+replace = PH.gsub . coerce  +-- | Replaces only first occurence of given /regex/.+replaceFirst :: Regex+             -- ^ pattern to replace+             -> (Text -> [Text] -> Text)+             -- ^ replacement function (as @fullMatch -> [groups] -> result@)+             -> Text+             -- ^ text to replace in+             -> Text+             -- ^ resulting text+replaceFirst = PH.sub . coerce++ -- | Searches the text for all occurences of given /regex/. scan :: Regex      -- ^ /regex/ to search for@@ -111,7 +151,7 @@      -- ^ input text      -> [(Text, [Text])]      -- ^ found occurences (as @[(fullMatch, [groups])]@)-scan (Regex regex) = PH.scan regex+scan = PH.scan . coerce   -- | Compiles the given text into /regex/ in runtime. Note that if the /regex/@@ -126,14 +166,7 @@   Right res -> res  -------------------------------  PRIVATE FUNCTIONS  -------------------------------quoteExpRegex :: String -> ExpQ-quoteExpRegex txt = [| compileUnsafe . T.pack $ txt |]-  where !_ = compileUnsafe . T.pack $ txt -- check at compile time------------------------------------  Error Types  --------------------------------+---------------------------------  ERROR TYPES  --------------------------------  -- | Exception specific to the "Headroom.Data.Regex" module. data RegexError = CompilationFailed Text Text@@ -146,6 +179,7 @@   fromException    = fromHeadroomError  displayException' :: RegexError -> String-displayException' = T.unpack . \case-  CompilationFailed raw reason ->-    mconcat ["Cannot compile regex from input '", raw, "', reason: ", reason]+displayException' = \case+  CompilationFailed raw reason -> [iii|+      Cannot compile regex from input '#{raw}', reason: #{reason}+    |]

@@ -0,0 +1,165 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Headroom.Data.Text+Description : Additional utilities for text manipulation+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++Module containing bunch of useful functions for working with text.+-}++module Headroom.Data.Text+  ( read+  , commonLinesPrefix+  , replaceFirst+    -- * Working with text lines+  , mapLines+  , mapLinesF+  , fromLines+  , toLines+  )+where++import           RIO+import qualified RIO.Text                           as T+import qualified RIO.Text.Partial                   as TP+++------------------------------  PUBLIC FUNCTIONS  ------------------------------++-- | Similar to 'T.commonPrefixes', but tries to find common prefix for all+-- lines in given text.+--+-- >>> commonLinesPrefix "-- first\n-- second\n-- third"+-- Just "-- "+commonLinesPrefix :: Text+                  -- ^ lines of text to find prefix for+                  -> Maybe Text+                  -- ^ found longest common prefixs+commonLinesPrefix text = go (toLines text) Nothing+ where+  go []       acc        = acc+  go (x : xs) Nothing    = go xs (Just x)+  go (x : xs) (Just acc) = case T.commonPrefixes x acc of+    Just (n, _, _) -> go xs (Just n)+    _              -> Nothing+++-- | Similar to 'T.replace', but replaces only very first occurence of pattern.+--+-- >>> replaceFirst ":" "/" "a : b : c"+-- "a / b : c"+replaceFirst :: Text -> Text -> Text -> Text+replaceFirst ptrn substitution text | T.null ptrn || T.null back = text+                                    | otherwise                  = processed+ where+  (front, back) = TP.breakOn ptrn text+  processed     = mconcat [front, substitution, T.drop (T.length ptrn) back]+++-- | Maps given function over individual lines of the given text.+--+-- >>> mapLines ("T: " <>) "foo zz\nbar"+-- "T: foo zz\nT: bar"+mapLines :: (Text -> Text)+         -- ^ function to map over individual lines+         -> Text+         -- ^ input text+         -> Text+         -- ^ resulting text+mapLines fn = mapLinesF (Just <$> fn)+++-- | Similar to 'mapLines', but the mapping function returns 'Foldable', which+-- gives some more control over outcome. After mapping over all individual+-- lines, results are folded and concatenated, which allows for example+-- filtering out some lines.+--+-- >>> mapLinesF (\l -> if l == "bar" then Nothing else Just l) "foo\nbar"+-- "foo"+mapLinesF :: Foldable t+          => (Text -> t Text)+          -- ^ function to map over inividual lines+          -> Text+          -- ^ input text+          -> Text+          -- ^ resulting text+mapLinesF f = fromLines . concat . (toList <$>) . go . toLines+ where+  go []       = []+  go (x : xs) = f x : go xs+++-- | Same as 'readMaybe', but takes 'Text' as input instead of 'String'.+--+-- >>> read "123" :: Maybe Int+-- Just 123+read :: Read a+     => Text+     -- ^ input text to parse+     -> Maybe a+     -- ^ parsed value+read = readMaybe . T.unpack+++-- | Similar to 'T.unlines', but does not automatically adds @\n@ at the end+-- of the text. Advantage is that when used together with 'toLines', it doesn't+-- ocassionaly change the newlines ad the end of input text:+--+-- >>> fromLines . toLines $ "foo\nbar"+-- "foo\nbar"+--+-- >>> fromLines . toLines $ "foo\nbar\n"+-- "foo\nbar\n"+--+-- Other examples:+--+-- >>> fromLines []+-- ""+--+-- >>> fromLines ["foo"]+-- "foo"+--+-- >>> fromLines ["first", "second"]+-- "first\nsecond"+--+-- >>> fromLines ["first", "second", ""]+-- "first\nsecond\n"+fromLines :: [Text]+          -- ^ lines to join+          -> Text+          -- ^ text joined from individual lines+fromLines = T.intercalate "\n"+++-- | Similar to 'T.lines', but does not drop trailing newlines from output.+-- Advantage is that when used together with 'fromLines', it doesn't ocassionaly+-- change the newlines ad the end of input text:+--+-- >>> fromLines . toLines $ "foo\nbar"+-- "foo\nbar"+--+-- >>> fromLines . toLines $ "foo\nbar\n"+-- "foo\nbar\n"+--+-- Other examples:+--+-- >>> toLines ""+-- []+--+-- >>> toLines "first\nsecond"+-- ["first","second"]+--+-- >>> toLines "first\nsecond\n"+-- ["first","second",""]+toLines :: Text+        -- ^ text to break into lines+        -> [Text]+        -- ^ lines of input text+toLines input | T.null input = []+              | otherwise    = T.split (== '\n') input

@@ -1,112 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--{-|-Module      : Headroom.Data.TextExtra-Description : Additional utilities for text manipulation-Copyright   : (c) 2019-2020 Vaclav Svejcar-License     : BSD-3-Clause-Maintainer  : vaclav.svejcar@gmail.com-Stability   : experimental-Portability : POSIX--Module containing bunch of useful functions for working with text.--}--module Headroom.Data.TextExtra-  ( read-    -- * Working with text lines-  , mapLines-  , fromLines-  , toLines-  )-where--import           RIO-import qualified RIO.Text                      as T----- | Maps given function over individual lines of the given text.------ >>> mapLines ("T: " <>) "foo zz\nbar"--- "T: foo zz\nT: bar"-mapLines :: (Text -> Text)-         -- ^ function to map over individual lines-         -> Text-         -- ^ input text-         -> Text-         -- ^ result text-mapLines fn = fromLines . go . toLines- where-  go []       = []-  go (x : xs) = fn x : go xs----- | Same as 'readMaybe', but takes 'Text' as input instead of 'String'.------ >>> read "123" :: Maybe Int--- Just 123-read :: Read a-     => Text-     -- ^ input text to parse-     -> Maybe a-     -- ^ parsed value-read = readMaybe . T.unpack----- | Similar to 'T.unlines', but does not automatically adds @\n@ at the end--- of the text. Advantage is that when used together with 'toLines', it doesn't--- ocassionaly change the newlines ad the end of input text:------ >>> fromLines . toLines $ "foo\nbar"--- "foo\nbar"------ >>> fromLines . toLines $ "foo\nbar\n"--- "foo\nbar\n"------ Other examples:------ >>> fromLines []--- ""------ >>> fromLines ["foo"]--- "foo"------ >>> fromLines ["first", "second"]--- "first\nsecond"------ >>> fromLines ["first", "second", ""]--- "first\nsecond\n"-fromLines :: [Text]-          -- ^ lines to join-          -> Text-          -- ^ text joined from individual lines-fromLines = T.intercalate "\n"----- | Similar to 'T.lines', but does not drop trailing newlines from output.--- Advantage is that when used together with 'fromLines', it doesn't ocassionaly--- change the newlines ad the end of input text:------ >>> fromLines . toLines $ "foo\nbar"--- "foo\nbar"------ >>> fromLines . toLines $ "foo\nbar\n"--- "foo\nbar\n"------ Other examples:------ >>> toLines ""--- []------ >>> toLines "first\nsecond"--- ["first","second"]------ >>> toLines "first\nsecond\n"--- ["first","second",""]-toLines :: Text-        -- ^ text to break into lines-        -> [Text]-        -- ^ lines of input text-toLines input | T.null input = []-              | otherwise    = T.split (== '\n') input

@@ -5,7 +5,7 @@ {-| Module      : Headroom.Embedded Description : Embedded files-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -21,12 +21,12 @@   ) where -import           Headroom.Configuration.Types   ( LicenseType(..) )-import           Headroom.Embedded.TH           ( embedConfigFile-                                                , embedDefaultConfig-                                                , embedTemplate-                                                )-import           Headroom.FileType.Types        ( FileType(..) )+import           Headroom.Configuration.Types        ( LicenseType(..) )+import           Headroom.Embedded.TH                ( embedConfigFile+                                                     , embedDefaultConfig+                                                     , embedTemplate+                                                     )+import           Headroom.FileType.Types             ( FileType(..) ) import           RIO  

@@ -4,7 +4,7 @@ {-| Module      : Headroom.Embedded.TH Description : /Template Haskell/ functions for "Headroom.Embedded"-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -22,18 +22,18 @@   ) where -import           Data.FileEmbed                 ( embedStringFile )-import           Headroom.Configuration.Types   ( LicenseType(..) )-import           Headroom.Data.EnumExtra        ( EnumExtra(..) )-import           Headroom.FileType.Types        ( FileType(..) )-import           Headroom.Meta                  ( TemplateType )-import           Headroom.Template              ( Template(..) )-import           Language.Haskell.TH.Syntax     ( Exp-                                                , Q-                                                )+import           Data.FileEmbed                      ( embedStringFile )+import           Headroom.Configuration.Types        ( LicenseType(..) )+import           Headroom.Data.EnumExtra             ( EnumExtra(..) )+import           Headroom.FileType.Types             ( FileType(..) )+import           Headroom.Meta                       ( TemplateType )+import           Headroom.Template                   ( Template(..) )+import           Language.Haskell.TH.Syntax          ( Exp+                                                     , Q+                                                     ) import           RIO-import qualified RIO.NonEmpty                  as NE-import qualified RIO.Text                      as T+import qualified RIO.NonEmpty                       as NE+import qualified RIO.Text                           as T   -- | Embeds stub configuration file to source code.

@@ -1,72 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--{-|-Module      : Headroom.Ext-Description : Extended support for selected /file types/-Copyright   : (c) 2019-2020 Vaclav Svejcar-License     : BSD-3-Clause-Maintainer  : vaclav.svejcar@gmail.com-Stability   : experimental-Portability : POSIX--/Headroom/ provides /extended support/ for selected /file types/, which mean-not only basic management of /license headers/ based on /template files/ is-provided, but also some additional functionality is available. For example,-some extra data may be extracted from the processed /source code file/ and made-available to template via /template variables/-(e.g. /module name/ for /Haskell source code files/).--}--module Headroom.Ext-  ( extractVariables-  , extractTemplateMeta-  )-where--import           Headroom.Configuration.Types   ( CtHeaderConfig )-import qualified Headroom.Ext.Haskell          as Haskell-import qualified Headroom.Ext.Java             as Java-import qualified Headroom.Ext.PureScript       as PureScript-import           Headroom.FileType.Types        ( FileType(..) )-import           Headroom.Template              ( Template(..) )-import           Headroom.Types                 ( TemplateMeta(..) )-import           Headroom.Variables.Types       ( Variables(..) )-import           RIO----- | Extracts variables specific to the file type (if supported), e.g. module--- name for /Haskell/ source code. Currently supported file types are:------ * /Haskell/ - implemented in "Headroom.Ext.Haskell"--- * /Java/ - implemented in "Headroom.Ext.Java"--- * /PureScript/ - implemented in "Headroom.Ext.PureScript"-extractVariables :: FileType-                 -- ^ type of the file-                 -> CtHeaderConfig-                 -- ^ license header configuration-                 -> Maybe TemplateMeta-                 -- ^ extracted metadata from corresponding /template/-                 -> Maybe (Int, Int)-                 -- ^ license header position @(startLine, endLine)@-                 -> Text-                 -- ^ text of the source code file-                 -> Variables-                 -- ^ extracted variables-extractVariables fileType = case fileType of-  Haskell    -> Haskell.extractVariables-  Java       -> Java.extractVariables-  PureScript -> PureScript.extractVariables-  _          -> mempty----- | Extracts medatata from given /template/ for selected /file type/, which--- might be later required by the 'extractVariables' function.-extractTemplateMeta :: (Template t)-                    => FileType-                    -- ^ /file type/ for which this template will be used-                    -> t-                    -- ^ parsed /template/-                    -> Maybe TemplateMeta-                    -- ^ extracted template metadata-extractTemplateMeta Haskell tmpl = Just $ Haskell.extractTemplateMeta tmpl-extractTemplateMeta _       _    = Nothing

@@ -1,111 +0,0 @@-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes       #-}-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TupleSections     #-}--{-|-Module      : Headroom.Ext.Haskell-Description : Extended support for /Haskell/ source code files-Copyright   : (c) 2019-2020 Vaclav Svejcar-License     : BSD-3-Clause-Maintainer  : vaclav.svejcar@gmail.com-Stability   : experimental-Portability : POSIX--This module provides support for extracting /Haskell/-specific info from the-parsed /source code files/ as /template variables/. Such info includes-/module name/ and selected fields from /Haddock module header/-(see "Headroom.FileSupport.Haskell.Haddock").--}--module Headroom.Ext.Haskell-  ( -- * Variables Extraction-    extractModuleName-  , extractVariables-    -- * Template Metadata Extraction-  , extractTemplateMeta-  )-where--import           Headroom.Configuration.Types   ( CtHeaderConfig )-import           Headroom.Data.Regex            ( match-                                                , re-                                                )-import           Headroom.Data.TextExtra        ( fromLines-                                                , toLines-                                                )-import           Headroom.Ext.Haskell.Haddock   ( HaddockModuleHeader(..)-                                                , extractFieldOffsets-                                                , extractModuleHeader-                                                )-import           Headroom.Template              ( Template(..) )-import           Headroom.Types                 ( TemplateMeta(..) )-import           Headroom.Variables             ( mkVariables )-import           Headroom.Variables.Types       ( Variables(..) )-import           RIO-import           RIO.Lens                       ( ix )-import qualified RIO.List                      as L----- | Extracts name of /Haskell/ module from given source code file content.------ >>> extractModuleName "{-# LANGUAGE OverloadedStrings #-}\nmodule Foo where"--- Just "Foo"-extractModuleName :: Text-                  -- ^ input text-                  -> Maybe Text-                  -- ^ extracted module name-extractModuleName = go . toLines- where-  go []       = Nothing-  go (x : xs) = maybe (go xs) (^? ix 1) (match [re|^module\s+(\S+)|] x)----- | Extracts variables from /Haskell/ source code.------ __List of Extracted Variables:__------ * @___haskell_module_copyright__@ - @Copyright@ field of /Haddock/ module header--- * @___haskell_module_license__@ - @License@ field of /Haddock/ module header--- * @___haskell_module_maintainer__@ - @Maintainer@ field of /Haddock/ module header--- * @___haskell_module_portability__@ - @Portability@ field of /Haddock/ module header--- * @___haskell_module_stability__@ - @Stability@ field of /Haddock/ module header--- * @___haskell_module_name__@ - name of the /Haskell/ module--- * @___haskell_module_longdesc__@ - long description of /Haddock/ module--- * @___haskell_module_shortdesc__@ - @Description@ field of /Haddock/ module header-extractVariables :: CtHeaderConfig-                 -- ^ license header configuration-                 -> Maybe TemplateMeta-                 -- ^ extracted metadata from corresponding /template/-                 -> Maybe (Int, Int)-                 -- ^ license header position @(startLine, endLine)@-                 -> Text-                 -- ^ input text-                 -> Variables-                 -- ^ extracted variables-extractVariables _ meta headerPos text = (mkVariables . catMaybes)-  [ ("_haskell_module_copyright", ) <$> hmhCopyright-  , ("_haskell_module_license", ) <$> hmhLicense-  , ("_haskell_module_maintainer", ) <$> hmhMaintainer-  , ("_haskell_module_name", ) <$> extractModuleName text-  , ("_haskell_module_portability", ) <$> hmhPortability-  , ("_haskell_module_stability", ) <$> hmhStability-  , ("_haskell_module_longdesc", ) <$> hmhLongDesc-  , ("_haskell_module_shortdesc", ) <$> hmhShortDesc-  ]- where-  HaddockModuleHeader {..} = extractModuleHeader headerText meta-  headerText               = maybe "" (\(s, e) -> cut s e text) headerPos-  cut s e = fromLines . L.take (e - s) . L.drop s . toLines----- | Extracts template metadata specific for /Haskell/.-extractTemplateMeta :: (Template t)-                    => t-                    -- ^ parsed /template/-                    -> TemplateMeta-                    -- ^ extracted template metadata-extractTemplateMeta template = HaskellTemplateMeta offsets-  where offsets = extractFieldOffsets template

@@ -1,286 +0,0 @@-{-# LANGUAGE DeriveFunctor     #-}-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes       #-}-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE StrictData        #-}--{-|-Module      : Headroom.Ext.Haskell.Haddock-Description : Extraction of /Haddock module header/ fields-Copyright   : (c) 2019-2020 Vaclav Svejcar-License     : BSD-3-Clause-Maintainer  : vaclav.svejcar@gmail.com-Stability   : experimental-Portability : POSIX--Support for extracting data from /Haddock module headers/ present in-/Haskell source code files/ or /templates/.--}--module Headroom.Ext.Haskell.Haddock-  ( HaddockModuleHeader(..)-  , extractFieldOffsets-  , extractModuleHeader-  , indentField-  , stripCommentSyntax-  )-where--import           Control.Applicative            ( Alternative(..) )-import           Control.Monad                  ( ap )-import           Data.Default.Class             ( Default(..) )-import           Headroom.Data.Regex            ( re-                                                , replace-                                                , scan-                                                )-import           Headroom.Data.TextExtra        ( fromLines-                                                , toLines-                                                )-import           Headroom.Template              ( Template(..) )-import           Headroom.Types                 ( HaddockFieldOffsets(..)-                                                , TemplateMeta(..)-                                                )-import           RIO-import qualified RIO.Char                      as C-import qualified RIO.Text                      as T----- | Extracted fields from the /Haddock module header/.-data HaddockModuleHeader = HaddockModuleHeader-  { hmhCopyright   :: Maybe Text-  -- ^ module copyright (content of the @Copyright@ field)-  , hmhLicense     :: Maybe Text-  -- ^ module license (content of the @License@ field)-  , hmhMaintainer  :: Maybe Text-  -- ^ module license (content of the @Maintainer@ field)-  , hmhPortability :: Maybe Text-  -- ^ module license (content of the @Portability@ field)-  , hmhStability   :: Maybe Text-  -- ^ module license (content of the @Stability@ field)-  , hmhShortDesc   :: Maybe Text-  -- ^ module short description (content of the @Description@ field)-  , hmhLongDesc    :: Maybe Text-  -- ^ module long description (the text after module header fields)-  }-  deriving (Eq, Show)----- | Extracts /offsets/ for selected haddock fields (i.e. number of chars--- between start of line and field value). This is needed to properly format--- multi-line field values rendered in new /license headers/.-extractFieldOffsets :: (Template t)-                    => t-                    -- ^ parsed /template/-                    -> HaddockFieldOffsets-                    -- ^ extracted field offsets-extractFieldOffsets template = HaddockFieldOffsets { .. }- where-  hfoCopyright = extractCopyrightOffset text-  text         = stripCommentSyntax . rawTemplate $ template---extractCopyrightOffset :: Text -> Maybe Int-extractCopyrightOffset text = case scan [re|\h*Copyright\h*:\h*|] text of-  [(full, _)] -> Just . T.length $ full-  _           -> Nothing----- | Extracts metadata from given /Haddock/ module header.-extractModuleHeader :: Text-                    -- ^ text containing /Haddock/ module header-                    -> Maybe TemplateMeta-                    -- ^ extracted metadata from corresponding /template/-                    -> HaddockModuleHeader-                    -- ^ extracted metadata-extractModuleHeader text meta =-  let hmhCopyright   = indent hfoCopyright <$> extractField "Copyright"-      hmhLicense     = extractField "License"-      hmhMaintainer  = extractField "Maintainer"-      hmhPortability = extractField "Portability"-      hmhStability   = extractField "Stability"-      hmhShortDesc   = extractField "Description"-      hmhLongDesc    = if null rest' then Nothing else process rest'-  in  HaddockModuleHeader { .. }- where-  (fields', rest') = fromMaybe ([], input) $ runP fields input-  input            = T.unpack . stripCommentSyntax $ text-  extractField name = fmap (T.strip . T.pack) (lookup name fields')-  process = Just . T.strip . T.pack-  indent c t = T.strip $ indentField c t-  HaddockFieldOffsets {..} = case meta of-    Just (HaskellTemplateMeta offsets') -> offsets'-    _ -> def----- | Adds correct indentation to multi-line /Haddock/ field values. It's usually--- desired to have such values indented like this:------ @--- Copyright        : (c) 2020, 1st Author---                    (c) 2020, 2nd Author--- @------ This functions achieves that using the /offset/ value, which specifies number--- of empty characters that should be placed before second (and any subsequent)--- line.------ >>> indentField (Just 2) "foo\nbar\nbaz"--- "foo\n  bar\n  baz"-indentField :: Maybe Int-            -- ^ offset (in number of black chars) for 2nd and subsequent lines-            -> Text-            -- ^ input text to indent-            -> Text-            -- ^ processed text-indentField Nothing       text = text-indentField (Just offset) text = fromLines . go . toLines $ text- where-  go []       = []-  go [x     ] = [x]-  go (x : xs) = x : fmap ((prefix <>) . T.stripStart) xs-  prefix = T.replicate offset " "----- | Strips /Haskell/ comment syntax tokens (e.g. @{-@, @-}@) from input text.------ >>> stripCommentSyntax "{- foo -}\nbar\n"--- "foo \nbar\n"-stripCommentSyntax :: Text-                   -- ^ input text to strip-                   -> Text-                   -- ^ resulting text without comment syntax tokens-stripCommentSyntax text = fromLines $ go (toLines text) []- where-  regex = [re|^(-- \||-{2,})|^\h*({-\h?\|?)|(-})\h*$|]-  strip = replace regex (const . const $ "")-  go []       acc = reverse acc-  go (x : xs) acc = go xs (strip x : acc)-------------------------------------------------------------------------------------- Below code is slightly modified version of code copied from:--- https://github.com/haskell/haddock/blob/ghc-8.10/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs----------------------------------------------------------------------------------- Small parser to parse module header.------------------------------------------------------------------------------------ The below is a small parser framework how we read keys.------ all fields in the header are optional and have the form------ [spaces1][field name][spaces] ":"---    [text]"\n" ([spaces2][space][text]"\n" | [spaces]"\n")*--- where each [spaces2] should have [spaces1] as a prefix.------ Thus for the key "Description",------ > Description : this is a--- >    rather long--- >--- >    description--- >--- > The module comment starts here------ the value will be "this is a .. description" and the rest will begin--- at "The module comment".---- 'C' is a 'Char' carrying its column.------ This let us make an indentation-aware parser, as we know current indentation.--- by looking at the next character in the stream ('curInd').------ Thus we can munch all spaces but only not-spaces which are indented.----data C = C {-# UNPACK #-} !Int Char--newtype P a = P { unP :: [C] -> Maybe ([C], a) }-  deriving Functor--instance Applicative P where-  pure x = P $ \s -> Just (s, x)-  (<*>) = ap--instance Monad P where-  return = pure-  m >>= k = P $ \s0 -> do-    (s1, x) <- unP m s0-    unP (k x) s1--instance Alternative P where-  empty = P $ const Nothing-  a <|> b = P $ \s -> unP a s <|> unP b s--runP :: P a -> String -> Maybe a-runP p input = fmap snd (unP p input')- where-  input' =-    concat [ zipWith C [0 ..] l <> [C (length l) '\n'] | l <- lines input ]----------------------------------------------------------------------------------------------------------------------------------------------------------------------curInd :: P Int-curInd = P $ \s -> Just . (,) s $ case s of-  []        -> 0-  C i _ : _ -> i--rest :: P String-rest = P $ \cs -> Just ([], [ c | C _ c <- cs ])--munch :: (Int -> Char -> Bool) -> P String-munch p = P $ \cs -> let (xs, ys) = takeWhileMaybe p' cs in Just (ys, xs)- where-  p' (C i c) | p i c     = Just c-             | otherwise = Nothing--munch1 :: (Int -> Char -> Bool) -> P String-munch1 p = P $ \case-  [] -> Nothing-  (c : cs)-    | Just c' <- p' c-    -> let (xs, ys) = takeWhileMaybe p' cs in Just (ys, c' : xs)-    | otherwise-    -> Nothing- where-  p' (C i c) | p i c     = Just c-             | otherwise = Nothing--char :: Char -> P Char-char c = P $ \case-  [] -> Nothing-  (C _ c' : cs) | c == c'   -> Just (cs, c)-                | otherwise -> Nothing--skipSpaces :: P ()-skipSpaces = P $ \cs -> Just (dropWhile (\(C _ c) -> C.isSpace c) cs, ())--takeWhileMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])-takeWhileMaybe f = go where-  go xs0@[]       = ([], xs0)-  go xs0@(x : xs) = case f x of-    Just y  -> let (ys, zs) = go xs in (y : ys, zs)-    Nothing -> ([], xs0)------------------------------------------------------------------------------------ Fields----------------------------------------------------------------------------------field :: Int -> P (String, String)-field i = do-  fn <- munch1 $ \_ c -> C.isAlpha c || c == '-'-  skipSpaces-  _ <- char ':'-  skipSpaces-  val <- munch $ \j c -> C.isSpace c || j > i-  return (fn, val)--fields :: P ([(String, String)], String)-fields = do-  skipSpaces-  i  <- curInd-  fs <- many (field i)-  r  <- rest-  return (fs, r)

@@ -1,68 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes       #-}-{-# LANGUAGE TupleSections     #-}--{-|-Module      : Headroom.Ext.Java-Description : Extended support for /Java/ source code files-Copyright   : (c) 2019-2020 Vaclav Svejcar-License     : BSD-3-Clause-Maintainer  : vaclav.svejcar@gmail.com-Stability   : experimental-Portability : POSIX--This module provides /extended support/ for /Java/ source code files. Current-implementation includes extracting of /package name/ from currently processed-/Java/ source code file.--}--module Headroom.Ext.Java-  ( extractVariables-  , extractPackageName-  )-where--import           Headroom.Configuration.Types   ( CtHeaderConfig )-import           Headroom.Data.Regex            ( match-                                                , re-                                                )-import           Headroom.Data.TextExtra        ( toLines )-import           Headroom.Types                 ( TemplateMeta(..) )-import           Headroom.Variables             ( mkVariables )-import           Headroom.Variables.Types       ( Variables(..) )-import           RIO-import           RIO.Lens                       ( ix )----- | Extracts name of /Java/ package from given source code file content.------ >>> extractPackageName "package mypackage;\nclass Foo {}"--- Just "mypackage"-extractPackageName :: Text-                   -- ^ input text-                   -> Maybe Text-                   -- ^ extracted package name-extractPackageName = go . toLines- where-  go []       = Nothing-  go (x : xs) = maybe (go xs) (^? ix 1) (match [re|^package (.*);$|] x)----- | Extracts variables from /Java/ source code.------ __List of Extracted Variables:__------ * @___java_package_name__@ - name of the /Java/ package-extractVariables :: CtHeaderConfig-                 -- ^ license header configuration-                 -> Maybe TemplateMeta-                 -- ^ extracted metadata from corresponding /template/-                 -> Maybe (Int, Int)-                 -- ^ license header position @(startLine, endLine)@-                 -> Text-                 -- ^ input text-                 -> Variables-                 -- ^ extracted variables-extractVariables _ _ _ text = (mkVariables . catMaybes)-  [("_java_package_name", ) <$> extractPackageName text]

@@ -1,47 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections     #-}--{-|-Module      : Headroom.Ext.PureScript-Description : Extended support for /PureScript/ source code files-Copyright   : (c) 2019-2020 Vaclav Svejcar-License     : BSD-3-Clause-Maintainer  : vaclav.svejcar@gmail.com-Stability   : experimental-Portability : POSIX--This module provides /extended support/ for /PureScript/ source code files.-Current implementation includes extracting of /module name/ from currently-processed /PureScript/ source code file.--}--module Headroom.Ext.PureScript where--import           Headroom.Configuration.Types   ( CtHeaderConfig )-import           Headroom.Ext.Haskell           ( extractModuleName )-import           Headroom.Types                 ( TemplateMeta(..) )-import           Headroom.Variables             ( mkVariables )-import           Headroom.Variables.Types       ( Variables(..) )-import           RIO----- | Extracts variables from /PureScript/ source code.------ __List of Extracted Variables:__------ * @___purescript_module_name__@ - name of the /PureScript/ module-extractVariables :: CtHeaderConfig-                 -- ^ license header configuration-                 -> Maybe TemplateMeta-                 -- ^ extracted metadata from corresponding /template/-                 -> Maybe (Int, Int)-                 -- ^ license header position @(startLine, endLine)@-                 -> Text-                 -- ^ input text-                 -> Variables-                 -- ^ extracted variables-extractVariables _ _ _ text = (mkVariables . catMaybes)-  [("_purescript_module_name", ) <$> extractModuleName text]--

@@ -1,299 +1,95 @@+{-# LANGUAGE MultiWayIf        #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE ViewPatterns      #-}  {-| Module      : Headroom.FileSupport-Description : License header manipulation-Copyright   : (c) 2019-2020 Vaclav Svejcar+Description : Support for handling various source code file types+Copyright   : (c) 2019-2021 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/.+/Headroom/ currently supports working with file types defined in 'FileType'+type, and because every type of source code file requires different handling of+some aspects, this file type specific support is implemented for every supported+file type and exposed as instance of 'FileSupport' data type. -}  module Headroom.FileSupport-  ( -- * File info extraction-    extractFileInfo-    -- * License header manipulation-  , addHeader-  , dropHeader-  , replaceHeader-    -- * License header detection-  , findHeader-  , findBlockHeader-  , findLineHeader-  , firstMatching-  , lastMatching-  , splitInput+  ( fileSupport+  , analyzeSourceCode   ) 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           Control.Monad.State                 ( get+                                                     , put+                                                     )+import qualified Headroom.FileSupport.C             as C+import qualified Headroom.FileSupport.CPP           as CPP+import qualified Headroom.FileSupport.CSS           as CSS+import qualified Headroom.FileSupport.Haskell       as Haskell+import qualified Headroom.FileSupport.HTML          as HTML+import qualified Headroom.FileSupport.Java          as Java+import qualified Headroom.FileSupport.JS            as JS+import qualified Headroom.FileSupport.PureScript    as PureScript+import qualified Headroom.FileSupport.Rust          as Rust+import qualified Headroom.FileSupport.Scala         as Scala+import qualified Headroom.FileSupport.Shell         as Shell+import           Headroom.FileSupport.Types          ( FileSupport(..)+                                                     , SyntaxAnalysis(..)+                                                     )+import           Headroom.FileType.Types             ( FileType(..) )+import           Headroom.SourceCode                 ( LineType(..)+                                                     , SourceCode+                                                     , fromText+                                                     ) 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 fiFileType fiHeaderConfig meta text =-  let fiHeaderPos = findHeader fiHeaderConfig text-      fiVariables =-        extractVariables fiFileType fiHeaderConfig meta fiHeaderPos text-  in  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 | isJust fiHeaderPos = text-addHeader FileInfo {..} header text                 = result- where-  (before, middle, after) = splitInput hcPutAfter hcPutBefore text-  HeaderConfig {..}       = fiHeaderConfig-  before'                 = stripLinesEnd before-  middle'                 = stripLinesStart middle-  margin [] _    = []-  margin _  size = replicate size ""-  marginBefore = margin before' hcMarginBefore-  marginAfter  = margin (middle' <> after) hcMarginAfter-  result       = fromLines $ concat joined-  joined       = [before', marginBefore, [header], marginAfter, middle', 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 _ _ Nothing             _) text = text-dropHeader (FileInfo _ _ (Just (start, end)) _) text = result- where-  before     = take start inputLines-  after      = drop (end + 1) inputLines-  inputLines = toLines text-  result     = fromLines (stripLinesEnd before <> stripLinesStart 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 header = addHeader' . dropHeader'- where-  addHeader'     = addHeader infoWithoutPos header-  dropHeader'    = dropHeader fileInfo-  infoWithoutPos = set fiHeaderPosL Nothing 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 HeaderConfig {..} input = case hcHeaderSyntax of-  BlockComment start end -> findBlockHeader start end inLines splitAt-  LineComment prefix     -> findLineHeader prefix inLines splitAt- where-  (before, headerArea, _) = splitInput hcPutAfter hcPutBefore input-  splitAt                 = L.length before-  inLines                 = T.strip <$> 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 startsWith endsWith = go Nothing Nothing- where-  isStart = T.isPrefixOf startsWith-  isEnd   = T.isSuffixOf endsWith-  go _ _ (x : _) i | isStart x && isEnd x = Just (i, i)-  go _ _ (x : xs) i | isStart x           = go (Just i) Nothing xs (i + 1)-  go (Just start) _ (x : _) i | isEnd x   = Just (start, i)-  go start end (_ : xs) i                 = go start end xs (i + 1)-  go _     _   []       _                 = 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 prefix = go Nothing- where-  isPrefix = T.isPrefixOf prefix-  go Nothing (x : xs) i | isPrefix x      = go (Just i) xs (i + 1)-  go Nothing (_ : xs) i                   = go Nothing xs (i + 1)-  go (Just start) (x : xs) i | isPrefix x = go (Just start) xs (i + 1)-  go (Just start) _  i                    = Just (start, i - 1)-  go _            [] _                    = Nothing+import qualified RIO.Text                           as T  --- | 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 patterns input = go input 0- where-  cond x = any (\r -> isJust $ match r x) patterns-  go (x : _) i | cond x = Just i-  go (_ : xs) i         = go xs (i + 1)-  go []       _         = Nothing-+------------------------------  PUBLIC FUNCTIONS  ------------------------------ --- | 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 patterns input = go input 0 Nothing- where-  cond x = any (\r -> isJust $ match r x) patterns-  go (x : xs) i _ | cond x = go xs (i + 1) (Just i)-  go (_ : xs) i pos        = go xs (i + 1) pos-  go []       _ pos        = pos+-- | Returns 'FileSupport' for corresponding 'FileType'.+fileSupport :: FileType -> FileSupport+fileSupport C          = C.fileSupport+fileSupport CPP        = CPP.fileSupport+fileSupport CSS        = CSS.fileSupport+fileSupport Haskell    = Haskell.fileSupport+fileSupport HTML       = HTML.fileSupport+fileSupport Java       = Java.fileSupport+fileSupport JS         = JS.fileSupport+fileSupport PureScript = PureScript.fileSupport+fileSupport Rust       = Rust.fileSupport+fileSupport Scala      = Scala.fileSupport+fileSupport Shell      = Shell.fileSupport  --- | 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 []       []       input = ([], toLines input, [])-splitInput fstSplit sndSplit input = (before, middle, after)+-- | Analyzes the raw source code of given type using provided 'FileSupport'.+analyzeSourceCode :: FileSupport+                  -- ^ 'FileSupport' implementation used for analysis+                  -> Text+                  -- ^ raw source code to analyze+                  -> SourceCode+                  -- ^ analyzed source code+analyzeSourceCode fs = fromText state0 process  where-  (middle', after ) = L.splitAt sndSplitAt inLines-  (before , middle) = L.splitAt fstSplitAt middle'-  fstSplitAt        = maybe 0 (+ 1) (lastMatching fstSplit middle')-  sndSplitAt        = fromMaybe len (firstMatching sndSplit inLines)-  inLines           = toLines input-  len               = L.length inLines---stripLinesEnd :: [Text] -> [Text]-stripLinesEnd = toLines . T.stripEnd . fromLines+  SyntaxAnalysis {..} = fsSyntaxAnalysis fs+  state0              = 0 :: Int+  process (T.strip -> l) = do+    cs <- get+    let isStart   = saIsCommentStart+        isEnd     = saIsCommentEnd+        tpe       = \c -> if c > 0 then Comment else Code+        (ns, res) = if+          | isStart l && isEnd l -> (cs, Comment)+          | isStart l            -> (cs + 1, Comment)+          | isEnd l              -> (cs - 1, tpe cs)+          | cs > 0               -> (cs, Comment)+          | otherwise            -> (0, Code)+    put ns+    pure res  -stripLinesStart :: [Text] -> [Text]-stripLinesStart = toLines . T.stripStart . fromLines

@@ -0,0 +1,44 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE QuasiQuotes       #-}++{-|+Module      : Headroom.FileSupport.C+Description : Support for /C/ source code files+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++Basic support for /C/ source code files. This implementation doesn't extract any+variables or template data.+-}++module Headroom.FileSupport.C+  ( fileSupport+  )+where++import           Headroom.Data.Regex                 ( isMatch+                                                     , re+                                                     )+import           Headroom.FileSupport.Types          ( FileSupport(..)+                                                     , SyntaxAnalysis(..)+                                                     , defaultFileSupport+                                                     )+import           Headroom.FileType.Types             ( FileType(..) )+++------------------------------  PUBLIC FUNCTIONS  ------------------------------++-- | Implementation of 'FileSupport' for /C/.+fileSupport :: FileSupport+fileSupport = defaultFileSupport C syntaxAnalysis+++------------------------------  PRIVATE FUNCTIONS  -----------------------------++syntaxAnalysis :: SyntaxAnalysis+syntaxAnalysis = SyntaxAnalysis { saIsCommentStart = isMatch [re|^\/\*|^\/\/|]+                                , saIsCommentEnd   = isMatch [re|\*\/$|^\/\/|]+                                }

@@ -0,0 +1,44 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE QuasiQuotes       #-}++{-|+Module      : Headroom.FileSupport.CPP+Description : Support for /C++/ source code files+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++Basic support for /C++/ source code files. This implementation doesn't extract+any variables or template data.+-}++module Headroom.FileSupport.CPP+  ( fileSupport+  )+where++import           Headroom.Data.Regex                 ( isMatch+                                                     , re+                                                     )+import           Headroom.FileSupport.Types          ( FileSupport(..)+                                                     , SyntaxAnalysis(..)+                                                     , defaultFileSupport+                                                     )+import           Headroom.FileType.Types             ( FileType(..) )+++------------------------------  PUBLIC FUNCTIONS  ------------------------------++-- | Implementation of 'FileSupport' for /C++/.+fileSupport :: FileSupport+fileSupport = defaultFileSupport CPP syntaxAnalysis+++------------------------------  PRIVATE FUNCTIONS  -----------------------------++syntaxAnalysis :: SyntaxAnalysis+syntaxAnalysis = SyntaxAnalysis { saIsCommentStart = isMatch [re|^\/\*|^\/\/|]+                                , saIsCommentEnd   = isMatch [re|\*\/$|^\/\/|]+                                }

@@ -0,0 +1,44 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE QuasiQuotes       #-}++{-|+Module      : Headroom.FileSupport.CSS+Description : Support for /CSS/ source code files+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++Basic support for /CSS/ source code files. This implementation doesn't extract+any variables or template data.+-}++module Headroom.FileSupport.CSS+  ( fileSupport+  )+where++import           Headroom.Data.Regex                 ( isMatch+                                                     , re+                                                     )+import           Headroom.FileSupport.Types          ( FileSupport(..)+                                                     , SyntaxAnalysis(..)+                                                     , defaultFileSupport+                                                     )+import           Headroom.FileType.Types             ( FileType(..) )+++------------------------------  PUBLIC FUNCTIONS  ------------------------------++-- | Implementation of 'FileSupport' for /CSS/.+fileSupport :: FileSupport+fileSupport = defaultFileSupport CSS syntaxAnalysis+++------------------------------  PRIVATE FUNCTIONS  -----------------------------++syntaxAnalysis :: SyntaxAnalysis+syntaxAnalysis = SyntaxAnalysis { saIsCommentStart = isMatch [re|^\/\*|]+                                , saIsCommentEnd   = isMatch [re|\*\/$|]+                                }

@@ -0,0 +1,44 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE QuasiQuotes       #-}++{-|+Module      : Headroom.FileSupport.HTML+Description : Support for /HTML/ source code files+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++Basic support for /HTML/ source code files. This implementation doesn't extract+any variables or template data.+-}++module Headroom.FileSupport.HTML+  ( fileSupport+  )+where++import           Headroom.Data.Regex                 ( isMatch+                                                     , re+                                                     )+import           Headroom.FileSupport.Types          ( FileSupport(..)+                                                     , SyntaxAnalysis(..)+                                                     , defaultFileSupport+                                                     )+import           Headroom.FileType.Types             ( FileType(..) )+++------------------------------  PUBLIC FUNCTIONS  ------------------------------++-- | Implementation of 'FileSupport' for /HTML/.+fileSupport :: FileSupport+fileSupport = defaultFileSupport HTML syntaxAnalysis+++------------------------------  PRIVATE FUNCTIONS  -----------------------------++syntaxAnalysis :: SyntaxAnalysis+syntaxAnalysis = SyntaxAnalysis { saIsCommentStart = isMatch [re|^<!--|]+                                , saIsCommentEnd   = isMatch [re|-->$|]+                                }

@@ -0,0 +1,131 @@+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE TupleSections     #-}+{-# LANGUAGE TypeApplications  #-}++{-|+Module      : Headroom.FileSupport.Haskell+Description : Support for /Haskell/ source code files+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++Support for /Haskell/ source code files. This implementation extracts module+name and /Haddock/ fields as variables (see below). For more details about+/Haddock/ extraction, see "Headroom.FileSupport.Haskell.Haddock" module.++= Extracted Variables for Templates+This implementation extracts following variables from source code file:++* @___haskell_module_copyright__@ - @Copyright@ field of /Haddock/ module header+* @___haskell_module_license__@ - @License@ field of /Haddock/ module header+* @___haskell_module_maintainer__@ - @Maintainer@ field of /Haddock/ module header+* @___haskell_module_portability__@ - @Portability@ field of /Haddock/ module header+* @___haskell_module_stability__@ - @Stability@ field of /Haddock/ module header+* @___haskell_module_name__@ - name of the /Haskell/ module+* @___haskell_module_longdesc__@ - long description of /Haddock/ module+* @___haskell_module_shortdesc__@ - @Description@ field of /Haddock/ module header++= Extracted Custom Data+This implementation extracts custom data from used template, represented by the+'HaskellTemplateData'' data type.+-}++module Headroom.FileSupport.Haskell+  ( fileSupport+  )+where++import           Headroom.Data.Regex                 ( isMatch+                                                     , match+                                                     , re+                                                     )+import           Headroom.FileSupport.Haskell.Haddock+                                                     ( HaddockModuleHeader(..)+                                                     , extractModuleHeader+                                                     , extractOffsets+                                                     )+import           Headroom.FileSupport.TemplateData   ( HaskellTemplateData'(..)+                                                     , TemplateData(..)+                                                     )+import           Headroom.FileSupport.Types          ( FileSupport(..)+                                                     , SyntaxAnalysis(..)+                                                     )++import           Headroom.Configuration.Types        ( HeaderConfig(..)+                                                     , HeaderSyntax+                                                     )+import           Headroom.FileType.Types             ( FileType(..) )+import           Headroom.Header.Types               ( HeaderTemplate(..) )+import           Headroom.SourceCode                 ( LineType(..)+                                                     , SourceCode(..)+                                                     , cut+                                                     , firstMatching+                                                     )+import           Headroom.Template                   ( Template(..) )+import           Headroom.Variables                  ( mkVariables )+import           Headroom.Variables.Types            ( Variables(..) )+import           RIO+import           RIO.Lens                            ( ix )++++------------------------------  PUBLIC FUNCTIONS  ------------------------------++-- | Implementation of 'FileSupport' for /Haskell/.+fileSupport :: FileSupport+fileSupport = FileSupport { fsSyntaxAnalysis      = syntaxAnalysis+                          , fsExtractTemplateData = extractTemplateData+                          , fsExtractVariables    = extractVariables+                          , fsFileType            = Haskell+                          }+++------------------------------  PRIVATE FUNCTIONS  -----------------------------++syntaxAnalysis :: SyntaxAnalysis+syntaxAnalysis = SyntaxAnalysis+  { saIsCommentStart = isMatch [re|^{-(?!\h*#)|^--|]+  , saIsCommentEnd   = isMatch [re|^\h*-}|\w+\h*-}|^--|]+  }+++extractTemplateData :: Template a => a -> HeaderSyntax -> TemplateData+extractTemplateData template syntax =+  let htdHaddockOffsets = extractOffsets template syntax+      templateData      = HaskellTemplateData' { .. }+  in  HaskellTemplateData templateData+++extractVariables :: HeaderTemplate+                 -> Maybe (Int, Int)+                 -> SourceCode+                 -> Variables+extractVariables HeaderTemplate {..} headerPos source =+  (mkVariables . catMaybes)+    [ ("_haskell_module_copyright", ) <$> hmhCopyright+    , ("_haskell_module_license", ) <$> hmhLicense+    , ("_haskell_module_maintainer", ) <$> hmhMaintainer+    , ("_haskell_module_name", ) <$> extractModuleName source+    , ("_haskell_module_portability", ) <$> hmhPortability+    , ("_haskell_module_stability", ) <$> hmhStability+    , ("_haskell_module_longdesc", ) <$> hmhLongDesc+    , ("_haskell_module_shortdesc", ) <$> hmhShortDesc+    ]+ where+  HaddockModuleHeader {..} = extractModuleHeader header htTemplateData syntax+  header                   = maybe mempty (\(s, e) -> cut s e source) headerPos+  syntax                   = hcHeaderSyntax htConfig+++extractModuleName :: SourceCode -> Maybe Text+extractModuleName = fmap snd . firstMatching f+ where+  f (lt, l) | lt == Code = match [re|^module\s+(\S+)|] l >>= (^? ix 1)+            | otherwise  = Nothing+

@@ -0,0 +1,278 @@+{-# LANGUAGE DeriveFunctor     #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE StrictData        #-}++{-|+Module      : Headroom.FileSupport.Haskell.Haddock+Description : Extraction of /Haddock module header/ fields+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++Support for extracting data from /Haddock module headers/ present in+/Haskell source code files/ or /templates/.+-}++module Headroom.FileSupport.Haskell.Haddock+  ( HaddockModuleHeader(..)+  , extractOffsets+  , extractModuleHeader+  , indentField+  )+where++import           Control.Applicative                 ( Alternative(..) )+import           Control.Monad                       ( ap )+import           Headroom.Configuration.Types        ( HeaderSyntax )+import           Headroom.Data.Regex                 ( re+                                                     , scan+                                                     )+import           Headroom.Data.Text                  ( fromLines+                                                     , toLines+                                                     )+import           Headroom.FileSupport.TemplateData   ( HaddockOffsets(..)+                                                     , HaskellTemplateData'(..)+                                                     , TemplateData(..)+                                                     )+import           Headroom.Header.Sanitize            ( stripCommentSyntax )+import           Headroom.SourceCode                 ( SourceCode(..)+                                                     , toText+                                                     )+import           Headroom.Template                   ( Template(..) )+import           RIO+import qualified RIO.Char                           as C+import qualified RIO.Text                           as T+++-- | Extracted fields from the /Haddock module header/.+data HaddockModuleHeader = HaddockModuleHeader+  { hmhCopyright   :: Maybe Text+  -- ^ module copyright (content of the @Copyright@ field)+  , hmhLicense     :: Maybe Text+  -- ^ module license (content of the @License@ field)+  , hmhMaintainer  :: Maybe Text+  -- ^ module license (content of the @Maintainer@ field)+  , hmhPortability :: Maybe Text+  -- ^ module license (content of the @Portability@ field)+  , hmhStability   :: Maybe Text+  -- ^ module license (content of the @Stability@ field)+  , hmhShortDesc   :: Maybe Text+  -- ^ module short description (content of the @Description@ field)+  , hmhLongDesc    :: Maybe Text+  -- ^ module long description (the text after module header fields)+  }+  deriving (Eq, Show)++++-- | Extracts /offsets/ for selected haddock fields (i.e. number of chars+-- between start of line and field value). This is needed to properly format+-- multi-line field values rendered in new /license headers/.+extractOffsets :: Template a+               => a+               -- ^ parsed /template/+               -> HeaderSyntax+               -- ^ copyright header syntax+               -> HaddockOffsets+               -- ^ extracted offsets+extractOffsets template syntax =+  let hoCopyright = extractCopyrightOffset templateText+  in  HaddockOffsets { .. }+  where templateText = stripCommentSyntax syntax . rawTemplate $ template+++extractCopyrightOffset :: Text -> Maybe Int+extractCopyrightOffset text = case scan [re|\h*Copyright\h*:\h*|] text of+  [(full, _)] -> Just . T.length $ full+  _           -> Nothing+++-- | Extracts metadata from given /Haddock/ module header.+extractModuleHeader :: SourceCode+                    -- ^ source code containing /Haddock/ module header+                    -> TemplateData+                    -- ^ extracted metadata from corresponding /template/+                    -> HeaderSyntax+                    -- ^ copyright header syntax+                    -> HaddockModuleHeader+                    -- ^ extracted metadata+extractModuleHeader source templateData syntax =+  let hmhCopyright   = indent hoCopyright <$> extractField "Copyright"+      hmhLicense     = extractField "License"+      hmhMaintainer  = extractField "Maintainer"+      hmhPortability = extractField "Portability"+      hmhStability   = extractField "Stability"+      hmhShortDesc   = extractField "Description"+      hmhLongDesc    = if null rest' then Nothing else process rest'+  in  HaddockModuleHeader { .. }+ where+  (fields', rest') = fromMaybe ([], input) $ runP fields input+  input            = T.unpack . stripCommentSyntax syntax . toText $ source+  extractField name = fmap (T.strip . T.pack) (lookup name fields')+  process = Just . T.strip . T.pack+  indent c t = T.strip $ indentField c t+  HaddockOffsets {..} = case templateData of+    HaskellTemplateData (HaskellTemplateData' offsets') -> offsets'+    _ -> HaddockOffsets Nothing+++-- | Adds correct indentation to multi-line /Haddock/ field values. It's usually+-- desired to have such values indented like this:+--+-- @+-- Copyright        : (c) 2020, 1st Author+--                    (c) 2020, 2nd Author+-- @+--+-- This functions achieves that using the /offset/ value, which specifies number+-- of empty characters that should be placed before second (and any subsequent)+-- line.+--+-- >>> indentField (Just 2) "foo\nbar\nbaz"+-- "foo\n  bar\n  baz"+indentField :: Maybe Int+            -- ^ offset (in number of black chars) for 2nd and subsequent lines+            -> Text+            -- ^ input text to indent+            -> Text+            -- ^ processed text+indentField Nothing       text = text+indentField (Just offset) text = fromLines . go . toLines $ text+ where+  go []       = []+  go [x     ] = [x]+  go (x : xs) = x : fmap ((prefix <>) . T.stripStart) xs+  prefix = T.replicate offset " "+++--------------------------------------------------------------------------------+-- Below code is slightly modified version of code copied from:+-- https://github.com/haskell/haddock/blob/ghc-8.10/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs+-------------------------------------------------------------------------------+-- Small parser to parse module header.+-------------------------------------------------------------------------------++-- The below is a small parser framework how we read keys.+--+-- all fields in the header are optional and have the form+--+-- [spaces1][field name][spaces] ":"+--    [text]"\n" ([spaces2][space][text]"\n" | [spaces]"\n")*+-- where each [spaces2] should have [spaces1] as a prefix.+--+-- Thus for the key "Description",+--+-- > Description : this is a+-- >    rather long+-- >+-- >    description+-- >+-- > The module comment starts here+--+-- the value will be "this is a .. description" and the rest will begin+-- at "The module comment".++-- 'C' is a 'Char' carrying its column.+--+-- This let us make an indentation-aware parser, as we know current indentation.+-- by looking at the next character in the stream ('curInd').+--+-- Thus we can munch all spaces but only not-spaces which are indented.+--+data C = C {-# UNPACK #-} !Int Char++newtype P a = P { unP :: [C] -> Maybe ([C], a) }+  deriving Functor++instance Applicative P where+  pure x = P $ \s -> Just (s, x)+  (<*>) = ap++instance Monad P where+  return = pure+  m >>= k = P $ \s0 -> do+    (s1, x) <- unP m s0+    unP (k x) s1++instance Alternative P where+  empty = P $ const Nothing+  a <|> b = P $ \s -> unP a s <|> unP b s++runP :: P a -> String -> Maybe a+runP p input = fmap snd (unP p input')+ where+  input' =+    concat [ zipWith C [0 ..] l <> [C (length l) '\n'] | l <- lines input ]++-------------------------------------------------------------------------------+--+-------------------------------------------------------------------------------++curInd :: P Int+curInd = P $ \s -> Just . (,) s $ case s of+  []        -> 0+  C i _ : _ -> i++rest :: P String+rest = P $ \cs -> Just ([], [ c | C _ c <- cs ])++munch :: (Int -> Char -> Bool) -> P String+munch p = P $ \cs -> let (xs, ys) = takeWhileMaybe p' cs in Just (ys, xs)+ where+  p' (C i c) | p i c     = Just c+             | otherwise = Nothing++munch1 :: (Int -> Char -> Bool) -> P String+munch1 p = P $ \case+  [] -> Nothing+  (c : cs)+    | Just c' <- p' c+    -> let (xs, ys) = takeWhileMaybe p' cs in Just (ys, c' : xs)+    | otherwise+    -> Nothing+ where+  p' (C i c) | p i c     = Just c+             | otherwise = Nothing++char :: Char -> P Char+char c = P $ \case+  [] -> Nothing+  (C _ c' : cs) | c == c'   -> Just (cs, c)+                | otherwise -> Nothing++skipSpaces :: P ()+skipSpaces = P $ \cs -> Just (dropWhile (\(C _ c) -> C.isSpace c) cs, ())++takeWhileMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])+takeWhileMaybe f = go where+  go xs0@[]       = ([], xs0)+  go xs0@(x : xs) = case f x of+    Just y  -> let (ys, zs) = go xs in (y : ys, zs)+    Nothing -> ([], xs0)++-------------------------------------------------------------------------------+-- Fields+-------------------------------------------------------------------------------++field :: Int -> P (String, String)+field i = do+  fn <- munch1 $ \_ c -> C.isAlpha c || c == '-'+  skipSpaces+  _ <- char ':'+  skipSpaces+  val <- munch $ \j c -> C.isSpace c || j > i+  return (fn, val)++fields :: P ([(String, String)], String)+fields = do+  skipSpaces+  i  <- curInd+  fs <- many (field i)+  r  <- rest+  return (fs, r)

@@ -0,0 +1,44 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE QuasiQuotes       #-}++{-|+Module      : Headroom.FileSupport.JS+Description : Support for /Javascript/ source code files+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++Basic support for /Javascript/ source code files. This implementation doesn't+extract any variables or template data.+-}++module Headroom.FileSupport.JS+  ( fileSupport+  )+where++import           Headroom.Data.Regex                 ( isMatch+                                                     , re+                                                     )+import           Headroom.FileSupport.Types          ( FileSupport(..)+                                                     , SyntaxAnalysis(..)+                                                     , defaultFileSupport+                                                     )+import           Headroom.FileType.Types             ( FileType(..) )+++------------------------------  PUBLIC FUNCTIONS  ------------------------------++-- | Implementation of 'FileSupport' for /Javascript/.+fileSupport :: FileSupport+fileSupport = defaultFileSupport JS syntaxAnalysis+++------------------------------  PRIVATE FUNCTIONS  -----------------------------++syntaxAnalysis :: SyntaxAnalysis+syntaxAnalysis = SyntaxAnalysis { saIsCommentStart = isMatch [re|^\/\*|^\/\/|]+                                , saIsCommentEnd   = isMatch [re|\*\/$|^\/\/|]+                                }

@@ -0,0 +1,85 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE TupleSections     #-}+{-# LANGUAGE TypeApplications  #-}++{-|+Module      : Headroom.FileSupport.Java+Description : Support for /Java/ source code files+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++Support for /Java/ source code files. This implementation extracts /Java/+package name as variable.++= Extracted Variables for Templates+This implementation extracts following variables from source code file:++* @___java_package_name__@ - name of the /Java/ package++= Extracted Custom Data+This implementation does not extract any custom data from template file.+-}++module Headroom.FileSupport.Java+  ( fileSupport+  )+where++import           Headroom.Data.Regex                 ( isMatch+                                                     , match+                                                     , re+                                                     )+import           Headroom.FileSupport.TemplateData   ( TemplateData(..) )+import           Headroom.FileSupport.Types          ( FileSupport(..)+                                                     , SyntaxAnalysis(..)+                                                     )+import           Headroom.FileType.Types             ( FileType(..) )+import           Headroom.Header.Types               ( HeaderTemplate )+import           Headroom.SourceCode                 ( LineType(..)+                                                     , SourceCode(..)+                                                     , firstMatching+                                                     )+import           Headroom.Variables                  ( mkVariables )+import           Headroom.Variables.Types            ( Variables(..) )+import           RIO+import           RIO.Lens                            ( ix )+++------------------------------  PUBLIC FUNCTIONS  ------------------------------++-- | Implementation of 'FileSupport' for /Java/.+fileSupport :: FileSupport+fileSupport = FileSupport+  { fsSyntaxAnalysis      = syntaxAnalysis+  , fsExtractTemplateData = const . const $ NoTemplateData+  , fsExtractVariables    = extractVariables+  , fsFileType            = Java+  }+++------------------------------  PRIVATE FUNCTIONS  -----------------------------++syntaxAnalysis :: SyntaxAnalysis+syntaxAnalysis = SyntaxAnalysis { saIsCommentStart = isMatch [re|^\/\*|^\/\/|]+                                , saIsCommentEnd   = isMatch [re|\*\/$|^\/\/|]+                                }+++extractVariables :: HeaderTemplate+                 -> Maybe (Int, Int)+                 -> SourceCode+                 -> Variables+extractVariables _ _ source = (mkVariables . catMaybes)+  [("_java_package_name", ) <$> extractPackageName source]+++extractPackageName :: SourceCode -> Maybe Text+extractPackageName = fmap snd . firstMatching f+ where+  f (lt, l) | lt == Code = match [re|^package (.*);$|] l >>= (^? ix 1)+            | otherwise  = Nothing

@@ -0,0 +1,88 @@+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE TupleSections     #-}+{-# LANGUAGE TypeApplications  #-}++{-|+Module      : Headroom.FileSupport.PureScript+Description : Support for /PureScript/ source code files+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++Support for /PureScript/ source code files. This implementation extracts+/PureScript/ module name as variable.++= Extracted Variables for Templates+This implementation extracts following variables from source code file:++* @___purescript_module_name__@ - name of the /PureScript/ module++= Extracted Custom Data+This implementation does not extract any custom data from template file.+-}++module Headroom.FileSupport.PureScript+  ( fileSupport+  )+where++import           Headroom.Data.Regex                 ( isMatch+                                                     , match+                                                     , re+                                                     )+import           Headroom.FileSupport.TemplateData   ( TemplateData(..) )+import           Headroom.FileSupport.Types          ( FileSupport(..)+                                                     , SyntaxAnalysis(..)+                                                     )+import           Headroom.FileType.Types             ( FileType(..) )+import           Headroom.Header.Types               ( HeaderTemplate )+import           Headroom.SourceCode                 ( LineType(..)+                                                     , SourceCode(..)+                                                     , firstMatching+                                                     )+import           Headroom.Variables                  ( mkVariables )+import           Headroom.Variables.Types            ( Variables(..) )+import           RIO+import           RIO.Lens                            ( ix )+++------------------------------  PUBLIC FUNCTIONS  ------------------------------++-- | Implementation of 'FileSupport' for /PureScript/.+fileSupport :: FileSupport+fileSupport = FileSupport+  { fsSyntaxAnalysis      = syntaxAnalysis+  , fsExtractTemplateData = const . const $ NoTemplateData+  , fsExtractVariables    = extractVariables+  , fsFileType            = PureScript+  }+++------------------------------  PRIVATE FUNCTIONS  -----------------------------++syntaxAnalysis :: SyntaxAnalysis+syntaxAnalysis = SyntaxAnalysis+  { saIsCommentStart = isMatch [re|^{-(?!\h*#)|^--|]+  , saIsCommentEnd   = isMatch [re|^\h*-}|\w+\h*-}|^--|]+  }+++extractVariables :: HeaderTemplate+                 -> Maybe (Int, Int)+                 -> SourceCode+                 -> Variables+extractVariables _ _ source = (mkVariables . catMaybes)+  [("_purescript_module_name", ) <$> extractModuleName source]+++extractModuleName :: SourceCode -> Maybe Text+extractModuleName = fmap snd . firstMatching f+ where+  f (lt, l) | lt == Code = match [re|^module\s+(\S+)|] l >>= (^? ix 1)+            | otherwise  = Nothing

@@ -0,0 +1,44 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE QuasiQuotes       #-}++{-|+Module      : Headroom.FileSupport.Rust+Description : Support for /Rust/ source code files+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++Basic support for /Rust/ source code files. This implementation doesn't extract+any variables or template data.+-}++module Headroom.FileSupport.Rust+  ( fileSupport+  )+where++import           Headroom.Data.Regex                 ( isMatch+                                                     , re+                                                     )+import           Headroom.FileSupport.Types          ( FileSupport(..)+                                                     , SyntaxAnalysis(..)+                                                     , defaultFileSupport+                                                     )+import           Headroom.FileType.Types             ( FileType(..) )+++------------------------------  PUBLIC FUNCTIONS  ------------------------------++-- | Implementation of 'FileSupport' for /Rust/.+fileSupport :: FileSupport+fileSupport = defaultFileSupport Rust syntaxAnalysis+++------------------------------  PRIVATE FUNCTIONS  -----------------------------++syntaxAnalysis :: SyntaxAnalysis+syntaxAnalysis = SyntaxAnalysis { saIsCommentStart = isMatch [re|^\/\*|^\/\/|]+                                , saIsCommentEnd   = isMatch [re|\*\/$|^\/\/|]+                                }

@@ -0,0 +1,44 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE QuasiQuotes       #-}++{-|+Module      : Headroom.FileSupport.Scala+Description : Support for /Scala/ source code files+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++Basic support for /Scala/ source code files. This implementation doesn't extract+any variables or template data.+-}++module Headroom.FileSupport.Scala+  ( fileSupport+  )+where++import           Headroom.Data.Regex                 ( isMatch+                                                     , re+                                                     )+import           Headroom.FileSupport.Types          ( FileSupport(..)+                                                     , SyntaxAnalysis(..)+                                                     , defaultFileSupport+                                                     )+import           Headroom.FileType.Types             ( FileType(..) )+++------------------------------  PUBLIC FUNCTIONS  ------------------------------++-- | Implementation of 'FileSupport' for /Scala/.+fileSupport :: FileSupport+fileSupport = defaultFileSupport Scala syntaxAnalysis+++------------------------------  PRIVATE FUNCTIONS  -----------------------------++syntaxAnalysis :: SyntaxAnalysis+syntaxAnalysis = SyntaxAnalysis { saIsCommentStart = isMatch [re|^\/\*|^\/\/|]+                                , saIsCommentEnd   = isMatch [re|\*\/$|^\/\/|]+                                }

@@ -0,0 +1,44 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE QuasiQuotes       #-}++{-|+Module      : Headroom.FileSupport.Shell+Description : Support for /Shell/ source code files+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++Basic support for /Shell/ source code files. This implementation doesn't extract+any variables or template data.+-}++module Headroom.FileSupport.Shell+  ( fileSupport+  )+where++import           Headroom.Data.Regex                 ( isMatch+                                                     , re+                                                     )+import           Headroom.FileSupport.Types          ( FileSupport(..)+                                                     , SyntaxAnalysis(..)+                                                     , defaultFileSupport+                                                     )+import           Headroom.FileType.Types             ( FileType(..) )+++------------------------------  PUBLIC FUNCTIONS  ------------------------------++-- | Implementation of 'FileSupport' for /Shell/.+fileSupport :: FileSupport+fileSupport = defaultFileSupport Shell syntaxAnalysis+++------------------------------  PRIVATE FUNCTIONS  -----------------------------++syntaxAnalysis :: SyntaxAnalysis+syntaxAnalysis = SyntaxAnalysis { saIsCommentStart = isMatch [re|^#(?!!)|]+                                , saIsCommentEnd   = isMatch [re|^#(?!!)|]+                                }

@@ -0,0 +1,48 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE StrictData        #-}++{-|+Module      : Headroom.FileSupport.TemplateData+Description : Custom data specific to file support implementations+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++Because each implementation of file support might require some custom data+extracted for example from the template file, this module exposes data types+specific for individual implementations.+-}++module Headroom.FileSupport.TemplateData+  ( TemplateData(..)+  , HaddockOffsets(..)+  , HaskellTemplateData'(..)+  )+where+import           RIO+++-- | Additional template data extracted from the template file.+data TemplateData+  = HaskellTemplateData HaskellTemplateData'+  -- ^ additional template data for /Haskell/+  | NoTemplateData+  -- ^ no additional template data provided+  deriving (Eq, Show)++-- | Offsets for selected fields extracted from /Haddock module header/.+data HaddockOffsets = HaddockOffsets+  { hoCopyright :: Maybe Int+  -- ^ offset for /Copyright/ field+  }+  deriving (Eq, Show)+++-- | Additional template data required by /Haskell/ file support+data HaskellTemplateData' = HaskellTemplateData'+  { htdHaddockOffsets :: HaddockOffsets+  -- ^ offsets for /Haddock/ fields+  }+  deriving (Eq, Show)

@@ -1,39 +1,93 @@ {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RankNTypes        #-} {-# LANGUAGE StrictData        #-}  {-| Module      : Headroom.FileSupport.Types-Description : Data types for "Headroom.FileSupport"-Copyright   : (c) 2019-2020 Vaclav Svejcar+Description : Data types for "Headroom.FileSupport" module+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental Portability : POSIX -This module contains data types for "Headroom.FileSupport" module.+Data types for "Headroom.FileSupport" module in separated module+(to avoid cyclic dependencies). -}  module Headroom.FileSupport.Types   ( -- * Data Types-    FileInfo(..)+    FileSupport(..)+  , SyntaxAnalysis(..)+    -- * Smart Constructors+  , defaultFileSupport+    -- * Function Type Aliases+  , ExtractTemplateDataFn+  , ExtractVariablesFn   ) where -import           Headroom.Configuration.Types   ( CtHeaderConfig )-import           Headroom.FileType.Types        ( FileType )-import           Headroom.Variables.Types       ( Variables )+import           Headroom.Configuration.Types        ( HeaderSyntax )+import           Headroom.FileSupport.TemplateData   ( TemplateData(..) )+import           Headroom.FileType.Types             ( FileType )+import           Headroom.Header.Types               ( HeaderTemplate )+import           Headroom.SourceCode                 ( SourceCode )+import           Headroom.Template                   ( Template )+import           Headroom.Variables.Types            ( Variables ) import           RIO  --- | Info extracted about the concrete source code file.-data FileInfo = FileInfo-  { fiFileType     :: FileType-  -- ^ type of the file-  , fiHeaderConfig :: CtHeaderConfig-  -- ^ configuration for license header-  , fiHeaderPos    :: Maybe (Int, Int)-  -- ^ position of existing license header-  , fiVariables    :: Variables-  -- ^ additional extracted variables+-- | Set of functions that every file support needs to implement.+data FileSupport = FileSupport+  { fsSyntaxAnalysis      :: SyntaxAnalysis+  , fsExtractTemplateData :: ExtractTemplateDataFn+  , fsExtractVariables    :: ExtractVariablesFn+  , fsFileType            :: FileType   }-  deriving (Eq, Show)+++-- | Set of functions used to analyze source code.+data SyntaxAnalysis = SyntaxAnalysis+  { saIsCommentStart :: Text -> Bool+  , saIsCommentEnd   :: Text -> Bool+  }+++-- | Type of a function that extracts additional template data from template.+type ExtractTemplateDataFn+  =  forall a+   . Template a+  => a+  -- ^ template to use for extraction+  -> HeaderSyntax+  -- ^ copyright header syntax+  -> TemplateData+  -- ^ extracted template data+++-- | Type of a function that extracts variables from analyzed source code file.+type ExtractVariablesFn+  =  HeaderTemplate+  -- ^ header template+  -> Maybe (Int, Int)+  -- ^ header position as @(startLine, endLine)@+  -> SourceCode+  -- ^ analyzed source code file+  -> Variables+  -- ^ extracted variables+++-- | Default implementation of 'FileSupport' that doesn't extract any variables+-- or template data.+defaultFileSupport :: FileType+                   -- ^ type of the source code file+                   -> SyntaxAnalysis+                   -- ^ function that analyzes source code+                   -> FileSupport+                   -- ^ resulting 'FileSupport'+defaultFileSupport fileType syntaxAnalysis = FileSupport+  { fsSyntaxAnalysis      = syntaxAnalysis+  , fsExtractTemplateData = const . const $ NoTemplateData+  , fsExtractVariables    = const . const . const $ mempty+  , fsFileType            = fileType+  }

@@ -4,7 +4,7 @@ {-| Module      : Headroom.FileSystem Description : Operations related to files and file system-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -40,25 +40,25 @@   ) where -import           Headroom.Configuration.Types   ( CtHeadersConfig )-import           Headroom.Data.Regex            ( Regex-                                                , match-                                                )-import           Headroom.FileType              ( listExtensions )-import           Headroom.FileType.Types        ( FileType )+import           Headroom.Configuration.Types        ( CtHeadersConfig )+import           Headroom.Data.Regex                 ( Regex+                                                     , match+                                                     )+import           Headroom.FileType                   ( listExtensions )+import           Headroom.FileType.Types             ( FileType ) import           RIO-import           RIO.Directory                  ( createDirectory-                                                , doesDirectoryExist-                                                , doesFileExist-                                                , getCurrentDirectory-                                                , getDirectoryContents-                                                )-import           RIO.FilePath                   ( isExtensionOf-                                                , takeExtension-                                                , (</>)-                                                )-import qualified RIO.List                      as L-import qualified RIO.Text                      as T+import           RIO.Directory                       ( createDirectory+                                                     , doesDirectoryExist+                                                     , doesFileExist+                                                     , getCurrentDirectory+                                                     , getDirectoryContents+                                                     )+import           RIO.FilePath                        ( isExtensionOf+                                                     , takeExtension+                                                     , (</>)+                                                     )+import qualified RIO.List                           as L+import qualified RIO.Text                           as T   --------------------------------  TYPE ALIASES  --------------------------------@@ -235,8 +235,8 @@ -- | Takes list of patterns and file paths and returns list of file paths where -- those matching the given patterns are excluded. ----- >>> import Headroom.Data.Regex (re) -- >>> :set -XQuasiQuotes+-- >>> import Headroom.Data.Regex (re) -- >>> excludePaths [[re|\.hidden|], [re|zzz|]] ["foo/.hidden", "test/bar", "x/zzz/e"] -- ["test/bar"] excludePaths :: [Regex]

@@ -5,7 +5,7 @@ {-| Module      : Headroom.FileType Description : Logic for handlig supported file types-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -22,15 +22,15 @@   ) where -import           Headroom.Configuration.Types   ( CtHeaderConfig-                                                , CtHeadersConfig-                                                , HeaderConfig(..)-                                                , HeadersConfig(..)-                                                )-import           Headroom.Data.EnumExtra        ( EnumExtra(..) )-import           Headroom.FileType.Types        ( FileType(..) )+import           Headroom.Configuration.Types        ( CtHeaderConfig+                                                     , CtHeadersConfig+                                                     , HeaderConfig(..)+                                                     , HeadersConfig(..)+                                                     )+import           Headroom.Data.EnumExtra             ( EnumExtra(..) )+import           Headroom.FileType.Types             ( FileType(..) ) import           RIO-import qualified RIO.List                      as L+import qualified RIO.List                           as L   

@@ -4,7 +4,7 @@ {-| Module      : Headroom.FileType.Types Description : Data types for "Headroom.FileType"-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -15,7 +15,7 @@  module Headroom.FileType.Types where -import           Headroom.Data.EnumExtra        ( EnumExtra(..) )+import           Headroom.Data.EnumExtra             ( EnumExtra(..) ) import           RIO  -- | Supported type of source code file.

@@ -0,0 +1,309 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE TypeApplications  #-}+{-# LANGUAGE TypeFamilies      #-}++{-|+Module      : Headroom.Header+Description : Operations with copyright/license headers+Copyright   : (c) 2019-2021 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.Header+  ( -- * Header Info Extraction+    extractHeaderInfo+  , extractHeaderTemplate+    -- * License header manipulation+  , addHeader+  , dropHeader+  , replaceHeader+    -- * Copyright Header Detection+  , findHeader+  , findBlockHeader+  , findLineHeader+  , splitSource+  )+where++import           Headroom.Configuration.Types        ( CtHeaderConfig+                                                     , CtHeaderConfig+                                                     , CtHeadersConfig+                                                     , HeaderConfig(..)+                                                     , HeaderConfig(..)+                                                     , HeaderSyntax(..)+                                                     , HeaderSyntax(..)+                                                     )+import           Headroom.Data.Coerce                ( coerce+                                                     , inner+                                                     )+import           Headroom.Data.Lens                  ( suffixLensesFor )+import           Headroom.Data.Regex                 ( Regex+                                                     , isMatch+                                                     )+import           Headroom.FileSupport                ( fileSupport )+import           Headroom.FileSupport.Types          ( FileSupport(..) )+import           Headroom.FileType                   ( configByFileType )+import           Headroom.FileType.Types             ( FileType )+import           Headroom.Header.Sanitize            ( findPrefix )+import           Headroom.Header.Types               ( HeaderInfo(..)+                                                     , HeaderTemplate(..)+                                                     )+import           Headroom.Meta                       ( TemplateType )+import           Headroom.SourceCode                 ( CodeLine+                                                     , LineType(..)+                                                     , SourceCode(..)+                                                     , firstMatching+                                                     , fromText+                                                     , lastMatching+                                                     , stripEnd+                                                     , stripStart+                                                     )+import           Headroom.Template                   ( Template(..) )+import           RIO+import qualified RIO.List                           as L+import qualified RIO.Text                           as T++++suffixLensesFor ["hcHeaderSyntax"] ''HeaderConfig+suffixLensesFor ["hiHeaderPos"]    ''HeaderInfo+++-- | Extracts info about the processed file to be later used by the header+-- detection/manipulation functions.+extractHeaderInfo :: HeaderTemplate+                  -- ^ template info+                  -> SourceCode+                  -- ^ text used for detection+                  -> HeaderInfo+                  -- ^ resulting file info+extractHeaderInfo ht@HeaderTemplate {..} source =+  let hiFileType     = htFileType+      hiHeaderConfig = htConfig+      hiHeaderPos    = findHeader hiHeaderConfig source+      hiVariables    = fsExtractVariables ht hiHeaderPos source+  in  HeaderInfo { .. }+  where FileSupport {..} = fileSupport htFileType+++-- | Constructs new 'HeaderTemplate' from provided data.+extractHeaderTemplate :: CtHeadersConfig+                      -- ^ configuration for license headers+                      -> FileType+                      -- ^ type of source code files this template is for+                      -> TemplateType+                      -- ^ parsed template+                      -> HeaderTemplate+                      -- ^ resulting template info+extractHeaderTemplate configs fileType template =+  let htConfig       = withP (configByFileType configs fileType)+      htTemplateData = fsExtractTemplateData template (hcHeaderSyntax htConfig)+      htFileType     = fileType+      htTemplate     = template+  in  HeaderTemplate { .. }+ where+  FileSupport {..} = fileSupport fileType+  withP            = \config -> config & hcHeaderSyntaxL %~ headerSyntax+  headerSyntax     = \hs -> findPrefix hs (rawTemplate template)+++-- | 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.+addHeader :: 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+addHeader HeaderInfo {..} _ source | isJust hiHeaderPos = source+addHeader HeaderInfo {..} header source                 = mconcat chunks+ where+  HeaderConfig {..}       = hiHeaderConfig+  (before, middle, after) = splitSource hcPutAfter hcPutBefore source+  header'                 = fromText [] (const $ pure Comment) header+  before'                 = stripEnd before+  middle'                 = stripStart middle+  margin (SourceCode ls) mInner mOuter+    | L.null ls = coerce $ replicate mOuter (Code, T.empty)+    | otherwise = coerce $ replicate mInner (Code, T.empty)+  marginT = margin before' hcMarginTopCode hcMarginTopFile+  marginB = margin (middle' <> after) hcMarginBottomCode hcMarginBottomFile+  chunks  = [before', marginT, header', marginB, middle', after]+++-- | Drops header at position specified by the 'HeaderInfo' from the given+-- source code. Does nothing if no header is present.+dropHeader :: HeaderInfo+           -- ^ additional info about the header+           -> SourceCode+           -- ^ text of the file from which to drop the header+           -> SourceCode+           -- ^ resulting text with dropped header+dropHeader (HeaderInfo _ _ Nothing             _) source = source+dropHeader (HeaderInfo _ _ (Just (start, end)) _) source = result+ where+  before = inner @_ @[CodeLine] (take start) source+  after  = inner @_ @[CodeLine] (drop $ end + 1) source+  result = stripEnd before <> stripStart after+++-- | 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.+replaceHeader :: 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+replaceHeader fileInfo header = addHeader' . dropHeader'+ where+  addHeader'     = addHeader infoWithoutPos header+  dropHeader'    = dropHeader fileInfo+  infoWithoutPos = fileInfo & hiHeaderPosL .~ Nothing+++-- | 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)+findHeader :: CtHeaderConfig+           -- ^ appropriate header configuration+           -> SourceCode+           -- ^ text in which to detect the header+           -> Maybe (Int, Int)+           -- ^ header position @(startLine, endLine)@+findHeader HeaderConfig {..} input = case hcHeaderSyntax of+  BlockComment start end _ -> findBlockHeader start end headerArea splitAt+  LineComment prefix _     -> findLineHeader prefix headerArea splitAt+ where+  (before, headerArea, _) = splitSource hcPutAfter hcPutBefore input+  splitAt                 = length (coerce before :: [CodeLine])+++-- | 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)+findBlockHeader :: Regex+                -- ^ starting pattern (e.g. @{-@ or @/*@)+                -> Regex+                -- ^ ending pattern (e.g. @-}@ or @*/@)+                -> SourceCode+                -- ^ source code in which to detect the header+                -> Int+                -- ^ line number offset (adds to resulting position)+                -> Maybe (Int, Int)+                -- ^ header position @(startLine + offset, endLine + offset)@+findBlockHeader start end sc offset = mapT2 (+ offset) <$> position+ where+  ls          = zip [0 ..] $ coerce sc+  isMatch'    = \p t -> isMatch p . T.strip $ t+  allComments = all (\(_, (lt, _)) -> lt == Comment)+  hasStart    = maybe False (\(_, (_, t)) -> isMatch' start t) . L.headMaybe+  hasEnd      = maybe False (\(_, (_, t)) -> isMatch' end t) . L.lastMaybe+  position    = (,) <$> (header >>= L.headMaybe) <*> (header >>= L.lastMaybe)+  header =+    (fmap . fmap) fst+      . L.find (\g -> allComments g && hasStart g && hasEnd g)+      . L.groupBy (\(_, (lt1, _)) (_, (lt2, _)) -> lt1 == lt2)+      $ ls+++-- | 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)+findLineHeader :: Regex+               -- ^ prefix pattern (e.g. @--@ or @//@)+               -> SourceCode+               -- ^ source code in which to detect the header+               -> Int+               -- ^ line number offset (adds to resulting position)+               -> Maybe (Int, Int)+               -- ^ header position @(startLine + offset, endLine + offset)@+findLineHeader prefix sc offset = mapT2 (+ offset) <$> position+ where+  ls       = zip [0 ..] $ coerce sc+  isMatch' = \p t -> isMatch p . T.strip $ t+  position = (,) <$> (header >>= L.headMaybe) <*> (header >>= L.lastMaybe)+  header =+    (fmap . fmap) fst+      . L.find (all (\(_, (lt, t)) -> lt == Comment && isMatch' prefix t))+      . L.groupBy (\(_, (lt1, _)) (_, (lt2, _)) -> lt1 == lt2)+      $ ls+++-- | Splits input source code into three parts:+--+--     1. all lines located before the very last occurence of one of the+--        conditions from the first condition list+--     2. all lines between the first and last lists+--     3. 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 [])+splitSource :: [Regex]+            -> [Regex]+            -> SourceCode+            -> (SourceCode, SourceCode, SourceCode)+splitSource []    []    sc = (mempty, sc, mempty)+splitSource fstPs sndPs sc = (before, middle, after)+ where+  allLines          = coerce sc+  (middle', after ) = mapT2 SourceCode $ L.splitAt sndSplit allLines+  (before , middle) = mapT2 SourceCode $ L.splitAt fstSplitAt (coerce middle')+  fstSplitAt        = maybe 0 ((+ 1) . fst) $ lastMatching (cond fstPs) middle'+  sndSplit          = maybe len fst $ firstMatching (cond sndPs) sc+  len               = length allLines+  cond              = \ps cl@(lt, t) ->+    if lt == Code && any (`isMatch` t) ps then Just cl else Nothing++++mapT2 :: (a -> b) -> (a, a) -> (b, b)+mapT2 = join (***)

@@ -0,0 +1,128 @@+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Headroom.Header.Sanitize+Description : Logic for sanitizing license headers+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++This module contains functions related to sanitizing license headers. Because+license headers are just regular comments in given programming language, they+need to have correct syntax in order to avoid causing compile/runtime errors.+Because header manipulation done by /Headroom/ can disrupt the comment syntax+structure, sanitizing the header is the last step done in the flow, making+sure that license header syntax is not broken.+-}++module Headroom.Header.Sanitize+  ( findPrefix+  , sanitizeSyntax+  , stripCommentSyntax+  )+where++import           Headroom.Configuration.Types        ( HeaderSyntax(..) )+import qualified Headroom.Data.Regex                as R+import qualified Headroom.Data.Text                 as T+import           RIO+import qualified RIO.Text                           as T+++------------------------------  PUBLIC FUNCTIONS  ------------------------------++-- | Tries to find comment prefix in given comment. By /prefix/ it's meant+-- either the line prefix used for block comment syntax (like @*@ at start of+-- each line between opening and closing pattern - @/* */@) or line comment+-- syntax (just the syntax for comment itself - like @//@ or @--@). If such+-- prefix is found, it's then added to the input 'HeaderSyntax'.+--+-- >>> :set -XQuasiQuotes+-- >>> import Headroom.Data.Regex (re)+-- >>> findPrefix (BlockComment [re|^\/\*|] [re|\*\/$|] Nothing) "/*\n * foo\n * bar\n */"+-- BlockComment "^\\/\\*" "\\*\\/$" (Just " *")+findPrefix :: HeaderSyntax+           -- ^ describes comment syntax of the header+           -> Text+           -- ^ text containint the comment+           -> HeaderSyntax+           -- ^ input 'HeaderSyntax' with added prefix (if found)+findPrefix syntax text = case syntax of+  BlockComment s e _ -> BlockComment s e prefix+  LineComment s _    -> LineComment s prefix+ where+  filtered = filter cond . T.toLines $ text+  cond     = \t -> (not . T.null . T.strip $ t) && isCommentBody syntax t+  prefix   = fmap T.stripEnd (T.commonLinesPrefix . T.fromLines $ filtered)+++-- | Sanitizes given header text to make sure that each comment line starts with+-- appropriate prefix (if defined within given 'HeaderSyntax'). For block+-- comments, this is to make it visually unified, but for line comments it's+-- necessary in order not to break syntax of target source code file.+--+-- >>> :set -XQuasiQuotes+-- >>> import Headroom.Data.Regex (re)+-- >>> sanitizeSyntax (LineComment [re|^--|] (Just "--")) "-- foo\nbar"+-- "-- foo\n-- bar"+sanitizeSyntax :: HeaderSyntax+               -- ^ header syntax definition that may contain prefix+               -> Text+               -- ^ header to sanitize+               -> Text+               -- ^ sanitized header+sanitizeSyntax syntax = mapCommentLines syntax (addPrefix mPrefix)+ where+  addPrefix Nothing l = Just l+  addPrefix (Just p) l | p `T.isPrefixOf` l = Just l+                       | otherwise          = Just $ p <> " " <> l+  mPrefix = case syntax of+    BlockComment _ _ p -> p+    LineComment _ p    -> p+++-- | Strips comment syntax from given text.+--+-- >>> :set -XQuasiQuotes+-- >>> import Headroom.Data.Regex (re)+-- >>> stripCommentSyntax (LineComment [re|^--|] (Just "--")) "-- a\n-- b"+-- "a\n b"+stripCommentSyntax :: HeaderSyntax+                   -- ^ copyright header syntax+                   -> Text+                   -- ^ input text from which to strip the syntax+                   -> Text+                   -- ^ processed text+stripCommentSyntax syntax = T.strip . T.fromLines . go [] . T.toLines . T.strip+ where+  (s, e, p) = case syntax of+    BlockComment s' e' p' -> (Just s', Just e', p')+    LineComment s' p'     -> (Just s', Nothing, p')+  nil = const . const $ ""+  rep = \pt l -> maybe l (\pt' -> R.replaceFirst pt' nil l) pt+  dp  = \pt l -> maybe l (\pt' -> T.replaceFirst pt' "" l) pt+  go agg []       = reverse agg+  go []  (x : xs) = go [rep s . rep e . dp p $ x] xs+  go agg [x     ] = go ((rep e . dp p $ x) : agg) []+  go agg (x : xs) = go (dp p x : agg) xs+++------------------------------  PRIVATE FUNCTIONS  -----------------------------++mapCommentLines :: Foldable t+                => HeaderSyntax+                -> (Text -> t Text)+                -> Text+                -> Text+mapCommentLines syntax f = T.mapLinesF $ \case+  line | isCommentBody syntax line -> toList . f $ line+       | otherwise                 -> [line]+++isCommentBody :: HeaderSyntax -> Text -> Bool+isCommentBody (LineComment _ _   ) _ = True+isCommentBody (BlockComment s e _) l = not $ R.isMatch s l || R.isMatch e l

@@ -0,0 +1,56 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE StrictData        #-}++{-|+Module      : Headroom.Header.Types+Description : Data types for "Headroom.Header"+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++This module contains data types for "Headroom.Header" module.+-}++module Headroom.Header.Types+  ( -- * Data Types+    HeaderInfo(..)+  , HeaderTemplate(..)+  )+where++import           Headroom.Configuration.Types        ( CtHeaderConfig )+import           Headroom.FileSupport.TemplateData   ( TemplateData )+import           Headroom.FileType.Types             ( FileType )+import           Headroom.Meta                       ( TemplateType )+import           Headroom.Variables.Types            ( Variables )+import           RIO+++-- | Info extracted about the source code file header.+data HeaderInfo = HeaderInfo+  { hiFileType     :: FileType+  -- ^ type of the file+  , hiHeaderConfig :: CtHeaderConfig+  -- ^ configuration for license header+  , hiHeaderPos    :: Maybe (Int, Int)+  -- ^ position of existing license header+  , hiVariables    :: Variables+  -- ^ additional extracted variables+  }+  deriving (Eq, Show)+++-- | Represents info about concrete header template.+data HeaderTemplate = HeaderTemplate+  { htConfig       :: CtHeaderConfig+  -- ^ header configuration+  , htTemplateData :: TemplateData+  -- ^ extra template data extracted by the correcponding file type support+  , htFileType     :: FileType+  -- ^ type of the file this template is for+  , htTemplate     :: TemplateType+  -- ^ parsed template+  }+  deriving (Eq, Show)

@@ -12,7 +12,7 @@ {-| Module      : Headroom.HeaderFn Description : Support for /license header functions/-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -34,26 +34,25 @@   ) where -import           Headroom.Configuration.Types   ( CtHeaderFnConfigs-                                                , HeaderFnConfig(..)-                                                , HeaderFnConfigs(..)-                                                , UpdateCopyrightConfig(..)-                                                )-import           Headroom.Data.Has              ( Has(..) )-import           Headroom.Data.Lens             ( suffixLenses-                                                , suffixLensesFor-                                                )-import           Headroom.HeaderFn.Types        ( HeaderFn(..) )-import           Headroom.HeaderFn.UpdateCopyright-                                                ( SelectedAuthors(..)-                                                , UpdateCopyrightMode(..)-                                                , updateCopyright-                                                )-import           Headroom.Meta                  ( TemplateType )-import           Headroom.Template              ( Template(..) )-import           Headroom.Types                 ( CurrentYear(..) )-import           Headroom.Variables.Types       ( Variables(..) )-import           Lens.Micro                     ( traverseOf )+import           Headroom.Configuration.Types        ( CtHeaderFnConfigs+                                                     , HeaderFnConfig(..)+                                                     , HeaderFnConfigs(..)+                                                     , UpdateCopyrightConfig(..)+                                                     )+import           Headroom.Data.Has                   ( Has(..) )+import           Headroom.Data.Lens                  ( suffixLenses+                                                     , suffixLensesFor+                                                     )+import           Headroom.HeaderFn.Types             ( HeaderFn(..) )+import           Headroom.HeaderFn.UpdateCopyright   ( SelectedAuthors(..)+                                                     , UpdateCopyrightMode(..)+                                                     , updateCopyright+                                                     )+import           Headroom.Meta                       ( TemplateType )+import           Headroom.Template                   ( Template(..) )+import           Headroom.Types                      ( CurrentYear(..) )+import           Headroom.Variables.Types            ( Variables(..) )+import           Lens.Micro                          ( traverseOf ) import           RIO  

@@ -3,7 +3,7 @@ {-| Module      : Headroom.HeaderFn.Types Description : Data types for /license header functions/-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental

@@ -8,7 +8,7 @@ {-| Module      : Headroom.HeaderFn.UpdateCopyright Description : /License Header function/ for updating years in copyrights-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -29,18 +29,18 @@   ) where -import           Headroom.Data.Has              ( Has(..) )-import           Headroom.Data.Regex            ( re-                                                , replace-                                                )-import           Headroom.Data.TextExtra        ( mapLines-                                                , read-                                                )-import           Headroom.HeaderFn.Types        ( HeaderFn(..) )-import           Headroom.Types                 ( CurrentYear(..) )+import           Headroom.Data.Has                   ( Has(..) )+import           Headroom.Data.Regex                 ( re+                                                     , replace+                                                     )+import           Headroom.Data.Text                  ( mapLines+                                                     , read+                                                     )+import           Headroom.HeaderFn.Types             ( HeaderFn(..) )+import           Headroom.Types                      ( CurrentYear(..) ) import           RIO-import qualified RIO.NonEmpty                  as NE-import qualified RIO.Text                      as T+import qualified RIO.NonEmpty                       as NE+import qualified RIO.Text                           as T   ---------------------------------  DATA TYPES  ---------------------------------

@@ -1,10 +1,11 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}  {-| Module      : Headroom.Meta Description : Application metadata (name, vendor, etc.)-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -17,18 +18,29 @@ module Headroom.Meta   ( TemplateType   , buildVersion+  , configBreakingChanges+  , configFileName   , productDesc   , productInfo   , productName-  , website+  , webDoc+  , webDocConfigCurr+  , webDocMigration+  , webRepo   ) where -import           Data.Version                   ( showVersion )-import           Headroom.Template.Mustache     ( Mustache )-import           Paths_headroom                 ( version )+import           Data.Version                        ( showVersion )+import           Headroom.Meta.Version               ( Version(..)+                                                     , parseVersion+                                                     , printVersion+                                                     , pvp+                                                     )+import           Headroom.Template.Mustache          ( Mustache )+import           Paths_headroom                      ( version ) import           RIO-import qualified RIO.Text                      as T+import           RIO.Partial                         ( fromJust )+import qualified RIO.Text                           as T   -- | Type of the template format used for license headers.@@ -36,10 +48,21 @@   -- | Application version, as specified in @headroom.cabal@ file.-buildVersion :: Text-buildVersion = T.pack . showVersion $ version+buildVersion :: Version+buildVersion = fromJust . parseVersion . T.pack . showVersion $ version  +-- | List of versions that made breaking changes into YAML configuration and+-- require some migration steps to be performed by end-user.+configBreakingChanges :: [Version]+configBreakingChanges = [[pvp|0.4.0.0|]]+++-- | Name of the YAML configuration file.+configFileName :: IsString a => a+configFileName = ".headroom.yaml"++ -- | Full product description. productDesc :: Text productDesc = "manage your source code license headers"@@ -47,7 +70,8 @@  -- | Product info. productInfo :: Text-productInfo = mconcat [productName, ", v", buildVersion, " :: ", website]+productInfo =+  mconcat [productName, ", v", printVersion buildVersion, " :: ", webRepo]   -- | Product name.@@ -55,6 +79,21 @@ productName = "headroom"  --- | Homepage website of the product.-website :: Text-website = "https://github.com/vaclavsvejcar/headroom"+-- | Product documentation website for given version.+webDoc :: Version -> Text+webDoc v = "http://doc.norcane.com/headroom/v" <> printVersion v+++-- | Link to configuration documentation for current version.+webDocConfigCurr :: Text+webDocConfigCurr = webDoc buildVersion <> "/documentation/configuration/"+++-- | Product migration guide for given version.+webDocMigration :: Version -> Text+webDocMigration v = webDoc v <> "/migration-guide"+++-- | Product source code repository.+webRepo :: Text+webRepo = "https://github.com/vaclavsvejcar/headroom"

@@ -0,0 +1,139 @@+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE StrictData        #-}+{-# LANGUAGE TemplateHaskell   #-}++{-|+Module      : Headroom.Meta.Version+Description : Type safe representation of Haskell PVP version+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++This module contains data types and functions for working with+Haskell PVP versions (<https://pvp.haskell.org/faq/>) in type safe way.+-}++module Headroom.Meta.Version+  ( Version(..)+  , parseVersion+  , printVersion+  , printVersionP+  , pvp+  )+where++import           Data.Aeson                          ( FromJSON(..)+                                                     , Value(String)+                                                     )+import           Headroom.Data.Regex                 ( match+                                                     , re+                                                     )+import qualified Headroom.Data.Text                 as T+import           Language.Haskell.TH.Quote           ( QuasiQuoter(..) )+import           RIO+import qualified RIO.Text                           as T+++---------------------------------  DATA TYPES  ---------------------------------++-- | Type safe representation of /PVP/ version.+data Version = Version+  { vMajor1 :: Int+  -- ^ first major version+  , vMajor2 :: Int+  -- ^ second major version+  , vMinor  :: Int+  -- ^ minor version+  , vPatch  :: Int+  -- ^ patch level version+  }+  deriving (Eq, Show)+++instance Ord Version where+  compare (Version a1 b1 c1 d1) (Version a2 b2 c2 d2) = go pairs+   where+    pairs = [(a1, a2), (b1, b2), (c1, c2), (d1, d2)]+    go [] = EQ+    go ((x, y) : xs) | x /= y    = compare x y+                     | otherwise = go xs+++instance FromJSON Version where+  parseJSON (String s) = maybe (error . errorMsg $ s) pure (parseVersion s)+  parseJSON other      = error . errorMsg . tshow $ other+++------------------------------  PUBLIC FUNCTIONS  ------------------------------++-- | Parses 'Version' from given text.+--+-- >>> parseVersion "0.3.2.0"+-- Just (Version {vMajor1 = 0, vMajor2 = 3, vMinor = 2, vPatch = 0})+parseVersion :: Text+             -- ^ input text to parse version from+             -> Maybe Version+             -- ^ parsed 'Version'+parseVersion raw = do+  groups <- match [re|^([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)$|] raw+  check . catMaybes $ T.read <$> groups+ where+  check [ma1, ma2, mi, p] = Just $ Version ma1 ma2 mi p+  check _                 = Nothing+++-- | Prints 'Version' in @major1.major2.minor.patch@ format.+--+-- >>> printVersion (Version 0 3 2 0)+-- "0.3.2.0"+printVersion :: Version+             -- ^ 'Version' to print+             -> Text+             -- ^ textual representation+printVersion (Version ma1 ma2 mi p) = T.intercalate "." chunks+  where chunks = tshow <$> [ma1, ma2, mi, p]+++-- | Similar to 'printVersion', but adds the @v@ prefix in front of the version+-- number.+--+-- >>> printVersionP (Version 0 3 2 0)+-- "v0.3.2.0"+printVersionP :: Version -> Text+printVersionP = ("v" <>) . printVersion+++-- | QuasiQuoter for defining 'Version' values checked at compile time.+--+-- >>> [pvp|1.2.3.4|]+-- Version {vMajor1 = 1, vMajor2 = 2, vMinor = 3, vPatch = 4}+pvp :: QuasiQuoter+pvp = QuasiQuoter { quoteExp  = quoteExpVersion+                  , quotePat  = undefined+                  , quoteType = undefined+                  , quoteDec  = undefined+                  }+ where+  quoteExpVersion txt = [| parseVersionUnsafe . T.pack $ txt |]+    where !_ = parseVersionUnsafe . T.pack $ txt -- check at compile time+++------------------------------  PRIVATE FUNCTIONS  -----------------------------++parseVersionUnsafe :: Text -> Version+parseVersionUnsafe raw = case parseVersion raw of+  Nothing  -> error . errorMsg $ raw+  Just res -> res++errorMsg :: Text -> String+errorMsg raw = mconcat+  [ "Value '"+  , T.unpack raw+  , "' is not valid PVP version string. Please define correct version in "+  , "format 'MAJOR1.MAJOR2.MINOR.PATCH' (e.g. '0.4.1.2')."+  ]

@@ -4,7 +4,7 @@ {-| Module      : Headroom.Serialization Description : Various functions for data (de)serialization-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -24,14 +24,14 @@   ) where -import           Data.Aeson                     ( Options-                                                , ToJSON(..)-                                                , defaultOptions-                                                , fieldLabelModifier-                                                )-import qualified Data.Yaml.Pretty              as YP+import           Data.Aeson                          ( Options+                                                     , ToJSON(..)+                                                     , defaultOptions+                                                     , fieldLabelModifier+                                                     )+import qualified Data.Yaml.Pretty                   as YP import           RIO-import qualified RIO.Char                      as C+import qualified RIO.Char                           as C   

@@ -0,0 +1,157 @@+{-# LANGUAGE DerivingStrategies         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoImplicitPrelude          #-}+{-# LANGUAGE StrictData                 #-}+{-# LANGUAGE TypeApplications           #-}+{-# LANGUAGE ViewPatterns               #-}++{-|+Module      : Headroom.SourceCode+Description : Type safe representation of analyzed source code+Copyright   : (c) 2019-2021 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++This module contains data types and function used for analysis and type safe+representation of source code files.+-}++module Headroom.SourceCode+  ( -- * Data Types+    LineType(..)+  , CodeLine+  , SourceCode(..)+    -- * Functions+  , fromText+  , toText+  , firstMatching+  , lastMatching+  , stripStart+  , stripEnd+  , cut+  )+where++import           Control.Monad.State                 ( State+                                                     , evalState+                                                     )+import           Headroom.Data.Coerce                ( coerce+                                                     , inner+                                                     )+import           Headroom.Data.Text                  ( fromLines+                                                     , toLines+                                                     )+import           RIO+import qualified RIO.List                           as L+import qualified RIO.Text                           as T+++---------------------------------  DATA TYPES  ---------------------------------++-- | Represents type of the line in source code.+data LineType+  = Code    -- ^ Line of code+  | Comment -- ^ Line of comment+  deriving (Eq, Show)++-- | Type alias for analyzed line of code.+type CodeLine = (LineType, Text)++-- | Represents analyzed source code.+newtype SourceCode+  = SourceCode [CodeLine]+  deriving stock (Eq, Show)+  deriving newtype (Semigroup, Monoid)+++------------------------------  PUBLIC FUNCTIONS  ------------------------------++-- | Converts 'Text' into 'SourceCode' using the given function to analyze+-- each line's 'LineType'. The analyzing function can hold any state that is+-- accumulated as the text is processed, for example to hold some info about+-- already processed lines.+fromText :: a+         -- ^ initial state of analyzing function+         -> (Text -> State a LineType)+         -- ^ function that analyzes currently processed line+         -> Text+         -- ^ raw source code to analyze+         -> SourceCode+         -- ^ analyzed 'SourceCode'+fromText s0 f (toLines -> ls) = coerce $ zip (evalState (mapM f ls) s0) ls+++-- | Converts analyzed 'SourceCode' back into 'Text'.+toText :: SourceCode+       -- ^ source code to convert back to plain text+       -> Text+       -- ^ resulting plain text+toText (SourceCode sc) = fromLines . fmap snd $ sc+++-- | Finds very first line matching given predicate and optionally performs some+-- operation over it.+firstMatching :: (CodeLine -> Maybe a)+              -- ^ predicate (and transform) function+              -> SourceCode+              -- ^ source code to search in+              -> Maybe (Int, a)+              -- ^ first matching line (if found)+firstMatching f sc = go (coerce sc) 0+ where+  go [] _ = Nothing+  go (x : xs) i | Just res <- f x = Just (i, res)+                | otherwise       = go xs (i + 1)+++-- | Finds very last line matching given predicate and optionally performs some+-- operation over it.+lastMatching :: (CodeLine -> Maybe a)+             -- ^ predicate (and transform) function+             -> SourceCode+             -- ^ source code to search in+             -> Maybe (Int, a)+             -- ^ last matching line (if found)+lastMatching f sc =+  let matching = firstMatching f . inner @_ @[CodeLine] reverse $ sc+      lastIdx  = length (coerce sc :: [CodeLine]) - 1+  in  fmap (first (lastIdx -)) matching+++-- | Strips empty lines at the beginning of source code.+--+-- >>> stripStart $ SourceCode [(Code, ""), (Code, "foo"), (Code, "")]+-- SourceCode [(Code,"foo"),(Code,"")]+stripStart :: SourceCode+           -- ^ source code to strip+           -> SourceCode+           -- ^ stripped source code+stripStart = inner @_ @[CodeLine] (L.dropWhile (T.null . T.strip . snd))+++-- | Strips empty lines at the end of source code.+--+-- >>> stripEnd $ SourceCode [(Code, ""), (Code, "foo"), (Code, "")]+-- SourceCode [(Code,""),(Code,"foo")]+stripEnd :: SourceCode+         -- ^ source code to strip+         -> SourceCode+         -- ^ stripped source code+stripEnd = inner @_ @[CodeLine] (L.dropWhileEnd (T.null . T.strip . snd))+++-- | Cuts snippet from the source code using the given start and end position.+--+-- >>> cut 1 3 $ SourceCode [(Code, "1"), (Code, "2"),(Code, "3"),(Code, "4")]+-- SourceCode [(Code,"2"),(Code,"3")]+cut :: Int+    -- ^ index of first line to be included into the snippet+    -> Int+    -- ^ index of the first line after the snippet+    -> SourceCode+    -- ^ source code to cut+    -> SourceCode+    -- ^ cut snippet+cut s e = inner @_ @[CodeLine] (L.take (e - s) . L.drop s)

@@ -2,38 +2,43 @@ {-# LANGUAGE LambdaCase          #-} {-# LANGUAGE NoImplicitPrelude   #-} {-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE QuasiQuotes         #-} {-# LANGUAGE StrictData          #-}  {-| Module      : Headroom.Template-Description : Generic representation of supported template type-Copyright   : (c) 2019-2020 Vaclav Svejcar+Description : Extensible templating support+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental Portability : POSIX -Module providing generic representation of supported template type, using-the 'Template' /type class/.+Module providing interface for working with template files in extensible way.+Supported template is represented by the 'Template' /type class/. -}  module Headroom.Template-  ( Template(..)+  ( -- * Extendable Template Support+    Template(..)+    -- * Helper Functions+  , emptyTemplate+    -- * Error Data Types   , TemplateError(..)   ) where -import           Headroom.Types                 ( fromHeadroomError-                                                , toHeadroomError-                                                )-import           Headroom.Variables.Types       ( Variables(..) )+import           Data.String.Interpolate             ( iii )+import           Headroom.Types                      ( fromHeadroomError+                                                     , toHeadroomError+                                                     )+import           Headroom.Variables.Types            ( Variables(..) ) import           RIO-import qualified RIO.Text                      as T+import qualified RIO.Text                           as T  --- | Type class representing generic license header template support.-class Template t where-+-- | /Type class/ representing supported template file.+class Template a where    -- | Returns list of supported file extensions for this template type.   templateExtensions :: NonEmpty Text@@ -46,7 +51,7 @@                 -- ^ name of the template (optional)                 -> Text                 -- ^ raw template text-                -> m t+                -> m a                 -- ^ parsed template  @@ -54,7 +59,7 @@   renderTemplate :: MonadThrow m                  => Variables                  -- ^ values of variables to replace-                 -> t+                 -> a                  -- ^ parsed template to render                  -> m Text                  -- ^ rendered template text@@ -62,14 +67,21 @@    -- | Returns the raw text of the template, same that has been parsed by   -- 'parseTemplate' method.-  rawTemplate :: t+  rawTemplate :: a               -- ^ template for which to return raw template text               -> Text               -- ^ raw template text  ----------------------------------  Error Types  --------------------------------+------------------------------  PUBLIC FUNCTIONS  ------------------------------ +-- | Returns empty template of selected type.+emptyTemplate :: (MonadThrow m, Template a) => m a+emptyTemplate = parseTemplate Nothing T.empty+++---------------------------------  ERROR TYPES  --------------------------------+ -- | Error during processing template. data TemplateError   = MissingVariables Text [Text]@@ -78,16 +90,18 @@   -- ^ error parsing raw template text   deriving (Eq, Show, Typeable) + instance Exception TemplateError where   displayException = displayException'   toException      = toHeadroomError   fromException    = fromHeadroomError + displayException' :: TemplateError -> String-displayException' = T.unpack . \case-  MissingVariables name variables -> missingVariables name variables-  ParseError msg                  -> parseError msg- where-  missingVariables name variables =-    mconcat ["Missing variables for '", name, "': ", T.pack $ show variables]-  parseError msg = "Error parsing template: " <> msg+displayException' = \case+  MissingVariables name variables -> [iii|+      Missing variables for #{name}: #{variables}+    |]+  ParseError msg -> [iii|+      Error parsing template: #{msg}+    |]

@@ -1,17 +1,19 @@ {-# LANGUAGE LambdaCase        #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData        #-}  {-| Module      : Headroom.Template.Mustache Description : Implementation of /Mustache/ template support-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental Portability : POSIX -This module provides support for <https://mustache.github.io Mustache> templates.+This module provides support for <https://mustache.github.io Mustache>+templates. -}  module Headroom.Template.Mustache@@ -19,34 +21,40 @@   ) where -import           Headroom.Template              ( Template(..)-                                                , TemplateError(..)-                                                )-import           Headroom.Variables.Types       ( Variables(..) )+import           Headroom.Template                   ( Template(..)+                                                     , TemplateError(..)+                                                     )+import           Headroom.Variables.Types            ( Variables(..) ) import           RIO-import qualified RIO.Text                      as T-import qualified Text.Mustache                 as MU-import           Text.Mustache.Render           ( SubstitutionError(..) )+import qualified RIO.Text                           as T+import qualified Text.Mustache                      as MU+import           Text.Mustache.Render                ( SubstitutionError(..) )   -- | The /Mustache/ template.-data Mustache = Mustache MU.Template Text+data Mustache = Mustache+  { mCompiledTemplate :: MU.Template+  , mRawTemplate      :: Text+  }   deriving Show +instance Eq Mustache where+  a == b = mRawTemplate a == mRawTemplate b + -- | Support for /Mustache/ templates. instance Template Mustache where   templateExtensions = "mustache" :| []   parseTemplate      = parseTemplate'   renderTemplate     = renderTemplate'-  rawTemplate        = rawTemplate'+  rawTemplate        = mRawTemplate   parseTemplate' :: MonadThrow m => Maybe Text -> Text -> m Mustache parseTemplate' name raw = case MU.compileTemplate templateName raw of   Left  err -> throwM . ParseError $ tshow err   Right res -> pure $ Mustache res raw-  where templateName = T.unpack . fromMaybe "" $ name+  where templateName = T.unpack . fromMaybe T.empty $ name   renderTemplate' :: MonadThrow m => Variables -> Mustache -> m Text@@ -61,8 +69,3 @@       in  if length errs == length errs'             then throwM $ MissingVariables (T.pack name) errs'             else pure rendered---rawTemplate' :: Mustache -> Text-rawTemplate' (Mustache _ raw) = raw-

@@ -6,7 +6,7 @@ {-| Module      : Headroom.Types Description : Application data types-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -22,14 +22,11 @@   , fromHeadroomError   , toHeadroomError     -- * Other Data Types-  , TemplateMeta(..)-  , HaddockFieldOffsets(..)   , CurrentYear(..)   ) where -import           Data.Default.Class             ( Default(..) )-import           Data.Typeable                  ( cast )+import           Data.Typeable                       ( cast ) import           RIO  @@ -69,19 +66,3 @@   -- ^ value of current year   }   deriving (Eq, Show)----- | Offsets for selected fields extracted from /Haddock module header/.-data HaddockFieldOffsets = HaddockFieldOffsets-  { hfoCopyright :: Maybe Int-  -- ^ offset for /Copyright/ field-  }-  deriving (Eq, Show)--instance Default HaddockFieldOffsets where-  def = HaddockFieldOffsets { hfoCopyright = Nothing }---- | Metadata parsed from raw /template/, specific for selected /file type/.-data TemplateMeta = HaskellTemplateMeta HaddockFieldOffsets-  deriving (Eq, Show)-

@@ -3,7 +3,7 @@ {-| Module      : Headroom.UI Description : UI Components-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental

@@ -4,7 +4,7 @@ {-| Module      : Headroom.UI.Progress Description : UI component for displaying progress-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -20,9 +20,9 @@ where  import           RIO-import qualified RIO.List                      as L-import qualified RIO.Text                      as T-import           Text.Printf                    ( printf )+import qualified RIO.List                           as L+import qualified RIO.Text                           as T+import           Text.Printf                         ( printf )   -- | Progress indication. First argument is current progress, second the maximum

@@ -1,13 +1,14 @@ {-# LANGUAGE LambdaCase        #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-} {-# LANGUAGE StrictData        #-} {-# LANGUAGE TypeApplications  #-}  {-| Module      : Headroom.Variables Description : Support for template variables-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental@@ -27,16 +28,17 @@   ) where -import           Headroom.Meta                  ( TemplateType )-import           Headroom.Template              ( Template(..) )-import           Headroom.Types                 ( CurrentYear(..)-                                                , fromHeadroomError-                                                , toHeadroomError-                                                )-import           Headroom.Variables.Types       ( Variables(..) )+import           Data.String.Interpolate             ( iii )+import           Headroom.Meta                       ( TemplateType )+import           Headroom.Template                   ( Template(..) )+import           Headroom.Types                      ( CurrentYear(..)+                                                     , fromHeadroomError+                                                     , toHeadroomError+                                                     )+import           Headroom.Variables.Types            ( Variables(..) ) import           RIO-import qualified RIO.HashMap                   as HM-import qualified RIO.Text                      as T+import qualified RIO.HashMap                        as HM+import qualified RIO.Text                           as T   -- | Constructor function for 'Variables' data type.@@ -114,5 +116,7 @@   displayException' :: VariablesError -> String-displayException' = T.unpack . \case-  InvalidVariable raw -> ("Cannot parse variable key=value from: " <> raw)+displayException' = \case+  InvalidVariable raw -> [iii|+      Cannot parse variable in format KEY=VALUE from: #{raw}+    |]

@@ -3,7 +3,7 @@ {-| Module      : Headroom.Variables.Types Description : Data types for "Headroom.Variables"-Copyright   : (c) 2019-2020 Vaclav Svejcar+Copyright   : (c) 2019-2021 Vaclav Svejcar License     : BSD-3-Clause Maintainer  : vaclav.svejcar@gmail.com Stability   : experimental

@@ -9,4 +9,8 @@    // printf() displays the string inside quotation    printf("Hello, World!");    return 0;++   /*+    * block comment+    */ }

@@ -8,6 +8,11 @@ /* This is not header */  int main() {+    // line comment     std::cout << "Hello World!";     return 0;++    /*+     * multiline block comment+     */ }

@@ -10,3 +10,7 @@ }  /* This is not header */++/*+ * block comment+ */

@@ -11,10 +11,32 @@  long description++== Code sample+@+{-# LANGUAGE TypeApplications #-}++module Data.VCS.Test where++import Data.VCS.Ignore ( Git, Repo(..), listRepo )++example :: IO [FilePath]+example = do+  repo <- scanRepo @Git "path/to/repo"+  listRepo repo+@ -}  {-# LANGUAGE OverloadedStrings #-} module Test where +{- single line block comment -}++{-+multi line block comment+-}+ foo :: String foo = "Hello, world!"++-- line comment

@@ -0,0 +1,23 @@+{-|+Module      : Data.VCS.Ignore.Repo+Description : Type class representing the VCS repository+Copyright   : (c) 2020 Vaclav Svejcar+License     : BSD-3-Clause+Maintainer  : vaclav.svejcar@gmail.com+Stability   : experimental+Portability : POSIX++This module contains /type class/ representing the selected type of /VCS/+repository.++@+  {-# LANGUAGE TypeApplications #-}+@+-}++{-# LANGUAGE OverloadedStrings #-}+module Test where++foo :: String+foo = "Hello, World!"+{-# INLINE key_function #-}

@@ -13,4 +13,7 @@     <body>         Hello, World!     </body>+    <!--+        multi line block comment+    --> </html>

@@ -10,5 +10,6 @@     /* This is not header */     public static void main(String[] args) {         System.out.println("Hello, world!");+        // line header     } }

@@ -5,4 +5,5 @@ function answer() {   /* This is not header */   return 42;+  // line comment }

@@ -5,5 +5,11 @@  module Test where +{-+block comment multi line+-}+ foo :: String foo = "Hello, world!"++{- block comment single line -}

@@ -5,4 +5,5 @@  fn main() {     /* This is not header */     println!("Hello World!");+    // line comment }

@@ -8,4 +8,5 @@  object Hello extends App {     println("Hello, world!")+    // line comment }

@@ -11,17 +11,17 @@ where  import           Headroom.Command.Init-import           Headroom.Command.Types         ( CommandInitOptions(..) )-import           Headroom.Configuration.Types   ( LicenseType(..) )-import           Headroom.Data.Has              ( Has(..) )-import           Headroom.Data.Lens             ( suffixLenses-                                                , suffixLensesFor-                                                )-import           Headroom.FileSystem            ( FileSystem(..) )-import           Headroom.FileType.Types        ( FileType(..) )+import           Headroom.Command.Types              ( CommandInitOptions(..) )+import           Headroom.Configuration.Types        ( LicenseType(..) )+import           Headroom.Data.Has                   ( Has(..) )+import           Headroom.Data.Lens                  ( suffixLenses+                                                     , suffixLensesFor+                                                     )+import           Headroom.FileSystem                 ( FileSystem(..) )+import           Headroom.FileType.Types             ( FileType(..) ) import           RIO-import           RIO.FilePath                   ( (</>) )-import qualified RIO.List                      as L+import           RIO.FilePath                        ( (</>) )+import qualified RIO.List                           as L import           Test.Hspec  

@@ -8,26 +8,23 @@ where  import           Headroom.Command.Readers-import           Headroom.Configuration.Types   ( LicenseType )-import           Headroom.Data.EnumExtra        ( EnumExtra(..) )-import           Headroom.FileType.Types        ( FileType )+import           Headroom.Configuration.Types        ( LicenseType )+import           Headroom.Data.EnumExtra             ( EnumExtra(..) )+import           Headroom.FileType.Types             ( FileType ) import           RIO-import qualified RIO.Text                      as T+import qualified RIO.Text                           as T import           Test.Hspec-import           Test.Hspec.QuickCheck          ( prop )+import           Test.Hspec.QuickCheck               ( prop ) import           Test.QuickCheck   spec :: Spec spec = do-  describe "parseLicenseAndFileType" $ do-    prop "should parse license and file type from raw input"-         prop_parseLicenseAndFileType-+  describe "parseLicense" $ do+    prop "should parse license and file type from raw input" prop_parseLicense  where-  licenseTypes = fmap (T.toLower . enumToText) (allValues @LicenseType)-  fileTypes = fmap (T.toLower . enumToText) (allValues @FileType)-  licenseAndFileTypesGen = elements-    $ concatMap (\lt -> fmap (\ft -> lt <> ":" <> ft) fileTypes) licenseTypes-  prop_parseLicenseAndFileType =-    forAll licenseAndFileTypesGen (isJust . parseLicenseAndFileType)+  licenseTypes           = T.toLower . enumToText <$> allValues @LicenseType+  fileTypes              = T.toLower . enumToText <$> allValues @FileType+  together               = \lt -> fmap (\ft -> lt <> ":" <> ft) fileTypes+  licenseAndFileTypesGen = elements $ concatMap together licenseTypes+  prop_parseLicense      = forAll licenseAndFileTypesGen (isJust . parseLicense)

@@ -2,44 +2,47 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude     #-} {-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE QuasiQuotes           #-} {-# LANGUAGE RecordWildCards       #-} {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE StrictData            #-} {-# LANGUAGE TemplateHaskell       #-} {-# LANGUAGE TypeApplications      #-} {-# LANGUAGE TypeFamilies          #-}+ module Headroom.Command.RunSpec   ( spec   ) where  import           Headroom.Command.Run-import           Headroom.Configuration.Types   ( CtHeaderFnConfigs-                                                , HeaderFnConfig(..)-                                                , HeaderFnConfigs(..)-                                                , HeaderSyntax(..)-                                                , LicenseType(..)-                                                , UpdateCopyrightConfig(..)-                                                )-import           Headroom.Data.EnumExtra        ( EnumExtra(..) )-import           Headroom.Data.Has              ( Has(..) )-import           Headroom.Data.Lens             ( suffixLenses-                                                , suffixLensesFor-                                                )-import           Headroom.Data.TextExtra        ( fromLines )-import           Headroom.FileSystem            ( FileSystem(..) )-import           Headroom.FileType.Types        ( FileType(..) )-import           Headroom.Meta                  ( TemplateType )-import           Headroom.Template              ( Template(..) )-import           Headroom.Types                 ( CurrentYear(..) )-import           Headroom.Variables             ( mkVariables )-import           RIO                     hiding ( assert )-import qualified RIO.Map                       as M-import qualified RIO.NonEmpty                  as NE-import qualified RIO.Text                      as T+import           Headroom.Configuration.Types        ( CtHeaderFnConfigs+                                                     , HeaderFnConfig(..)+                                                     , HeaderFnConfigs(..)+                                                     , HeaderSyntax(..)+                                                     , LicenseType(..)+                                                     , UpdateCopyrightConfig(..)+                                                     )+import           Headroom.Data.EnumExtra             ( EnumExtra(..) )+import           Headroom.Data.Has                   ( Has(..) )+import           Headroom.Data.Lens                  ( suffixLenses+                                                     , suffixLensesFor+                                                     )+import           Headroom.Data.Regex                 ( re )+import           Headroom.Data.Text                  ( fromLines )+import           Headroom.FileSystem                 ( FileSystem(..) )+import           Headroom.FileType.Types             ( FileType(..) )+import           Headroom.Meta                       ( TemplateType )+import           Headroom.Template                   ( Template(..) )+import           Headroom.Types                      ( CurrentYear(..) )+import           Headroom.Variables                  ( mkVariables )+import           RIO                          hiding ( assert )+import qualified RIO.Map                            as M+import qualified RIO.NonEmpty                       as NE+import qualified RIO.Text                           as T import           Test.Hspec-import           Test.Hspec.QuickCheck          ( prop )-import           Test.QuickCheck         hiding ( sample )+import           Test.Hspec.QuickCheck               ( prop )+import           Test.QuickCheck              hiding ( sample ) import           Test.QuickCheck.Monadic  @@ -111,21 +114,8 @@             , "-- Copyright (c) 2017-2020 2nd Author"             ]           vars   = mkVariables [("sndAuthor", "2nd Author")]-          syntax = LineComment "--"+          syntax = LineComment [re|^--|] (Just "--")       runRIO env (postProcessHeader' syntax vars sample) `shouldReturn` expected---  describe "sanitizeHeader" $ do-    it "does nothing when block comment syntax used" $ do-      let sample = fromLines ["{-", "foo", "bar", "-}"]-          syntax = BlockComment "{-" "-}"-      sanitizeHeader syntax sample `shouldBe` sample--    it "adds missing single-line comment syntax" $ do-      let sample   = fromLines ["-- first", "second", "-- third"]-          syntax   = LineComment "--"-          expected = fromLines ["-- first", "-- second", "-- third"]-      sanitizeHeader syntax sample `shouldBe` expected   env :: TestEnv

@@ -0,0 +1,50 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}++module Headroom.Configuration.CompatSpec+  ( spec+  )+where++import           Headroom.Configuration.Compat+import           Headroom.Meta.Version               ( Version(..)+                                                     , pvp+                                                     )+import           RIO+import           Test.Hspec+++spec :: Spec+spec = do+  describe "checkCompatibility" $ do+    it "passes when config version is compatible" $ do+      let yaml     = "version: 0.4.0.0"+          curr     = [pvp|0.4.0.0|]+          version  = [pvp|0.4.0.0|]+          versions = [[pvp|0.1.0.0|], [pvp|0.2.1.0|], [pvp|0.4.0.0|]]+      checkCompatibility versions curr yaml `shouldBe` Just version++    it "fails when config version is not compatible" $ do+      let yaml     = "version: 0.2.1.0"+          curr     = [pvp|0.2.1.0|]+          versions = [[pvp|0.1.0.0|], [pvp|0.2.1.0|], [pvp|0.4.0.0|]]+      let err (UnsupportedVersion [Version 0 4 0 0] (Version 0 2 1 0)) = True+          err _ = False+      checkCompatibility versions curr yaml `shouldThrow` err++    it "fails when version is newer than Headroom version" $ do+      let yaml     = "version: 0.2.1.0"+          curr     = [pvp|0.2.0.0|]+          versions = [[pvp|0.1.0.0|]]+      let err (NewerVersionDetected (Version 0 2 1 0)) = True+          err _ = False+      checkCompatibility versions curr yaml `shouldThrow` err++    it "fails when config version cannot be determined" $ do+      let yaml     = ""+          curr     = [pvp|0.2.0.0|]+          versions = [[pvp|0.1.0.0|], [pvp|0.2.1.0|], [pvp|0.4.0.0|]]+      let err CannotParseVersion = True+          err _                  = False+      checkCompatibility versions curr yaml `shouldThrow` err

@@ -0,0 +1,48 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Headroom.Configuration.EnrichSpec+  ( spec+  )+where++import           Headroom.Configuration.Enrich+import           RIO+import           Test.Hspec+++spec :: Spec+spec = do+  describe "withArray" $ do+    it "produces valid YAML array field" $ do+      let field  = "name"+          values = ["foo", "bar"] :: [Text]+      withArray values field `shouldBe` (Array, "name:\n- foo\n- bar")+++  describe "withText" $ do+    it "produces valid YAML string from Text value" $ do+      let field = "name"+          value = "John Smith" :: Text+      withText value field `shouldBe` (String, "name: John Smith")+++  describe "replaceEmptyValue" $ do+    it "replaces YAML array field" $ do+      let field  = "name"+          values = ["foo", "bar"] :: [Text]+          yaml   = "name: []"+          action = replaceEmptyValue field $ withArray values+      enrich action yaml `shouldBe` "name:\n- foo\n- bar"++    it "replaces multiple YAML array fields using Semigroup instance" $ do+      let animalsF      = "animals"+          animals       = ["dog", "cat"] :: [Text]+          colorsF       = "colors"+          colors        = ["blue", "red"] :: [Text]+          yaml          = "colors: []\nanimals: []"+          enrichAnimals = replaceEmptyValue animalsF $ withArray animals+          enrichColors  = replaceEmptyValue colorsF (withArray colors)+          action        = enrichAnimals <> enrichColors+          expected      = "colors:\n- blue\n- red\nanimals:\n- dog\n- cat"+      enrich action yaml `shouldBe` expected

@@ -6,7 +6,7 @@ where  import           Headroom.Configuration-import           Headroom.Embedded              ( defaultConfig )+import           Headroom.Embedded                   ( defaultConfig ) import           RIO import           Test.Hspec 

@@ -0,0 +1,24 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Headroom.Data.CoerceSpec+  ( spec+  )+where++import           Headroom.Data.Coerce+import           RIO+import qualified RIO.Text                           as T+import           Test.Hspec+++spec :: Spec+spec = do+  describe "inner" $ do+    it "applies function to inner value of newtype" $ do+      let sample   = Foo "hello"+          expected = Foo "HELLO"+      inner T.toUpper sample `shouldBe` expected+++newtype Foo = Foo Text deriving (Eq, Show)

@@ -20,3 +20,12 @@       match regex "foz" `shouldSatisfy` isNothing       match regex "foosdas" `shouldSatisfy` isJust       match regex "barfoo" `shouldSatisfy` isJust+++  describe "isMatch" $ do+    it "checks if regular expression matches against given sample" $ do+      let regex = [re|foo|bar|]+      isMatch regex "foz" `shouldBe` False+      isMatch regex "xxx" `shouldBe` False+      isMatch regex "foosdas" `shouldBe` True+      isMatch regex "barfoo" `shouldBe` True

@@ -1,57 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications  #-}-module Headroom.Data.TextExtraSpec-  ( spec-  )-where--import           Headroom.Data.TextExtra-import           RIO-import           Test.Hspec---spec :: Spec-spec = do-  describe "mapLines" $ do-    it "should return same output for identity function" $ do-      let sample = fromLines ["foo zz", "bar", "xx"]-      mapLines id sample `shouldBe` sample--    it "should map all lines using the function" $ do-      let sample   = fromLines ["foo zz", "bar", "xx"]-          fn       = ("L: " <>)-          expected = fromLines ["L: foo zz", "L: bar", "L: xx"]-      mapLines fn sample `shouldBe` expected---  describe "read" $ do-    it "parses value from given text using Read instance" $ do-      read @Int "123" `shouldBe` Just 123---  describe "fromLines" $ do-    it "handles correctly empty linex" $ do-      fromLines [] `shouldBe` ""--    it "handles correctly single line text" $ do-      fromLines ["foo"] `shouldBe` "foo"--    it "joins lines of text" $ do-      fromLines ["first", "second"] `shouldBe` "first\nsecond"-      fromLines ["first", "second", ""] `shouldBe` "first\nsecond\n"---  describe "toLines" $ do-    it "handles correctly empty text" $ do-      toLines "" `shouldBe` []--    it "splits lines of text to list" $ do-      toLines "first\nsecond" `shouldBe` ["first", "second"]-      toLines "first\nsecond\n" `shouldBe` ["first", "second", ""]---  describe "toLines . fromLines" $ do-    it "does not alter newlines in processed text" $ do-      (fromLines . toLines $ "first\nsecond") `shouldBe` "first\nsecond"-      (fromLines . toLines $ "first\nsecond\n") `shouldBe` "first\nsecond\n"

@@ -0,0 +1,96 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications  #-}+module Headroom.Data.TextSpec+  ( spec+  )+where++import           Headroom.Data.Text+import           RIO+import qualified RIO.Text                           as T+import           Test.Hspec+++spec :: Spec+spec = do++  describe "commonLinesPrefix" $ do+    it "returns longest common prefix for lines of text" $ do+      let text = fromLines ["-- foo", "-- bar", "-- xx"]+      commonLinesPrefix text `shouldBe` Just "-- "++    it "returns Nothing if not all elements starts with same prefix" $ do+      let text = fromLines ["-- foo", "bar", "-- xx"]+      commonLinesPrefix text `shouldBe` Nothing++    it "returns Nothing if no common prefix found" $ do+      let text = fromLines ["foo", "bar", "hello"]+      commonLinesPrefix text `shouldBe` Nothing++    it "returns Nothing if input is empty" $ do+      commonLinesPrefix T.empty `shouldBe` Nothing+++  describe "replaceFirst" $ do+    it "does nothing on empty pattern" $ do+      replaceFirst "" "/" "a :: b :: c" `shouldBe` "a :: b :: c"++    it "replaces only first pattern with substitute" $ do+      replaceFirst "::" "/" "a :: b :: c" `shouldBe` "a / b :: c"+++  describe "mapLines" $ do+    it "returns same output for identity function" $ do+      let sample = fromLines ["foo zz", "bar", "xx"]+      mapLines id sample `shouldBe` sample++    it "maps all lines using the function" $ do+      let sample   = fromLines ["foo zz", "bar", "xx"]+          fn       = ("L: " <>)+          expected = fromLines ["L: foo zz", "L: bar", "L: xx"]+      mapLines fn sample `shouldBe` expected+++  describe "mapLinesF" $ do+    it "returns same output for identity function" $ do+      let sample = fromLines ["foo zz", "bar", "xx"]+      mapLinesF (Just <$> id) sample `shouldBe` sample++    it "maps all lines using the function" $ do+      let sample   = fromLines ["foo zz", "bar", "xx"]+          fn       = \l -> if l == "bar" then Nothing else Just ("L: " <> l)+          expected = fromLines ["L: foo zz", "L: xx"]+      mapLinesF fn sample `shouldBe` expected+++  describe "read" $ do+    it "parses value from given text using Read instance" $ do+      read @Int "123" `shouldBe` Just 123+++  describe "fromLines" $ do+    it "handles correctly empty linex" $ do+      fromLines [] `shouldBe` ""++    it "handles correctly single line text" $ do+      fromLines ["foo"] `shouldBe` "foo"++    it "joins lines of text" $ do+      fromLines ["first", "second"] `shouldBe` "first\nsecond"+      fromLines ["first", "second", ""] `shouldBe` "first\nsecond\n"+++  describe "toLines" $ do+    it "handles correctly empty text" $ do+      toLines "" `shouldBe` []++    it "splits lines of text to list" $ do+      toLines "first\nsecond" `shouldBe` ["first", "second"]+      toLines "first\nsecond\n" `shouldBe` ["first", "second", ""]+++  describe "toLines . fromLines" $ do+    it "does not alter newlines in processed text" $ do+      (fromLines . toLines $ "first\nsecond") `shouldBe` "first\nsecond"+      (fromLines . toLines $ "first\nsecond\n") `shouldBe` "first\nsecond\n"