diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,16 @@ # Changelog All notable changes to this project will be documented in this file. +## 0.2.0.0 (not released yet) +- [#28] Allow license headers to be anywhere in the file, not only at the very beginning. +- [#31] Render templates for each source file instead of once (blocker for [#25]) +- [#32] Allow custom user configuration for license headers. +- [#34] Support for [Rust](https://www.rust-lang.org/) +- [#35] Support for [Bash](https://www.gnu.org/software/bash/) +- [#36] Support for _C/C++_ +- [#38] Add `-a|--add-headers` command-line option +- bump _LTS Haskell_ to `15.9` + ## 0.1.3.0 (released 2020-03-23) - [#24] Added _Init_ command that automatically creates initial _Headroom_ configuration and set of templates. - bump _LTS Haskell_ to `15.5` diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,268 +1,11 @@ -So you are tired of managing license headers in your codebase by hand? Then __Headroom__ is the right tool for you! Now you can define your license header as [Mustache][web:mustache] template, put all the variables (such as author's name, year, etc.) into the [YAML][wiki:yaml] config file and Headroom will take care to add such license headers to all your source code files. - -__Table of Contents__ - -- [1. Main Features](#1-main-features) -- [2. Planned Features](#2-planned-features) -- [3. Installation](#3-installation) - - [3.1. From Source Code](#31-from-source-code) - - [3.1.1. Using Cabal](#311-using-cabal) - - [3.1.2. Using Stack](#312-using-stack) -- [4. Basic Overview](#4-basic-overview) - - [4.1. Main Concepts](#41-main-concepts) - - [4.2. License Header Detection](#42-license-header-detection) -- [5. Quick Start Guide](#5-quick-start-guide) - - [5.1. Initializing Headroom](#51-initializing-headroom) - - [5.1.1. Automatic Initialization](#511-automatic-initialization) - - [5.1.2. Manual Initialization](#512-manual-initialization) - - [5.2. YAML Configuration File](#52-yaml-configuration-file) - - [5.3. Running Headroom](#53-running-headroom) -- [6. Command Line Interface Overview](#6-command-line-interface-overview) - - [6.1. Init Command](#61-init-command) - - [6.2. Run Command](#62-run-command) - - [6.3. Generator Command](#63-generator-command) - - [6.3.1. Supported License Types](#631-supported-license-types) - - [6.3.2. Supported File Types](#632-supported-file-types) - -## 1. Main Features -- __License Header Management__ - allows to add, replace or drop license headers in source code files. -- __License Header Autodetection__ - you can even replace or drop license headers that weren't generated by Headroom, as they are automatically detected from source code files, not from template files. -- __Template Generator__ - generates license header templates for most popular _open source_ licenses. You can use these as-is, customize them or ignore them and use your custom templates. -- __Automatic Initialization__ - using the _Init_ command, _Headroom_ can detect what source code files you have in your project and generate initial configuration file and appropriate template skeletons. - -## 2. Planned Features -- [[#25]][i25] __Content-aware Templates__ - license header templates will be able to extract some template variables from source code file for which the template is rendered -- __Binary Distribution__ - pre-built binaries will be generated for each release for major OS platforms - -## 3. Installation -> Binary distribution will be available soon, there are also plans to add _Headroom_ to popular package managers. - -### 3.1. From Source Code -Headroom is written in [Haskell][web:haskell], so you can install it from source code either using [Cabal][web:cabal] or [Stack][web:stack]. - -#### 3.1.1. Using Cabal -1. install [Cabal][web:cabal] for your platform -1. run `cabal install headroom` -1. add `$HOME/.cabal/bin` to your `$PATH` - -#### 3.1.2. Using Stack -1. install [Stack][web:stack] for your platform -1. run `stack install headroom` -1. add `$HOME/.local/bin` to your `$PATH` - -## 4. Basic Overview - -### 4.1. Main Concepts -1. __Template files__ - Template files contains templates in [Mustache][web:mustache] format, used for rendering license headers. During rendering phase, all variables are replaced by values loaded from _YAML_ configuration file. Each supported source code file has unique template, because license headers may differ for individual programming languages (i.e. different syntax for comments, etc.). -1. __Source Code Files__ - Headroom automatically discovers individual source code files in configured location and can manage (add/remove/drop) license headers in supported types of source code files. -1. __Variables__ - are defined in _YAML_ configuration file and these values are used to replace variables present in the template files. - -### 4.2. License Header Detection -Unlike many other tools, Headroom can not only add, but also replace or drop existing license headers in source code files, even if there is already some header not generated by Headroom. This is done by implementing unique detection logic for each individual supported file type, but usually it's expected that the very first block comment is the license header. If you miss support for your favorite file type, please [open new issue][meta:new-issue]. - -## 5. Quick Start Guide -Let's demonstrate how to use Headroom in real world example: assume you have small source code repository with following structure and you'd like to setup Headroom for it: - -``` -project/ - └── src/ - ├── scala/ - │ ├── Foo.scala - │ └── Bar.scala - └── html/ - └── template1.html -``` - -### 5.1. Initializing Headroom - -#### 5.1.1. Automatic Initialization -Easiest and fastest way how to initialize Headroom for your project is to use the _Init_ command, which generates all the boilerplate for you. The only drawback is that you can use it only in case that you use any supported open source license for which Headroom contains license header templates: - -```shell -cd project/ -headroom init -l bsd3 -s src/ -``` - -This command will automatically scan source code directories for supported file types and will generate: -1. `.headroom.yaml` configuration file with correctly set path to template files, source codes and will contain dummy values for variables. -1. `headroom-templates/` directory which contains template files for all known file types you use in your project and for open source license you choose. - -Now the project structure will be following: - -``` -project/ - ├── src/ - │ ├── scala/ - │ │ ├── Foo.scala - │ │ └── Bar.scala - │ └── html/ - │ └── template1.html - ├── headroom-templates/ - │ ├── html.mustache - │ └── scala.mustache - └── .headroom.yaml -``` - -#### 5.1.2. Manual Initialization -If you for some reason don't want to use the automatic initialization using the steps above, you can either create all the required files (_YAML_ configuration and template files) by hand, or you can use the _Generator_ command to do that in semi-automatic way: - -```shell -cd project/ -headroom gen -c >./.headroom.yaml - -mkdir headroom-templates/ -cd headroom-templates/ - -headroom gen -l bsd3:css >./css.mustache -headroom gen -l bsd3:html >./html.mustache -headroom gen -l bsd3:scala >./scala.mustache -``` - -After these steps, make sure you set correctly the paths to template files and source code files in the _YAML_ configuration file. - -### 5.2. YAML Configuration File -Headroom's _YAML_ configuration file must be placed in root of your project and called `.headroom.yaml`. The configuration itself is pretty simple and consists of following keys: - -```yaml -run-mode: add -source-paths: - - . -template-paths: - - headroom-templates -variables: - author: John Smith - email: john.smith@example.com - project: My project - year: '2020' -``` - -- `run-mode` - sets the default behaviour of _Run_ command (`headroom run`). Possible options are: - - `add` - Headroom will only add license headers to source code where these are missing, but won't touch files with existing headers - - `drop` - Headroom will drop existing license headers without any replacement - - `replace` - Headroom will add missing or replace existing license headers -- `source-paths` - paths to source code files (either files or directories) -- `template-paths` - paths to template files (either files or directories) -- `variables` - variables (key-value) to replace in templates - -These settings can be then overriden by corresponding command line optionss. See more details about these settings in command line interface overview section below. - -### 5.3. Running Headroom -Now we're ready to run Headroom: - -```shell -cd project/ -headroom run # adds license headers to source code files -headroom run -r # adds or replaces existing license headers -headroom run -d # drops existing license headers from files -``` - -## 6. Command Line Interface Overview -Headroom provides various commands for different use cases. You can check commands overview by performing following command: - -``` -$ headroom --help -headroom v0.1.3.0 :: https://github.com/vaclavsvejcar/headroom - -Usage: headroom COMMAND - manage your source code license headers - -Available options: - -h,--help Show this help text - -Available commands: - run add or replace source code headers - gen generate stub configuration and template files - init initialize current project for Headroom -``` - -### 6.1. Init Command -Init command is used to initialize Headroom for project by generating all the required files (_YAML_ config file and template files). You can display available options by running following command: - -``` -$ headroom init --help -Usage: headroom init (-l|--license-type LICENSE_TYPE) (-s|--source-path PATH) - initialize current project for Headroom - -Available options: - -l,--license-type LICENSE_TYPE - type of open source license - -s,--source-path PATH path to source code file/directory - -h,--help Show this help text -``` - -### 6.2. Run Command -Run command is used to manipulate (add, replace or drop) license headers in source code files. You can display available options by running following command: - -``` -$ headroom run --help -Usage: headroom run [-s|--source-path PATH] [-t|--template-path PATH] - [-v|--variable KEY=VALUE] ([-r|--replace-headers] | - [-d|--drop-headers]) [--debug] - add or replace source code headers - -Available options: - -s,--source-path PATH path to source code file/directory - -t,--template-path PATH path to header template file/directory - -v,--variable KEY=VALUE - values for template variables - -r,--replace-headers force replace existing license headers - -d,--drop-headers drop existing license headers only - --debug produce more verbose output - -h,--help Show this help text -``` - -Note that command line options override options set in the configuration _YAML_ file. Relation between command line options and _YAML_ configuration options is below: - -| YAML option | Command Line Option | -|---------------------|---------------------------| -| `run-mode: add` | _(default mode)_ | -| `run-mode: drop` | `-d`, `--drop-headers` | -| `run-mode: replace` | `-r`, `--replace-headers` | -| `source-paths` | `-s`, `--source-path` | -| `template-paths` | `-t`, `--template-path` | - - -### 6.3. Generator Command -Generator command is used to generate stubs for license header template and _YAML_ configuration file. You can display available options by running following command: - -``` -$ headroom gen --help -Usage: headroom gen [-c|--config-file] [-l|--license name:type] - generate stub configuration and template files - -Available options: - -c,--config-file generate stub YAML config file to stdout - -l,--license name:type generate template for license and file type - -h,--help Show this help text -``` - -When using the `-l,--license` option, you need to select the _license type_ and _file type_ from the list of supported ones listed bellow. For example to generate template for _Apache 2.0_ license and _Haskell_ file type, you need to use the `headroom gen -l apache2:haskell`. - -#### 6.3.1. Supported License Types -Below is the list of supported _open source_ license types. If you miss support for license you use, feel free to [open new issue][meta:new-issue]. - -| License | Used Name | -|----------------|-----------| -| _Apache 2.0_ | `apache2` | -| _BSD 3-Clause_ | `bsd3` | -| _GPLv2_ | `gpl2` | -| _GPLv3_ | `gpl3` | -| _MIT_ | `mit` | - -#### 6.3.2. Supported File Types -Below is the list of supported source code file types. If you miss support for programming language you use, feel free to [open new issue][meta:new-issue]. +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][web:mustache] template, put all the variables (such as author's name, year, etc.) into the [YAML][wiki:yaml] config file and Headroom will take care to add such license headers to all your source code files. -| Language | Used Name | Supported Extensions | -|--------------|-----------|----------------------| -| _CSS_ | `css` | `.css` | -| _Haskell_ | `haskell` | `.hs` | -| _HTML_ | `html` | `.html`, `.htm` | -| _Java_ | `java` | `.java` | -| _JavaScript_ | `js` | `.js` | -| _Scala_ | `scala` | `.scala` | +[![asciicast](https://asciinema.org/a/4Pfxdss0V4msFjjt2z6mgCZCp.svg)](https://asciinema.org/a/4Pfxdss0V4msFjjt2z6mgCZCp) +See the [GitHub project page](https://github.com/vaclavsvejcar/headroom/) for more details. [i25]: https://github.com/vaclavsvejcar/headroom/issues/25 +[file:embedded/default-config.yaml]: https://github.com/vaclavsvejcar/headroom/blob/master/embedded/default-config.yaml [meta:new-issue]: https://github.com/vaclavsvejcar/headroom/issues/new [web:bsd-3]: https://opensource.org/licenses/BSD-3-Clause [web:cabal]: https://www.haskell.org/cabal/ diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,13 +1,14 @@ {-| Module : Main -Description : Application entry point +Description : Main application launcher Copyright : (c) 2019-2020 Vaclav Svejcar License : BSD-3 Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX -Functions responsible for application bootstrap. +Code responsible for booting up the application and parsing command line +arguments. -} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -15,55 +16,39 @@ module Main where -import Headroom.Command ( Command(..) - , commandParser - ) -import Headroom.Command.Gen ( commandGen ) -import Headroom.Command.Gen.Env ( GenMode(..) - , GenOptions(GenOptions) +import Headroom.Command ( commandParser ) +import Headroom.Command.Gen ( commandGen + , parseGenMode ) import Headroom.Command.Init ( commandInit ) -import Headroom.Command.Init.Env ( InitOptions(InitOptions) ) import Headroom.Command.Run ( commandRun ) -import Headroom.Command.Run.Env ( RunOptions(RunOptions) ) -import Headroom.License ( LicenseType - , parseLicenseType - ) -import Headroom.Types ( HeadroomError(..) - , InitCommandError(..) +import Headroom.Types ( ApplicationError(..) + , Command(..) + , CommandGenOptions(..) + , CommandInitOptions(..) + , CommandRunOptions(..) ) import Options.Applicative import Prelude ( putStrLn ) import RIO + main :: IO () main = do command' <- execParser commandParser catch (bootstrap command') (\ex -> do - putStrLn $ "ERROR: " <> displayException (ex :: HeadroomError) + putStrLn $ "ERROR: " <> displayException (ex :: ApplicationError) exitWith $ ExitFailure 1 ) bootstrap :: Command -> IO () bootstrap = \case - Run sourcePaths templatePaths variables runMode debug -> - commandRun (RunOptions runMode sourcePaths templatePaths variables debug) c@(Gen _ _) -> do genMode <- parseGenMode c - commandGen (GenOptions genMode) - Init licenseType sourcePaths -> do - licenseType' <- parseLicenseType' licenseType - commandInit (InitOptions sourcePaths licenseType') - -parseGenMode :: MonadThrow m => Command -> m GenMode -parseGenMode = \case - Gen True Nothing -> pure GenConfigFile - Gen False (Just license) -> pure $ GenLicense license - _ -> throwM NoGenModeSelected - -parseLicenseType' :: MonadThrow m => Text -> m LicenseType -parseLicenseType' input = case parseLicenseType input of - Just licenseType -> pure licenseType - Nothing -> throwM $ InitCommandError $ InvalidLicenseType input + commandGen (CommandGenOptions genMode) + Init licenseType sourcePaths -> + commandInit (CommandInitOptions sourcePaths licenseType) + Run sourcePaths templatePaths variables runMode debug -> commandRun + (CommandRunOptions runMode sourcePaths templatePaths variables debug) diff --git a/embedded/config-file.yaml b/embedded/config-file.yaml --- a/embedded/config-file.yaml +++ b/embedded/config-file.yaml @@ -2,16 +2,26 @@ ## See https://github.com/vaclavsvejcar/headroom for more details. ## Defines the behaviour how to handle license headers, possible options are: +## ## - add = (default) adds license header to files with no existing header +## (same as '-a|--add-headers' command line argument) ## - drop = drops existing license header from without replacement +## (same as '-d|--drop-headers' command line argument) ## - replace = adds or replaces existing license header +## (same as '-r|--replace-headers' command line argument) run-mode: add -## Paths to source code files (either files or directories). +## Paths to source code files (either files or directories), +## same as '-s|--source-path=PATH' command line argument (can be used multiple +## times for more than one path). source-paths: [] -## Paths to template files (either files or directories). +## Paths to template files (either files or directories), +## same as '-t|--template-path=PATH' command line argument (can be used multiple +## times for more than one path). template-paths: [] -## Variables (key-value) to replace in templates. +## Variables (key-value) to replace in templates, +## same as '-v|--variable="KEY=VALUE"' command line argument (can be used +## multiple times for more than one path). variables: {} diff --git a/embedded/default-config.yaml b/embedded/default-config.yaml new file mode 100644 --- /dev/null +++ b/embedded/default-config.yaml @@ -0,0 +1,173 @@ +## This is the configuration file for Headroom. +## See https://github.com/vaclavsvejcar/headroom for more details. + +## Defines the behaviour how to handle license headers, possible options are: +## +## - add = (default) adds license header to files with no existing header +## (same as '-a|--add-headers' command line argument) +## - drop = drops existing license header from without replacement +## (same as '-d|--drop-headers' command line argument) +## - replace = adds or replaces existing license header +## (same as '-r|--replace-headers' command line argument) +run-mode: add + +## Paths to source code files (either files or directories), +## same as '-s|--source-path=PATH' command line argument (can be used multiple +## times for more than one path). +## +## NOTE: Not defined in default configuration as this options must be defined by +## the user. +# source-paths: [] + +## Paths to template files (either files or directories), +## same as '-t|--template-path=PATH' command line argument (can be used multiple +## times for more than one path). +## +## NOTE: Not defined in default configuration as this options must be defined by +## the user. +# template-paths: [] + +## Variables (key-value) to replace in templates, +## same as '-v|--variable="KEY=VALUE"' command line argument (can be used +## multiple times for more than one path). +## +## NOTE: Not defined in default configuration as this options must be defined by +## the user. +# variables: {} + +## Allows to change behaviour of license header detection and placement. Such +## configuration is defined for every supported file type, where individual +## 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. +## - 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 +## is placed at the very beginning of the file. +## - put-before = List of regexp patterns, where the license header is +## placed BEFORE the very first line matching one of the +## given regular expressions. If no match found, header +## is placed at the very beginning of the file. +## - block-comment = Defines that the license header is rendered using the +## multi-line (block) comment syntax (such as '/* */'). +## Has two mandatory fields: +## starts-with = Defines how the license header comment starts. +## ends-with = Defines how the license header comment ends. +## 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. +license-headers: + ## C configuration + c: + file-extensions: ["c"] + margin-after: 0 + margin-before: 0 + put-after: [] + put-before: ["^#include"] + block-comment: + starts-with: "/*" + ends-with: "*/" + + ## C++ configuration + cpp: + file-extensions: ["cpp"] + margin-after: 0 + margin-before: 0 + put-after: [] + put-before: ["^#include"] + block-comment: + starts-with: "/*" + ends-with: "*/" + + ## CSS configuration + css: + file-extensions: ["css"] + margin-after: 0 + margin-before: 0 + put-after: [] + put-before: ['([^\r\n,{}]+)(,(?=[^}]*{)|\s*{)'] + block-comment: + starts-with: "/*" + ends-with: "*/" + + ## Haskell configuration + haskell: + file-extensions: ["hs"] + margin-after: 0 + margin-before: 0 + put-after: [] + put-before: ["^module"] + block-comment: + starts-with: "{-|" + ends-with: "-}" + + ## HTML configuration + html: + file-extensions: ["htm", "html"] + margin-after: 0 + margin-before: 0 + put-after: [] + put-before: ["^(" + + ## Java configuration + java: + file-extensions: ["java"] + margin-after: 0 + margin-before: 0 + put-after: [] + put-before: ["^package"] + block-comment: + starts-with: "/*" + ends-with: "*/" + + ## JS configuration + js: + file-extensions: ["js"] + margin-after: 0 + margin-before: 0 + put-after: [] + put-before: [] + block-comment: + starts-with: "/*" + ends-with: "*/" + + ## Rust configuration + rust: + file-extensions: ["rs"] + margin-after: 0 + margin-before: 0 + put-after: [] + put-before: ["^use"] + block-comment: + starts-with: "/*" + ends-with: "*/" + + ## Scala configuration + scala: + file-extensions: ["scala"] + margin-after: 0 + margin-before: 0 + put-after: [] + put-before: ["^package"] + block-comment: + starts-with: "/*" + ends-with: "*/" + + ## Shell configuration + shell: + file-extensions: ["sh"] + margin-after: 1 + margin-before: 1 + put-after: ["^#!"] + put-before: [] + line-comment: + prefixed-by: "#" diff --git a/embedded/license/apache2/c.mustache b/embedded/license/apache2/c.mustache new file mode 100644 --- /dev/null +++ b/embedded/license/apache2/c.mustache @@ -0,0 +1,16 @@ +/* + * {{ project }} + * Copyright {{ year }} {{ author }} + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express + * or implied. See the License for the specific language governing + * permissions and limitations under the License. + */ diff --git a/embedded/license/apache2/cpp.mustache b/embedded/license/apache2/cpp.mustache new file mode 100644 --- /dev/null +++ b/embedded/license/apache2/cpp.mustache @@ -0,0 +1,16 @@ +/* + * {{ project }} + * Copyright {{ year }} {{ author }} + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express + * or implied. See the License for the specific language governing + * permissions and limitations under the License. + */ diff --git a/embedded/license/apache2/css.mustache b/embedded/license/apache2/css.mustache --- a/embedded/license/apache2/css.mustache +++ b/embedded/license/apache2/css.mustache @@ -1,4 +1,5 @@ /* + * {{ project }} * Copyright {{ year }} {{ author }} * * Licensed under the Apache License, Version 2.0 (the "License"); diff --git a/embedded/license/apache2/html.mustache b/embedded/license/apache2/html.mustache --- a/embedded/license/apache2/html.mustache +++ b/embedded/license/apache2/html.mustache @@ -1,4 +1,5 @@ diff --git a/embedded/license/mpl2/java.mustache b/embedded/license/mpl2/java.mustache new file mode 100644 --- /dev/null +++ b/embedded/license/mpl2/java.mustache @@ -0,0 +1,8 @@ +/* + * {{ project }} + * Copyright (c) {{ year }} {{ author }} + * + * This Source Code Form is subject to the terms of the Mozilla Public + * License, version 2.0. If a copy of the MPL was not distributed with this + * file, You can obtain one at http://mozilla.org/MPL/2.0/. + */ diff --git a/embedded/license/mpl2/js.mustache b/embedded/license/mpl2/js.mustache new file mode 100644 --- /dev/null +++ b/embedded/license/mpl2/js.mustache @@ -0,0 +1,8 @@ +/* + * {{ project }} + * Copyright (c) {{ year }} {{ author }} + * + * This Source Code Form is subject to the terms of the Mozilla Public + * License, version 2.0. If a copy of the MPL was not distributed with this + * file, You can obtain one at http://mozilla.org/MPL/2.0/. + */ diff --git a/embedded/license/mpl2/rust.mustache b/embedded/license/mpl2/rust.mustache new file mode 100644 --- /dev/null +++ b/embedded/license/mpl2/rust.mustache @@ -0,0 +1,8 @@ +/* + * {{ project }} + * Copyright (c) {{ year }} {{ author }} + * + * This Source Code Form is subject to the terms of the Mozilla Public + * License, version 2.0. If a copy of the MPL was not distributed with this + * file, You can obtain one at http://mozilla.org/MPL/2.0/. + */ diff --git a/embedded/license/mpl2/scala.mustache b/embedded/license/mpl2/scala.mustache new file mode 100644 --- /dev/null +++ b/embedded/license/mpl2/scala.mustache @@ -0,0 +1,8 @@ +/* + * {{ project }} + * Copyright (c) {{ year }} {{ author }} + * + * This Source Code Form is subject to the terms of the Mozilla Public + * License, version 2.0. If a copy of the MPL was not distributed with this + * file, You can obtain one at http://mozilla.org/MPL/2.0/. + */ diff --git a/embedded/license/mpl2/shell.mustache b/embedded/license/mpl2/shell.mustache new file mode 100644 --- /dev/null +++ b/embedded/license/mpl2/shell.mustache @@ -0,0 +1,6 @@ +# {{ project }} +# Copyright (c) {{ year }} {{ author }} +# +# This Source Code Form is subject to the terms of the Mozilla Public +# License, version 2.0. If a copy of the MPL was not distributed with this +# file, You can obtain one at http://mozilla.org/MPL/2.0/. diff --git a/headroom.cabal b/headroom.cabal --- a/headroom.cabal +++ b/headroom.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: headroom -version: 0.1.3.0 +version: 0.2.0.0 license: BSD3 license-file: LICENSE copyright: Copyright (c) 2019-2020 Vaclav Svejcar @@ -10,7 +10,7 @@ bug-reports: https://github.com/vaclavsvejcar/headroom/issues synopsis: License Header Manager description: - So you are tired of managing license headers in your codebase 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. + 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 build-type: Simple extra-source-files: @@ -18,50 +18,87 @@ LICENSE README.md embedded/config-file.yaml + embedded/default-config.yaml + embedded/license/apache2/c.mustache + embedded/license/apache2/cpp.mustache embedded/license/apache2/css.mustache embedded/license/apache2/haskell.mustache embedded/license/apache2/html.mustache embedded/license/apache2/java.mustache embedded/license/apache2/js.mustache + embedded/license/apache2/rust.mustache embedded/license/apache2/scala.mustache + embedded/license/apache2/shell.mustache + embedded/license/bsd3/c.mustache + embedded/license/bsd3/cpp.mustache embedded/license/bsd3/css.mustache embedded/license/bsd3/haskell.mustache embedded/license/bsd3/html.mustache embedded/license/bsd3/java.mustache embedded/license/bsd3/js.mustache + embedded/license/bsd3/rust.mustache embedded/license/bsd3/scala.mustache + embedded/license/bsd3/shell.mustache + embedded/license/gpl2/c.mustache + embedded/license/gpl2/cpp.mustache embedded/license/gpl2/css.mustache embedded/license/gpl2/haskell.mustache embedded/license/gpl2/html.mustache embedded/license/gpl2/java.mustache embedded/license/gpl2/js.mustache + embedded/license/gpl2/rust.mustache embedded/license/gpl2/scala.mustache + embedded/license/gpl2/shell.mustache + embedded/license/gpl3/c.mustache + embedded/license/gpl3/cpp.mustache embedded/license/gpl3/css.mustache embedded/license/gpl3/haskell.mustache embedded/license/gpl3/html.mustache embedded/license/gpl3/java.mustache embedded/license/gpl3/js.mustache + embedded/license/gpl3/rust.mustache embedded/license/gpl3/scala.mustache + embedded/license/gpl3/shell.mustache + embedded/license/mit/c.mustache + embedded/license/mit/cpp.mustache embedded/license/mit/css.mustache embedded/license/mit/haskell.mustache embedded/license/mit/html.mustache embedded/license/mit/java.mustache embedded/license/mit/js.mustache + embedded/license/mit/rust.mustache embedded/license/mit/scala.mustache + embedded/license/mit/shell.mustache + embedded/license/mpl2/c.mustache + embedded/license/mpl2/cpp.mustache + embedded/license/mpl2/css.mustache + embedded/license/mpl2/haskell.mustache + embedded/license/mpl2/html.mustache + embedded/license/mpl2/java.mustache + embedded/license/mpl2/js.mustache + embedded/license/mpl2/rust.mustache + embedded/license/mpl2/scala.mustache + embedded/license/mpl2/shell.mustache test-data/test-template.mustache + test-data/code-samples/c/sample1.c + test-data/code-samples/c/sample2.c + test-data/code-samples/cpp/sample1.cpp + test-data/code-samples/cpp/sample2.cpp test-data/code-samples/css/sample1.css test-data/code-samples/css/sample2.css - test-data/code-samples/css/sample3.css test-data/code-samples/haskell/full.hs - test-data/code-samples/haskell/replaced-simple.hs - test-data/code-samples/haskell/stripped.hs - test-data/code-samples/html/with-doctype.html - test-data/code-samples/html/without-doctype.html - test-data/code-samples/java/full.java + test-data/code-samples/haskell/sample1.hs + test-data/code-samples/haskell/sample2.hs + test-data/code-samples/html/sample1.html + test-data/code-samples/html/sample2.html + test-data/code-samples/java/sample1.java + test-data/code-samples/java/sample2.java test-data/code-samples/js/sample1.js test-data/code-samples/js/sample2.js - test-data/code-samples/js/sample3.js - test-data/code-samples/scala/full.scala + test-data/code-samples/rust/sample1.rs + test-data/code-samples/scala/sample1.scala + test-data/code-samples/scala/sample2.scala + test-data/code-samples/shell/sample1.sh test-data/configs/full.yaml test-data/test-traverse/a.html test-data/test-traverse/foo/b.html @@ -74,35 +111,24 @@ library exposed-modules: - Headroom.AppConfig Headroom.Command Headroom.Command.Gen - Headroom.Command.Gen.Env Headroom.Command.Init - Headroom.Command.Init.Env + Headroom.Command.Readers Headroom.Command.Run - Headroom.Command.Run.Env - Headroom.Command.Shared + Headroom.Command.Utils + Headroom.Configuration Headroom.Embedded + Headroom.FileSupport Headroom.FileSystem Headroom.FileType - Headroom.Global - Headroom.Header - Headroom.Header.Impl - Headroom.Header.Impl.CSS - Headroom.Header.Impl.Haskell - Headroom.Header.Impl.HTML - Headroom.Header.Impl.Java - Headroom.Header.Impl.JS - Headroom.Header.Impl.Scala - Headroom.Header.Utils - Headroom.License Headroom.Meta + Headroom.Serialization Headroom.Template Headroom.Template.Mustache - Headroom.Text Headroom.Types - Headroom.Types.Utils + Headroom.Types.EnumExtra + Headroom.UI Headroom.UI.Progress hs-source-dirs: src other-modules: @@ -113,7 +139,7 @@ -Wpartial-fields -Wredundant-constraints -Werror=incomplete-patterns build-depends: - aeson >=1.4.7.0 && <1.5, + aeson >=1.4.7.1 && <1.5, base >=4.7 && <5, either >=5.0.1.1 && <5.1, file-embed >=0.0.11.2 && <0.1, @@ -122,7 +148,7 @@ optparse-applicative >=0.15.1.0 && <0.16, pcre-heavy >=1.0.0.2 && <1.1, pcre-light >=0.4.1.0 && <0.5, - rio >=0.1.14.1 && <0.2, + rio >=0.1.15.0 && <0.2, template-haskell >=2.15.0.0 && <2.16, text >=1.2.4.0 && <1.3, time >=1.9.3 && <1.10, @@ -143,7 +169,7 @@ base >=4.7 && <5, headroom -any, optparse-applicative >=0.15.1.0 && <0.16, - rio >=0.1.14.1 && <0.2 + rio >=0.1.15.0 && <0.2 test-suite doctest type: exitcode-stdio-1.0 @@ -158,32 +184,24 @@ -Werror=incomplete-patterns build-depends: base >=4.7 && <5, - doctest >=0.16.2 && <0.17, + doctest >=0.16.3 && <0.17, optparse-applicative >=0.15.1.0 && <0.16, - rio >=0.1.14.1 && <0.2 + rio >=0.1.15.0 && <0.2 test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: test other-modules: - Headroom.AppConfigSpec Headroom.Command.InitSpec + Headroom.Command.ReadersSpec + Headroom.ConfigurationSpec + Headroom.FileSupportSpec Headroom.FileSystemSpec Headroom.FileTypeSpec - Headroom.Header.Impl.CSSSpec - Headroom.Header.Impl.HaskellSpec - Headroom.Header.Impl.HTMLSpec - Headroom.Header.Impl.JavaSpec - Headroom.Header.Impl.JSSpec - Headroom.Header.Impl.ScalaSpec - Headroom.Header.UtilsSpec - Headroom.HeaderSpec - Headroom.LicenseSpec + Headroom.SerializationSpec Headroom.Template.MustacheSpec - Headroom.TextSpec - Headroom.Types.UtilsSpec - Headroom.TypesSpec + Headroom.Types.EnumExtraSpec Headroom.UI.ProgressSpec Test.Utils Paths_headroom @@ -193,9 +211,12 @@ -Wpartial-fields -Wredundant-constraints -Werror=incomplete-patterns build-depends: - aeson >=1.4.7.0 && <1.5, + QuickCheck >=2.13.2 && <2.14, + aeson >=1.4.7.1 && <1.5, base >=4.7 && <5, headroom -any, hspec >=2.7.1 && <2.8, optparse-applicative >=0.15.1.0 && <0.16, - rio >=0.1.14.1 && <0.2 + pcre-heavy >=1.0.0.2 && <1.1, + pcre-light >=0.4.1.0 && <0.5, + rio >=0.1.15.0 && <0.2 diff --git a/src/Headroom/AppConfig.hs b/src/Headroom/AppConfig.hs deleted file mode 100644 --- a/src/Headroom/AppConfig.hs +++ /dev/null @@ -1,138 +0,0 @@ -{-| -Module : Headroom.AppConfig -Description : Application configuration -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -This module adds support for loading and parsing application configuration. -Such configuration can be loaded either from /YAML/ config file, or from command -line arguments. Provided 'Semigroup' and 'Monoid' instances allows to merge -multiple loaded configurations into one. --} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE NoImplicitPrelude #-} -module Headroom.AppConfig - ( AppConfig(..) - , loadAppConfig - , makePathsRelativeTo - , parseAppConfig - , parseVariables - , prettyPrintAppConfig - , validateAppConfig - ) -where - -import Control.Lens -import Data.Aeson ( FromJSON(parseJSON) - , ToJSON(toJSON) - , genericParseJSON - , genericToJSON - ) -import Data.Validation -import qualified Data.Yaml as Y -import Data.Yaml.Pretty ( defConfig - , encodePretty - , setConfCompare - ) -import Headroom.Types ( AppConfigError(..) - , HeadroomError(..) - , RunMode(..) - ) -import Headroom.Types.Utils ( customOptions ) -import RIO -import qualified RIO.ByteString as B -import RIO.FilePath ( takeDirectory - , () - ) -import qualified RIO.HashMap as HM -import qualified RIO.Text as T - - --- | Application configuration, loaded either from configuration file or command --- line options. -data AppConfig = AppConfig - { acRunMode :: RunMode -- ^ selected mode of /Run/ command - , acSourcePaths :: [FilePath] -- ^ paths to source code files - , acTemplatePaths :: [FilePath] -- ^ paths to template files - , acVariables :: HashMap Text Text -- ^ variables to replace - } - deriving (Eq, Generic, Show) - --- | Support for reading configuration from /YAML/. -instance FromJSON AppConfig where - parseJSON = genericParseJSON customOptions - --- | Support for writing configuration to /YAML/. -instance ToJSON AppConfig where - toJSON = genericToJSON customOptions - -instance Semigroup AppConfig where - x <> y = AppConfig (acRunMode x) - (acSourcePaths x <> acSourcePaths y) - (acTemplatePaths x <> acTemplatePaths y) - (acVariables x <> acVariables y) - -instance Monoid AppConfig where - mempty = AppConfig Add [] [] HM.empty - --- | Loads and parses application configuration from given file. -loadAppConfig :: MonadIO m - => FilePath -- ^ path to configuration file - -> m AppConfig -- ^ parsed configuration -loadAppConfig path = do - appConfig <- liftIO $ B.readFile path >>= parseAppConfig - pure $ makePathsRelativeTo (takeDirectory path) appConfig - --- | Rewrites all file paths in 'AppConfig' to be relative to given file path. -makePathsRelativeTo :: FilePath -- ^ file path to use - -> AppConfig -- ^ input application configuration - -> AppConfig -- ^ result with relativized file paths -makePathsRelativeTo root appConfig = appConfig - { acSourcePaths = processPaths . acSourcePaths $ appConfig - , acTemplatePaths = processPaths . acTemplatePaths $ appConfig - } - where processPaths = fmap (root ) - --- | Parses application configuration from given raw input. -parseAppConfig :: MonadThrow m - => B.ByteString -- ^ raw input to parse - -> m AppConfig -- ^ parsed application configuration -parseAppConfig = Y.decodeThrow - --- | Parses variables from raw input in @key=value@ format. --- --- >>> parseVariables ["key1=value1"] --- fromList [("key1","value1")] -parseVariables :: MonadThrow m - => [Text] -- ^ list of raw variables - -> m (HashMap Text Text) -- ^ parsed variables -parseVariables variables = fmap HM.fromList (mapM parse variables) - where - parse input = case T.split (== '=') input of - [key, value] -> pure (key, value) - _ -> throwM $ InvalidVariable input - --- | Writes the given 'AppConfig' to /YAML/ text, using the pretty printer. -prettyPrintAppConfig :: AppConfig -- ^ application config to write to /YAML/ - -> Text -- ^ pretty printed /YAML/ text -prettyPrintAppConfig = decodeUtf8Lenient . encodePretty prettyConfig - where prettyConfig = setConfCompare compare defConfig - --- | Validates whether given 'AppConfig' contains valid data. -validateAppConfig :: MonadThrow m - => AppConfig -- ^ application config to validate - -> m AppConfig -- ^ validated application config (or errors) -validateAppConfig appConfig = case checked of - Success ac' -> pure ac' - Failure errors -> throwM $ InvalidAppConfig errors - where - checked = appConfig <$ checkSourcePaths <* checkTemplatePaths - checkSourcePaths = if null (acSourcePaths appConfig) - then _Failure # [EmptySourcePaths] - else _Success # appConfig - checkTemplatePaths = if null (acTemplatePaths appConfig) - then _Failure # [EmptyTemplatePaths] - else _Success # appConfig diff --git a/src/Headroom/Command.hs b/src/Headroom/Command.hs --- a/src/Headroom/Command.hs +++ b/src/Headroom/Command.hs @@ -1,46 +1,45 @@ {-| Module : Headroom.Command -Description : Command line options processing +Description : Support for parsing command line arguments Copyright : (c) 2019-2020 Vaclav Svejcar License : BSD-3 Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX -Data types and functions for parsing command line options. +This module contains code responsible for parsing command line arguments, using +the /optparse-applicative/ library. -} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} module Headroom.Command - ( Command(..) - , commandParser + ( commandParser ) where -import Headroom.Meta ( buildVer ) -import Headroom.Types ( RunMode(..) ) +import Headroom.Command.Readers ( licenseReader + , licenseTypeReader + ) +import Headroom.Meta ( productDesc + , productInfo + ) +import Headroom.Types ( Command(..) + , LicenseType + , RunMode(..) + ) +import Headroom.Types.EnumExtra ( EnumExtra(..) ) import Options.Applicative import RIO +import qualified RIO.Text as T --- | Application command. -data Command - = Run [FilePath] [FilePath] [Text] RunMode Bool -- ^ /Run/ command - | Gen Bool (Maybe Text) -- ^ /Generator/ command - | Init Text [FilePath] -- ^ /Init/ command - deriving (Show) - -- | Parses command line arguments. commandParser :: ParserInfo Command commandParser = info (commands <**> helper) - ( fullDesc - <> progDesc "manage your source code license headers" - <> header header' - ) + (fullDesc <> progDesc (T.unpack productDesc) <> header (T.unpack productInfo)) where - header' = - "headroom v" <> buildVer <> " :: https://github.com/vaclavsvejcar/headroom" commands = subparser (runCommand <> genCommand <> initCommand) runCommand = command "run" @@ -75,22 +74,27 @@ ) <*> many (strOption - (long "variables" <> short 'v' <> metavar "KEY=VALUE" <> help - "values for template variables" + (long "variable" <> short 'v' <> metavar "KEY=VALUE" <> help + "value for template variable" ) ) - <*> ( flag' - Replace - (long "replace-headers" <> short 'r' <> help - "force replace existing license headers" - ) - <|> flag' - Drop - (long "drop-headers" <> short 'd' <> help - "drop existing license headers only" + <*> optional + ( flag' + Add + (long "add-headers" <> short 'a' <> help + "only adds missing license headers" ) - <|> pure Add - ) + <|> flag' + Replace + (long "replace-headers" <> short 'r' <> help + "force replace existing license headers" + ) + <|> flag' + Drop + (long "drop-headers" <> short 'd' <> help + "drop existing license headers only" + ) + ) <*> switch (long "debug" <> help "produce more verbose output") genOptions :: Parser Command @@ -101,18 +105,24 @@ "generate stub YAML config file to stdout" ) <*> optional - (strOption - (long "license" <> short 'l' <> metavar "name:type" <> help - "generate template for license and file type" + (option + licenseReader + ( long "license" + <> short 'l' + <> metavar "licenseType:fileType" + <> help "generate template for license and file type" ) ) initOptions :: Parser Command initOptions = Init - <$> strOption - (long "license-type" <> short 'l' <> metavar "LICENSE_TYPE" <> help - "type of open source license" + <$> option + licenseTypeReader + (long "license-type" <> short 'l' <> metavar "TYPE" <> help + ( "type of open source license, available options: " + <> T.unpack (T.toLower (allValuesToText @LicenseType)) + ) ) <*> some (strOption diff --git a/src/Headroom/Command/Gen.hs b/src/Headroom/Command/Gen.hs --- a/src/Headroom/Command/Gen.hs +++ b/src/Headroom/Command/Gen.hs @@ -1,45 +1,65 @@ {-| Module : Headroom.Command.Gen -Description : Logic for Generate command +Description : Handler for the @gen@ command. Copyright : (c) 2019-2020 Vaclav Svejcar License : BSD-3 Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX -Logic for the /Generator/ command, used to generate /stub/ files. +The @gen@ command is responsible for generating various files requied by +/Headroom/, such as /YAML/ configuration stubs or /Mustache/ license templates. +Run /Headroom/ using the @headroom gen --help@ to see available options. -} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NoImplicitPrelude #-} module Headroom.Command.Gen ( commandGen + , parseGenMode ) where -import Headroom.Command.Gen.Env -import Headroom.Command.Shared ( bootstrap ) + +import Headroom.Command.Utils ( bootstrap ) import Headroom.Embedded ( configFileStub , licenseTemplate ) -import Headroom.License ( parseLicense ) -import Headroom.Types ( HeadroomError(..) ) +import Headroom.Types ( ApplicationError(..) + , Command(..) + , CommandGenError(..) + , CommandGenOptions(..) + , GenMode(..) + ) import Prelude ( putStrLn ) import RIO -env' :: GenOptions -> LogFunc -> IO Env +data Env = Env + { envLogFunc :: !LogFunc -- ^ logging function + , envGenOptions :: !CommandGenOptions -- ^ options + } + +instance HasLogFunc Env where + logFuncL = lens envLogFunc (\x y -> x { envLogFunc = y }) + +env' :: CommandGenOptions -> LogFunc -> IO Env env' opts logFunc = pure $ Env { envLogFunc = logFunc, envGenOptions = opts } +-- | Parses 'GenMode' from combination of options from given 'Command'. +parseGenMode :: MonadThrow m + => Command -- ^ command from which to parse the 'GenMode' + -> m GenMode -- ^ parsed 'GenMode' +parseGenMode = \case + Gen True Nothing -> pure GenConfigFile + Gen False (Just license) -> pure $ GenLicense license + _ -> throwM $ CommandGenError NoGenModeSelected + -- | Handler for /Generator/ command. -commandGen :: GenOptions -- ^ /Generator/ command options - -> IO () -- ^ execution result -commandGen opts = bootstrap (env' opts) False $ case goGenMode opts of - GenConfigFile -> liftIO printConfigFile - GenLicense license -> liftIO $ printLicense license +commandGen :: CommandGenOptions -- ^ /Generator/ command options + -> IO () -- ^ execution result +commandGen opts = bootstrap (env' opts) False $ case cgoGenMode opts of + GenConfigFile -> liftIO printConfigFile + GenLicense (lType, fType) -> liftIO . putStrLn $ licenseTemplate lType fType printConfigFile :: IO () printConfigFile = putStrLn configFileStub - -printLicense :: Text -> IO () -printLicense license = case parseLicense license of - Just license' -> putStrLn $ licenseTemplate license' - Nothing -> throwM $ InvalidLicense license diff --git a/src/Headroom/Command/Gen/Env.hs b/src/Headroom/Command/Gen/Env.hs deleted file mode 100644 --- a/src/Headroom/Command/Gen/Env.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-| -Module : Headroom.Command.Gen.Env -Description : Environment for the Generate command -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -Data types and instances for the /Generator/ command environment. --} -{-# LANGUAGE NoImplicitPrelude #-} -module Headroom.Command.Gen.Env - ( Env(..) - , GenMode(..) - , GenOptions(..) - ) -where - -import RIO - - --- | /RIO/ Environment for the /Generator/ command. -data Env = Env - { envLogFunc :: !LogFunc -- ^ logging function - , envGenOptions :: !GenOptions -- ^ options - } - --- | Represents what action should the /Generator/ perform. -data GenMode - = GenConfigFile -- ^ generate /YAML/ config file stub - | GenLicense Text -- ^ generate license header template - deriving (Eq, Show) - --- | Options for the /Generator/ command. -newtype GenOptions = GenOptions - { goGenMode :: GenMode -- ^ used /Generator/ command mode - } - deriving Show - -instance HasLogFunc Env where - logFuncL = lens envLogFunc (\x y -> x { envLogFunc = y }) diff --git a/src/Headroom/Command/Init.hs b/src/Headroom/Command/Init.hs --- a/src/Headroom/Command/Init.hs +++ b/src/Headroom/Command/Init.hs @@ -1,60 +1,103 @@ {-| Module : Headroom.Command.Init -Description : Logic for Init command +Description : Handler for the @init@ command Copyright : (c) 2019-2020 Vaclav Svejcar License : BSD-3 Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX -Logic for the @init@ command, used to generate initial configuration boilerplate -for Headroom. +Module representing the @init@ command, responsible for generating all the +required files (configuration, templates) for the given project, which are then +required by the @run@ or @gen@ commands. -} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} module Headroom.Command.Init - ( commandInit + ( Env(..) + , Paths(..) + , HasPaths(..) + , HasInitOptions(..) + , commandInit , doesAppConfigExist , findSupportedFileTypes ) where -import Headroom.AppConfig ( AppConfig(..) - , prettyPrintAppConfig +import Headroom.Command.Utils ( bootstrap ) +import Headroom.Configuration ( makeHeadersConfig + , parseConfiguration ) -import Headroom.Command.Init.Env -import Headroom.Command.Shared ( bootstrap ) -import Headroom.Embedded ( licenseTemplate ) -import Headroom.FileSystem ( fileExtension - , findFiles +import Headroom.Embedded ( configFileStub + , defaultConfig + , licenseTemplate ) -import Headroom.FileType ( FileType - , fileTypeByExt +import Headroom.FileSystem ( createDirectory + , doesFileExist + , fileExtension + , findFiles + , getCurrentDirectory ) -import Headroom.Global ( TemplateType ) -import Headroom.License ( License(..) ) -import Headroom.Template ( templateExtensions ) -import Headroom.Types ( HeadroomError(..) - , InitCommandError(..) +import Headroom.FileType ( fileTypeByExt ) +import Headroom.Meta ( TemplateType ) +import Headroom.Template ( Template(..) ) +import Headroom.Types ( ApplicationError(..) + , CommandInitError(..) + , CommandInitOptions(..) + , FileType(..) + , LicenseType(..) + , PartialConfiguration(..) ) -import Headroom.UI.Progress ( Progress(..) +import Headroom.UI ( Progress(..) , zipWithProgress ) import RIO import qualified RIO.Char as C -import RIO.Directory ( createDirectory - , doesFileExist - , getCurrentDirectory - ) import RIO.FilePath ( () ) -import qualified RIO.HashMap as HM import qualified RIO.List as L import qualified RIO.NonEmpty as NE import qualified RIO.Text as T +import qualified RIO.Text.Partial as TP -env' :: InitOptions -> LogFunc -> IO Env + +-- | /RIO/ Environment for the @init@ command. +data Env = Env + { envLogFunc :: !LogFunc + , envInitOptions :: !CommandInitOptions + , envPaths :: !Paths + } + +-- | Paths to various locations of file system. +data Paths = Paths + { pCurrentDir :: !FilePath + , pConfigFile :: !FilePath + , pTemplatesDir :: !FilePath + } + +instance HasLogFunc Env where + logFuncL = lens envLogFunc (\x y -> x { envLogFunc = y }) + +-- | Environment value with @init@ command options. +class HasInitOptions env where + initOptionsL :: Lens' env CommandInitOptions + +-- | Environment value with 'Paths'. +class HasPaths env where + pathsL :: Lens' env Paths + +instance HasInitOptions Env where + initOptionsL = lens envInitOptions (\x y -> x { envInitOptions = y }) + +instance HasPaths Env where + pathsL = lens envPaths (\x y -> x { envPaths = y }) + +-------------------------------------------------------------------------------- + +env' :: CommandInitOptions -> LogFunc -> IO Env env' opts logFunc = do currentDir <- getCurrentDirectory let paths = Paths { pCurrentDir = currentDir @@ -63,29 +106,35 @@ } pure $ Env { envLogFunc = logFunc, envInitOptions = opts, envPaths = paths } --- | Handler for /Init/ command. -commandInit :: InitOptions -- ^ /Init/ command options - -> IO () -- ^ execution result +-- | Handler for @init@ command. +commandInit :: CommandInitOptions -- ^ @init@ command options + -> IO () -- ^ execution result commandInit opts = bootstrap (env' opts) False $ doesAppConfigExist >>= \case False -> do fileTypes <- findSupportedFileTypes makeTemplatesDir createTemplates fileTypes createConfigFile - True -> throwM $ InitCommandError AppConfigAlreadyExists + True -> do + paths <- view pathsL + throwM $ CommandInitError (AppConfigAlreadyExists $ pConfigFile paths) -- | Recursively scans provided source paths for known file types for which -- templates can be generated. findSupportedFileTypes :: (HasInitOptions env, HasLogFunc env) => RIO env [FileType] findSupportedFileTypes = do - opts <- view initOptionsL - fileTypes <- do - allFiles <- mapM (\path -> findFiles path (const True)) (ioSourcePaths opts) - let allFileTypes = fmap (fileExtension >=> fileTypeByExt) (concat allFiles) + opts <- view initOptionsL + pHeadersConfig <- pcLicenseHeaders <$> parseConfiguration defaultConfig + headersConfig <- makeHeadersConfig pHeadersConfig + fileTypes <- do + allFiles <- mapM (\path -> findFiles path (const True)) + (cioSourcePaths opts) + let allFileTypes = fmap (fileExtension >=> fileTypeByExt headersConfig) + (concat allFiles) pure $ L.nub . catMaybes $ allFileTypes case fileTypes of - [] -> throwM $ InitCommandError NoSourcePaths + [] -> throwM $ CommandInitError NoProvidedSourcePaths _ -> do logInfo $ "Found supported file types: " <> displayShow fileTypes pure fileTypes @@ -97,19 +146,19 @@ opts <- view initOptionsL paths <- view pathsL let templatesDir = pCurrentDir paths pTemplatesDir paths - mapM_ (\(p, l) -> createTemplate templatesDir l p) - (zipWithProgress $ fmap (License (ioLicenseType opts)) fileTypes) + mapM_ (\(p, lf) -> createTemplate templatesDir lf p) + (zipWithProgress $ fmap (cioLicenseType opts, ) fileTypes) createTemplate :: (HasLogFunc env) => FilePath - -> License + -> (LicenseType, FileType) -> Progress -> RIO env () -createTemplate templatesDir license@(License _ fileType) progress = do - let extension = NE.head $ templateExtensions (Proxy :: Proxy TemplateType) +createTemplate templatesDir (licenseType, fileType) progress = do + let extension = NE.head $ templateExtensions @TemplateType file = (fmap C.toLower . show $ fileType) <> "." <> T.unpack extension filePath = templatesDir file - template = licenseTemplate license + template = licenseTemplate licenseType fileType logInfo $ mconcat [display progress, " Creating template file in ", fromString filePath] writeFileUtf8 filePath template @@ -120,20 +169,21 @@ opts <- view initOptionsL paths <- view pathsL let filePath = pCurrentDir paths pConfigFile paths - content = prettyPrintAppConfig $ appConfig opts paths logInfo $ "Creating YAML config file in " <> fromString filePath - writeFileUtf8 filePath content + writeFileUtf8 filePath (configuration opts paths) where - variables = HM.fromList - [ ("author" , "John Smith") - , ("email" , "john.smith@example.com") - , ("project", "My project") - , ("year" , "2020") - ] - appConfig opts paths = mempty { acSourcePaths = ioSourcePaths opts - , acTemplatePaths = [pTemplatesDir paths] - , acVariables = variables - } + configuration opts paths = + let withSourcePaths = TP.replace + "source-paths: []" + ("source-paths: " <> toYamlList (T.pack <$> cioSourcePaths opts)) + configFileStub + withTemplatePaths = TP.replace + "template-paths: []" + ("template-paths: " <> toYamlList [T.pack $ pTemplatesDir paths]) + withSourcePaths + in withTemplatePaths + toYamlList items = mconcat + ["[ ", T.intercalate ", " (fmap (\i -> "\"" <> i <> "\"") items), " ]"] -- | Checks whether application config file already exists. doesAppConfigExist :: (HasLogFunc env, HasPaths env) => RIO env Bool diff --git a/src/Headroom/Command/Init/Env.hs b/src/Headroom/Command/Init/Env.hs deleted file mode 100644 --- a/src/Headroom/Command/Init/Env.hs +++ /dev/null @@ -1,55 +0,0 @@ -{-| -Module : Headroom.Command.Init.Env -Description : Environment for the Init command -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -Data types and instances for the /Init/ command environment. --} -{-# LANGUAGE NoImplicitPrelude #-} -module Headroom.Command.Init.Env where - -import Headroom.License ( LicenseType ) -import RIO - - --- | /RIO/ Environment for the /Init/ command. -data Env = Env - { envLogFunc :: !LogFunc - , envInitOptions :: !InitOptions - , envPaths :: !Paths - } - --- | Options for the /Init/ command. -data InitOptions = InitOptions - { ioSourcePaths :: ![FilePath] - , ioLicenseType :: !LicenseType - } - deriving Show - --- | Paths to various locations of file system. -data Paths = Paths - { pCurrentDir :: !FilePath - , pConfigFile :: !FilePath - , pTemplatesDir :: !FilePath - } - -instance HasLogFunc Env where - logFuncL = lens envLogFunc (\x y -> x { envLogFunc = y }) - --- | Environment value with /Init/ command options. -class HasInitOptions env where - initOptionsL :: Lens' env InitOptions - --- | Environment value with 'Paths'. -class HasPaths env where - pathsL :: Lens' env Paths - -instance HasInitOptions Env where - initOptionsL = lens envInitOptions (\x y -> x { envInitOptions = y }) - -instance HasPaths Env where - pathsL = lens envPaths (\x y -> x { envPaths = y }) diff --git a/src/Headroom/Command/Readers.hs b/src/Headroom/Command/Readers.hs new file mode 100644 --- /dev/null +++ b/src/Headroom/Command/Readers.hs @@ -0,0 +1,72 @@ +{-| +Module : Headroom.Command.Readers +Description : Custom readers for /optparse-applicative/ library +Copyright : (c) 2019-2020 Vaclav Svejcar +License : BSD-3 +Maintainer : vaclav.svejcar@gmail.com +Stability : experimental +Portability : POSIX + +This module contains custom readers required by the /optparse-applicative/ +library to parse data types such as 'LicenseType' or 'FileType'. +-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +module Headroom.Command.Readers + ( licenseReader + , licenseTypeReader + , parseLicenseAndFileType + ) +where + +import Data.Either.Combinators ( maybeToRight ) +import Headroom.Types ( FileType + , LicenseType + ) +import Headroom.Types.EnumExtra ( EnumExtra(..) ) +import Options.Applicative +import RIO +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 + where + parseLicense raw = maybeToRight errMsg (parseLicenseAndFileType $ T.pack raw) + errMsg = T.unpack $ mconcat + [ "invalid license/file type, must be in format 'licenseType:fileType' " + , "(e.g. bsd3:haskell)" + , "\nAvailable license types: " + , T.toLower (allValuesToText @LicenseType) + , "\nAvailable file types: " + , T.toLower (allValuesToText @FileType) + ] + + +-- | Reader for 'LicenseType'. +licenseTypeReader :: ReadM LicenseType +licenseTypeReader = eitherReader parseLicenseType + where + parseLicenseType raw = maybeToRight errMsg (textToEnum $ T.pack raw) + errMsg = T.unpack $ mconcat + [ "invalid license type, available options: " + , T.toLower (allValuesToText @LicenseType) + ] + + +-- | Parses 'LicenseType' and 'FileType' from the input string, +-- formatted as @licenseType:fileType@. +-- +-- >>> parseLicenseAndFileType "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 diff --git a/src/Headroom/Command/Run.hs b/src/Headroom/Command/Run.hs --- a/src/Headroom/Command/Run.hs +++ b/src/Headroom/Command/Run.hs @@ -1,186 +1,259 @@ {-| Module : Headroom.Command.Run -Description : Logic for Run command +Description : Handler for the @run@ command. Copyright : (c) 2019-2020 Vaclav Svejcar License : BSD-3 Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX -Logic for the @run@ command, used to add or replace license headers in source -code files. +Module representing the @run@ command, the core command of /Headroom/, which is +responsible for license header management. -} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} module Headroom.Command.Run ( commandRun ) where import Data.Time.Clock.POSIX ( getPOSIXTime ) -import Headroom.AppConfig ( AppConfig(..) - , loadAppConfig - , validateAppConfig +import Headroom.Command.Utils ( bootstrap ) +import Headroom.Configuration ( loadConfiguration + , makeConfiguration + , parseConfiguration + , parseVariables ) -import Headroom.Command.Run.Env -import Headroom.Command.Shared ( bootstrap ) +import Headroom.Embedded ( defaultConfig ) +import Headroom.FileSupport ( addHeader + , dropHeader + , extractFileInfo + , replaceHeader + ) import Headroom.FileSystem ( fileExtension , findFilesByExts , findFilesByTypes + , loadFile ) -import Headroom.FileType ( FileType +import Headroom.FileType ( configByFileType , fileTypeByExt - , fileTypeByName ) -import Headroom.Global ( TemplateType ) -import Headroom.Header ( Header(..) - , addHeader - , containsHeader - , dropHeader - , replaceHeader +import Headroom.Meta ( TemplateType + , productInfo ) -import Headroom.Template ( Template(..) - , loadTemplate +import Headroom.Template ( Template(..) ) +import Headroom.Types ( CommandRunOptions(..) + , Configuration(..) + , FileInfo(..) + , FileType(..) + , PartialConfiguration(..) + , RunMode(..) ) -import Headroom.Types ( RunMode(..) ) -import Headroom.UI.Progress ( Progress(..) ) -import RIO hiding ( second ) -import RIO.Directory -import RIO.FilePath ( takeBaseName - , () +import Headroom.Types.EnumExtra ( EnumExtra(..) ) +import Headroom.UI ( Progress(..) + , zipWithProgress ) +import RIO +import RIO.FilePath ( takeBaseName ) import qualified RIO.List as L import qualified RIO.Map as M import qualified RIO.Text as T -env' :: RunOptions -> LogFunc -> IO Env +-- | Initial /RIO/ startup environment for the /Run/ command. +data StartupEnv = StartupEnv + { envLogFunc :: !LogFunc -- ^ logging function + , envRunOptions :: !CommandRunOptions -- ^ options + } + +-- | Full /RIO/ environment for the /Run/ command. +data Env = Env + { envEnv :: !StartupEnv -- ^ startup /RIO/ environment + , envConfiguration :: !Configuration -- ^ application configuration + } + +class HasConfiguration env where + configurationL :: Lens' env Configuration + +-- | Environment value with /Init/ command options. +class HasRunOptions env where + runOptionsL :: Lens' env CommandRunOptions + +class (HasLogFunc env, HasRunOptions env) => HasEnv env where + envL :: Lens' env StartupEnv + +instance HasConfiguration Env where + configurationL = lens envConfiguration (\x y -> x { envConfiguration = y }) + +instance HasEnv StartupEnv where + envL = id + +instance HasEnv Env where + envL = lens envEnv (\x y -> x { envEnv = y }) + +instance HasLogFunc StartupEnv where + logFuncL = lens envLogFunc (\x y -> x { envLogFunc = y }) + +instance HasLogFunc Env where + logFuncL = envL . logFuncL + +instance HasRunOptions StartupEnv where + runOptionsL = lens envRunOptions (\x y -> x { envRunOptions = y }) + +instance HasRunOptions Env where + runOptionsL = envL . runOptionsL + + +env' :: CommandRunOptions -> LogFunc -> IO Env env' opts logFunc = do let startupEnv = StartupEnv { envLogFunc = logFunc, envRunOptions = opts } - merged <- runRIO startupEnv mergedAppConfig - pure $ Env { envEnv = startupEnv, envAppConfig = merged } + merged <- runRIO startupEnv finalConfiguration + pure $ Env { envEnv = startupEnv, envConfiguration = merged } + -- | Handler for /Run/ command. -commandRun :: RunOptions -- ^ /Run/ command options - -> IO () -- ^ execution result -commandRun opts = bootstrap (env' opts) (roDebug opts) $ do - startTS <- liftIO getPOSIXTime - logInfo "Loading source code header templates..." - templates <- loadTemplates - logInfo $ "Done, found " <> display (M.size templates) <> " template(s)" - logInfo "Searching for source code files..." - sourceFiles <- findSourceFiles (M.keys templates) - let sourceFilesNum = display . L.length $ sourceFiles - logInfo $ mconcat - ["Done, found ", sourceFilesNum, " sources code files(s) to process"] - (total, skipped) <- processHeaders templates sourceFiles - endTS <- liftIO getPOSIXTime - let (elapsedSeconds, _) = properFraction (endTS - startTS) +commandRun :: CommandRunOptions -- ^ /Run/ command options + -> IO () -- ^ execution result +commandRun opts = bootstrap (env' opts) (croDebug opts) $ do + logInfo $ display productInfo + startTS <- liftIO getPOSIXTime + templates <- loadTemplates + sourceFiles <- findSourceFiles (M.keys templates) + (total, processed) <- processSourceFiles templates sourceFiles + endTS <- liftIO getPOSIXTime + logInfo "-----" logInfo $ mconcat [ "Done: modified " - , display (total - skipped) + , display processed , ", skipped " - , display skipped - , " files in " - , display (elapsedSeconds :: Integer) + , display (total - processed) + , " file(s) in " + , displayShow (endTS - startTS) , " second(s)." ] -mergedAppConfig :: (HasRunOptions env, HasLogFunc env) => RIO env AppConfig -mergedAppConfig = do - runOptions <- view runOptionsL - configDir <- getXdgDirectory XdgConfig "headroom" - currDir <- getCurrentDirectory - let locations = [currDir ".headroom.yaml", configDir "headroom.yaml"] - logInfo "Loading configuration file(s)..." - logDebug $ "Configuration files locations: " <> displayShow locations - appConfigs <- fmap catMaybes (mapM loadAppConfigSafe locations) - appConfigFromOpts <- toAppConfig runOptions - merged <- mergeAppConfigs $ appConfigFromOpts : appConfigs - validateAppConfig merged + +findSourceFiles :: (HasConfiguration env, HasLogFunc env) + => [FileType] + -> RIO env [FilePath] +findSourceFiles fileTypes = do + Configuration {..} <- view configurationL + logDebug $ "Using source paths: " <> displayShow cSourcePaths + files <- + mconcat <$> mapM (findFilesByTypes cLicenseHeaders fileTypes) cSourcePaths + logInfo $ mconcat ["Found ", display $ L.length files, " source file(s)"] + pure files + + +processSourceFiles :: (HasConfiguration env, HasLogFunc env) + => Map FileType TemplateType + -> [FilePath] + -> RIO env (Int, Int) +processSourceFiles templates paths = do + Configuration {..} <- view configurationL + let withFileType = mapMaybe (findFileType cLicenseHeaders) paths + withTemplate = mapMaybe (uncurry findTemplate) withFileType + processed <- mapM process (zipWithProgress withTemplate) + logDebug "foo" + pure (L.length withTemplate, L.length . filter (== True) $ processed) where - loadAppConfigSafe path = catch - (fmap Just (loadAppConfig path)) - (\ex -> do - logDebug $ displayShow (ex :: IOException) - logWarn $ "Skipping missing configuration file: " <> fromString path - pure Nothing - ) - mergeAppConfigs appConfigs = do - let merged = mconcat appConfigs - logDebug $ "Source AppConfig instances: " <> displayShow appConfigs - logDebug $ "Merged AppConfig: " <> displayShow merged - pure merged + findFileType conf path = + fmap (, path) (fileExtension path >>= fileTypeByExt conf) + findTemplate ft p = (, ft, p) <$> M.lookup ft templates + process (pr, (tt, ft, p)) = processSourceFile pr tt ft p -loadTemplates :: (HasAppConfig env, HasLogFunc env) - => RIO env (M.Map FileType Text) + +processSourceFile :: (HasConfiguration env, HasLogFunc env) + => Progress + -> TemplateType + -> FileType + -> FilePath + -> RIO env Bool +processSourceFile progress template fileType path = do + Configuration {..} <- view configurationL + fileContent <- readFileUtf8 path + let fileInfo = extractFileInfo fileType + (configByFileType cLicenseHeaders fileType) + fileContent + variables = cVariables <> fiVariables fileInfo + header <- renderTemplate variables template + (processed, action, message') <- chooseAction fileInfo header + let message = if processed then message' else "Skipping file: " + logDebug $ "File info: " <> displayShow fileInfo + logInfo $ mconcat [display progress, " ", display message, fromString path] + writeFileUtf8 path (action fileContent) + pure processed + + +chooseAction :: (HasConfiguration env) + => FileInfo + -> Text + -> RIO env (Bool, Text -> Text, Text) +chooseAction info header = do + Configuration {..} <- view configurationL + let hasHeader = isJust $ fiHeaderPos info + pure $ go cRunMode hasHeader + where + go runMode hasHeader = case runMode of + Add -> (not hasHeader, addHeader info header, "Adding header to: ") + Drop -> (hasHeader, dropHeader info, "Dropping header from: ") + Replace -> if hasHeader + then (True, replaceHeader info header, "Replacing header in: ") + else go Add hasHeader + + +loadTemplates :: (HasConfiguration env, HasLogFunc env) + => RIO env (Map FileType TemplateType) loadTemplates = do - appConfig <- view appConfigL - paths <- liftIO (mconcat <$> mapM findPaths (acTemplatePaths appConfig)) - logDebug $ "Found template files: " <> displayShow paths - withTypes <- mapM (\path -> fmap (, path) (extractTemplateType path)) paths - parsed <- mapM (\(t, p) -> fmap (t, ) (loadTemplate p)) - (mapMaybe filterTemplate withTypes) - rendered <- mapM - (\(t, p) -> - fmap (t, ) (renderTemplate (acVariables appConfig) (p :: TemplateType)) - ) - parsed - pure $ M.fromList rendered + Configuration {..} <- view configurationL + paths <- mconcat <$> mapM (`findFilesByExts` extensions) cTemplatePaths + logDebug $ "Using template paths: " <> displayShow paths + withTypes <- catMaybes <$> mapM (\p -> fmap (, p) <$> typeOfTemplate p) paths + parsed <- mapM (\(t, p) -> (t, ) <$> load p) withTypes + logInfo $ mconcat ["Found ", display $ L.length parsed, " template(s)"] + pure $ M.fromList parsed where - extensions = toList $ templateExtensions (Proxy :: Proxy TemplateType) - findPaths path = findFilesByExts path extensions - filterTemplate (fileType, path) = (\ft -> Just (ft, path)) =<< fileType + extensions = toList $ templateExtensions @TemplateType + load path = + liftIO $ (T.strip <$> loadFile path) >>= parseTemplate (Just $ T.pack path) -extractTemplateType :: HasLogFunc env => FilePath -> RIO env (Maybe FileType) -extractTemplateType path = do - let fileType = fileTypeByName . T.pack . takeBaseName $ path + +typeOfTemplate :: HasLogFunc env => FilePath -> RIO env (Maybe FileType) +typeOfTemplate path = do + let fileType = textToEnum . T.pack . takeBaseName $ path when (isNothing fileType) (logWarn $ "Skipping unrecognized template type: " <> fromString path) pure fileType -findSourceFiles :: HasAppConfig env => [FileType] -> RIO env [FilePath] -findSourceFiles fileTypes = do - appConfig <- view appConfigL - let paths = acSourcePaths appConfig - liftIO $ fmap concat (mapM (`findFilesByTypes` fileTypes) paths) -processHeaders :: (HasLogFunc env, HasRunOptions env) - => M.Map FileType Text - -> [FilePath] - -> RIO env (Int, Int) -processHeaders templates paths = do - let filesToProcess = mapMaybe withTemplate (mapMaybe processPath paths) - zipped = L.zip [1 ..] filesToProcess - withProgress = fmap (\(i, (h, p)) -> (progress i, h, p)) zipped - progress curr = Progress curr (L.length paths) - processed <- mapM (\(i, h, p) -> processHeader i h p) withProgress - pure (L.length withProgress, L.length . filter (== True) $ processed) - where - withTemplate (fileType, path) = - fmap (\t -> (Header fileType t, path)) (M.lookup fileType templates) - processPath path = fmap (, path) (fileExtension path >>= fileTypeByExt) +finalConfiguration :: (HasLogFunc env, HasRunOptions env) + => RIO env Configuration +finalConfiguration = do + defaultConfig' <- parseConfiguration defaultConfig + cmdLineConfig <- optionsToConfiguration + yamlConfig <- loadConfiguration ".headroom.yaml" + let mergedConfig = defaultConfig' <> yamlConfig <> cmdLineConfig + config <- makeConfiguration mergedConfig + logDebug $ "Default config: " <> displayShow defaultConfig' + logDebug $ "YAML config: " <> displayShow yamlConfig + logDebug $ "CmdLine config: " <> displayShow cmdLineConfig + logDebug $ "Merged config: " <> displayShow mergedConfig + logDebug $ "Final config: " <> displayShow config + pure config -processHeader :: (HasLogFunc env, HasRunOptions env) - => Progress - -> Header - -> FilePath - -> RIO env Bool -processHeader progress header path = do - runOptions <- view runOptionsL - fileContent <- readFileUtf8 path - let hasHeader = containsHeader (hFileType header) fileContent - (skipped, action, msg) = chooseAction (roRunMode runOptions) hasHeader - msg' = if skipped then "Skipping file" else msg - log' $ msg' <> ": " <> fromString path - writeFileUtf8 path (action header fileContent) - pure skipped - where - log' msg = logInfo $ display progress <> " " <> msg - chooseAction runMode hasHeader = case runMode of - Add -> (hasHeader, addHeader, "Adding header to") - Drop -> (not hasHeader, dropHeader . hFileType, "Dropping header from") - Replace -> if hasHeader - then (False, replaceHeader, "Replacing header in") - else chooseAction Add hasHeader + +optionsToConfiguration :: (HasRunOptions env) => RIO env PartialConfiguration +optionsToConfiguration = do + runOptions <- view runOptionsL + variables <- parseVariables $ croVariables runOptions + pure PartialConfiguration + { pcRunMode = maybe mempty pure (croRunMode runOptions) + , pcSourcePaths = ifNot null (croSourcePaths runOptions) + , pcTemplatePaths = ifNot null (croTemplatePaths runOptions) + , pcVariables = ifNot null variables + , pcLicenseHeaders = mempty + } + where ifNot cond value = if cond value then mempty else pure value diff --git a/src/Headroom/Command/Run/Env.hs b/src/Headroom/Command/Run/Env.hs deleted file mode 100644 --- a/src/Headroom/Command/Run/Env.hs +++ /dev/null @@ -1,96 +0,0 @@ -{-| -Module : Headroom.Command.Run.Env -Description : Environment for the Run command -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -Data types and instances for the /Run/ command environment. --} -{-# LANGUAGE NoImplicitPrelude #-} -module Headroom.Command.Run.Env - ( RunOptions(..) - , StartupEnv(..) - , Env(..) - , HasAppConfig(..) - , HasRunOptions(..) - , toAppConfig - ) -where - -import Headroom.AppConfig ( AppConfig(..) - , parseVariables - ) -import Headroom.Types ( RunMode ) -import RIO - - --- | Options for the /Run/ command. -data RunOptions = RunOptions - { roRunMode :: RunMode -- ^ used /Run/ command mode - , roSourcePaths :: [FilePath] -- ^ source code file paths - , roTemplatePaths :: [FilePath] -- ^ template file paths - , roVariables :: [Text] -- ^ raw variables - , roDebug :: Bool -- ^ whether to run in debug mode - } - deriving (Eq, Show) - --- | Initial /RIO/ startup environment for the /Run/ command. -data StartupEnv = StartupEnv - { envLogFunc :: !LogFunc -- ^ logging function - , envRunOptions :: !RunOptions -- ^ options - } - --- | Full /RIO/ environment for the /Run/ command. -data Env = Env - { envEnv :: !StartupEnv -- ^ startup /RIO/ environment - , envAppConfig :: !AppConfig -- ^ application configuration - } - --- | Environment value with application configuration. -class HasAppConfig env where - -- | Application config lens. - appConfigL :: Lens' env AppConfig - -class (HasLogFunc env, HasRunOptions env) => HasEnv env where - envL :: Lens' env StartupEnv - --- | Environment value with /Run/ command options. -class HasRunOptions env where - -- | /Run/ command options lens. - runOptionsL :: Lens' env RunOptions - -instance HasAppConfig Env where - appConfigL = lens envAppConfig (\x y -> x { envAppConfig = y }) - -instance HasEnv StartupEnv where - envL = id - -instance HasEnv Env where - envL = lens envEnv (\x y -> x { envEnv = y }) - -instance HasLogFunc StartupEnv where - logFuncL = lens envLogFunc (\x y -> x { envLogFunc = y }) - -instance HasLogFunc Env where - logFuncL = envL . logFuncL - -instance HasRunOptions StartupEnv where - runOptionsL = lens envRunOptions (\x y -> x { envRunOptions = y }) - -instance HasRunOptions Env where - runOptionsL = envL . runOptionsL - --- | Converts options for /Run/ command into application config. -toAppConfig :: MonadThrow m - => RunOptions -- ^ /Run/ command options - -> m AppConfig -- ^ application configuration -toAppConfig opts = do - variables' <- parseVariables (roVariables opts) - pure $ mempty { acSourcePaths = roSourcePaths opts - , acTemplatePaths = roTemplatePaths opts - , acRunMode = roRunMode opts - , acVariables = variables' - } diff --git a/src/Headroom/Command/Shared.hs b/src/Headroom/Command/Shared.hs deleted file mode 100644 --- a/src/Headroom/Command/Shared.hs +++ /dev/null @@ -1,32 +0,0 @@ -{-| -Module : Headroom.Command.Shared -Description : Shared code for commands -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -Shared functionality for the individual command implementations. --} -{-# LANGUAGE NoImplicitPrelude #-} -module Headroom.Command.Shared - ( bootstrap - ) -where - -import RIO - - --- | Bootstraps /RIO/ application using provided environment data and flag --- whether to run in debug mode. -bootstrap :: (LogFunc -> IO env) -- ^ function returning environment data - -> Bool -- ^ whether to run in debug mode - -> RIO env a -- ^ /RIO/ application to execute - -> IO a -- ^ execution result -bootstrap getEnv isDebug logic = do - logOptions <- logOptionsHandle stderr isDebug - let logOptions' = setLogUseLoc False logOptions - withLogFunc logOptions' $ \logFunc -> do - env <- liftIO $ getEnv logFunc - runRIO env logic diff --git a/src/Headroom/Command/Utils.hs b/src/Headroom/Command/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Headroom/Command/Utils.hs @@ -0,0 +1,32 @@ +{-| +Module : Headroom.Command.Utils +Description : Shared code for individual command handlers +Copyright : (c) 2019-2020 Vaclav Svejcar +License : BSD-3 +Maintainer : vaclav.svejcar@gmail.com +Stability : experimental +Portability : POSIX + +Contains shared code common to all command handlers. +-} +{-# LANGUAGE NoImplicitPrelude #-} +module Headroom.Command.Utils + ( bootstrap + ) +where + +import RIO + +-- | Bootstraps /RIO/ application using provided environment data and flag +-- whether to run in debug mode. +bootstrap :: (LogFunc -> IO env) -- ^ function returning environment data + -> Bool -- ^ whether to run in debug mode + -> RIO env a -- ^ /RIO/ application to execute + -> IO a -- ^ execution result +bootstrap getEnv isDebug logic = do + logOptions <- logOptionsHandle stderr isDebug + let logOptions' = setLogUseLoc False logOptions + withLogFunc logOptions' $ \logFunc -> do + env <- liftIO $ getEnv logFunc + runRIO env logic + diff --git a/src/Headroom/Configuration.hs b/src/Headroom/Configuration.hs new file mode 100644 --- /dev/null +++ b/src/Headroom/Configuration.hs @@ -0,0 +1,125 @@ +{-| +Module : Headroom.Configuration +Description : Configuration handling (loading, parsing, validating) +Copyright : (c) 2019-2020 Vaclav Svejcar +License : BSD-3 +Maintainer : vaclav.svejcar@gmail.com +Stability : experimental +Portability : POSIX + +This module provides logic for working with the cofiguration data types. +Headroom uses the + +pattern for the configuration, where the 'Configuration' is the data type for +total configuration and 'PartialConfiguration' for the partial one. +-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module Headroom.Configuration + ( -- * Loading & Parsing Configuration + loadConfiguration + , parseConfiguration + , parseVariables + -- * Processing Partial Configuration + , makeConfiguration + , makeHeadersConfig + , makeHeaderConfig + ) +where + +import Data.Monoid ( Last(..) ) +import qualified Data.Yaml as Y +import Headroom.Types ( ApplicationError(..) + , Configuration(..) + , ConfigurationError(..) + , FileType(..) + , HeaderConfig(..) + , HeadersConfig(..) + , PartialConfiguration(..) + , PartialHeaderConfig(..) + , PartialHeadersConfig(..) + ) +import RIO +import qualified RIO.ByteString as B +import qualified RIO.HashMap as HM +import qualified RIO.Text as T + + + +-- | Loads and parses application configuration from given /YAML/ file. +loadConfiguration :: MonadIO m + => FilePath -- ^ path to /YAML/ configuration file + -> m PartialConfiguration -- ^ parsed configuration +loadConfiguration path = liftIO $ B.readFile path >>= parseConfiguration + + +-- | Parses application configuration from given raw input in /YAML/ format. +parseConfiguration :: MonadThrow m + => B.ByteString -- ^ raw input to parse + -> m PartialConfiguration -- ^ parsed application configuration +parseConfiguration = Y.decodeThrow + + +-- | Parses variables from raw input in @key=value@ format. +-- +-- >>> parseVariables ["key1=value1"] +-- fromList [("key1","value1")] +parseVariables :: MonadThrow m + => [Text] -- ^ list of raw variables + -> m (HashMap Text Text) -- ^ parsed variables +parseVariables variables = fmap HM.fromList (mapM parse variables) + where + parse input = case T.split (== '=') input of + [key, value] -> pure (key, value) + _ -> throwM $ ConfigurationError (InvalidVariable input) + + +-- | Makes full 'Configuration' from provided 'PartialConfiguration' (if valid). +makeConfiguration :: MonadThrow m + => PartialConfiguration -- ^ source 'PartialConfiguration' + -> m Configuration -- ^ full 'Configuration' +makeConfiguration PartialConfiguration {..} = do + cRunMode <- lastOrError NoRunMode pcRunMode + cSourcePaths <- lastOrError NoSourcePaths pcSourcePaths + cTemplatePaths <- lastOrError NoTemplatePaths pcTemplatePaths + cVariables <- lastOrError NoVariables pcVariables + cLicenseHeaders <- makeHeadersConfig pcLicenseHeaders + pure Configuration { .. } + + +-- | Makes full 'HeadersConfig' from provided 'PartialHeadersConfig' (if valid). +makeHeadersConfig :: MonadThrow m + => PartialHeadersConfig -- ^ source 'PartialHeadersConfig' + -> m HeadersConfig -- ^ full 'HeadersConfig' +makeHeadersConfig PartialHeadersConfig {..} = do + hscC <- makeHeaderConfig C phscC + hscCpp <- makeHeaderConfig CPP phscCpp + hscCss <- makeHeaderConfig CSS phscCss + hscHaskell <- makeHeaderConfig Haskell phscHaskell + hscHtml <- makeHeaderConfig HTML phscHtml + hscJava <- makeHeaderConfig Java phscJava + hscJs <- makeHeaderConfig JS phscJs + hscRust <- makeHeaderConfig Rust phscRust + hscScala <- makeHeaderConfig Scala phscScala + hscShell <- makeHeaderConfig Shell phscShell + pure HeadersConfig { .. } + + +-- | Makes full 'HeaderConfig' from provided 'PartialHeaderConfig' (if valid). +makeHeaderConfig :: MonadThrow m + => FileType -- ^ determines for which file type this configuration is + -> PartialHeaderConfig -- ^ source 'PartialHeaderConfig' + -> m HeaderConfig -- ^ full 'HeaderConfig' +makeHeaderConfig fileType PartialHeaderConfig {..} = do + hcFileExtensions <- lastOrError (NoFileExtensions fileType) phcFileExtensions + hcMarginAfter <- lastOrError (NoMarginAfter fileType) phcMarginAfter + hcMarginBefore <- lastOrError (NoMarginBefore fileType) phcMarginBefore + hcPutAfter <- lastOrError (NoPutAfter fileType) phcPutAfter + hcPutBefore <- lastOrError (NoPutBefore fileType) phcPutBefore + hcHeaderSyntax <- lastOrError (NoHeaderSyntax fileType) phcHeaderSyntax + pure HeaderConfig { .. } + + +lastOrError :: MonadThrow m => ConfigurationError -> Last a -> m a +lastOrError err (Last x) = maybe (throwM $ ConfigurationError err) pure x diff --git a/src/Headroom/Embedded.hs b/src/Headroom/Embedded.hs --- a/src/Headroom/Embedded.hs +++ b/src/Headroom/Embedded.hs @@ -1,72 +1,110 @@ {-| Module : Headroom.Embedded -Description : Embedded resource files +Description : Embedded files Copyright : (c) 2019-2020 Vaclav Svejcar License : BSD-3 Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX -Contains resources that were embedded from the @embedded/@ source folder during -compile time, using the "Data.FileEmbed" module. +Contains contents of files embedded using the "Data.FileEmbed" module. -} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TemplateHaskell #-} module Headroom.Embedded ( configFileStub + , defaultConfig , licenseTemplate ) where import Data.FileEmbed ( embedStringFile ) -import Headroom.FileType ( FileType(..) ) -import Headroom.License ( License(..) +import Headroom.Types ( FileType(..) , LicenseType(..) ) import RIO + -- | Content of dummy /YAML/ configuration file for the application. configFileStub :: IsString a => a configFileStub = $(embedStringFile "embedded/config-file.yaml") --- | License template for given 'License'. + +-- | Default /YAML/ configuration. +defaultConfig :: IsString a => a +defaultConfig = $(embedStringFile "embedded/default-config.yaml") + + +-- | License template for given license. licenseTemplate :: IsString a - => License -- ^ 'License' for which to return the template - -> a -- ^ template text -licenseTemplate (License licenseType fileType) = case licenseType of + => LicenseType -- ^ license for which to return the template + -> FileType -- ^ license for which to return the template + -> a -- ^ template text +licenseTemplate licenseType fileType = case licenseType of Apache2 -> case fileType of + C -> $(embedStringFile "embedded/license/apache2/c.mustache") + CPP -> $(embedStringFile "embedded/license/apache2/cpp.mustache") CSS -> $(embedStringFile "embedded/license/apache2/css.mustache") Haskell -> $(embedStringFile "embedded/license/apache2/haskell.mustache") HTML -> $(embedStringFile "embedded/license/apache2/html.mustache") Java -> $(embedStringFile "embedded/license/apache2/java.mustache") JS -> $(embedStringFile "embedded/license/apache2/js.mustache") + Rust -> $(embedStringFile "embedded/license/apache2/rust.mustache") Scala -> $(embedStringFile "embedded/license/apache2/scala.mustache") + Shell -> $(embedStringFile "embedded/license/apache2/shell.mustache") BSD3 -> case fileType of + C -> $(embedStringFile "embedded/license/bsd3/c.mustache") + CPP -> $(embedStringFile "embedded/license/bsd3/cpp.mustache") CSS -> $(embedStringFile "embedded/license/bsd3/css.mustache") Haskell -> $(embedStringFile "embedded/license/bsd3/haskell.mustache") HTML -> $(embedStringFile "embedded/license/bsd3/html.mustache") Java -> $(embedStringFile "embedded/license/bsd3/java.mustache") JS -> $(embedStringFile "embedded/license/bsd3/js.mustache") + Rust -> $(embedStringFile "embedded/license/bsd3/rust.mustache") Scala -> $(embedStringFile "embedded/license/bsd3/scala.mustache") + Shell -> $(embedStringFile "embedded/license/bsd3/shell.mustache") GPL2 -> case fileType of + C -> $(embedStringFile "embedded/license/gpl2/c.mustache") + CPP -> $(embedStringFile "embedded/license/gpl2/cpp.mustache") CSS -> $(embedStringFile "embedded/license/gpl2/css.mustache") Haskell -> $(embedStringFile "embedded/license/gpl2/haskell.mustache") HTML -> $(embedStringFile "embedded/license/gpl2/html.mustache") Java -> $(embedStringFile "embedded/license/gpl2/java.mustache") JS -> $(embedStringFile "embedded/license/gpl2/js.mustache") + Rust -> $(embedStringFile "embedded/license/gpl2/rust.mustache") Scala -> $(embedStringFile "embedded/license/gpl2/scala.mustache") + Shell -> $(embedStringFile "embedded/license/gpl2/shell.mustache") GPL3 -> case fileType of + C -> $(embedStringFile "embedded/license/gpl3/c.mustache") + CPP -> $(embedStringFile "embedded/license/gpl3/cpp.mustache") CSS -> $(embedStringFile "embedded/license/gpl3/css.mustache") Haskell -> $(embedStringFile "embedded/license/gpl3/haskell.mustache") HTML -> $(embedStringFile "embedded/license/gpl3/html.mustache") Java -> $(embedStringFile "embedded/license/gpl3/java.mustache") JS -> $(embedStringFile "embedded/license/gpl3/js.mustache") + Rust -> $(embedStringFile "embedded/license/gpl3/rust.mustache") Scala -> $(embedStringFile "embedded/license/gpl3/scala.mustache") + Shell -> $(embedStringFile "embedded/license/gpl3/shell.mustache") MIT -> case fileType of + C -> $(embedStringFile "embedded/license/mit/c.mustache") + CPP -> $(embedStringFile "embedded/license/mit/cpp.mustache") CSS -> $(embedStringFile "embedded/license/mit/css.mustache") Haskell -> $(embedStringFile "embedded/license/mit/haskell.mustache") HTML -> $(embedStringFile "embedded/license/mit/html.mustache") Java -> $(embedStringFile "embedded/license/mit/java.mustache") JS -> $(embedStringFile "embedded/license/mit/js.mustache") + Rust -> $(embedStringFile "embedded/license/mit/rust.mustache") Scala -> $(embedStringFile "embedded/license/mit/scala.mustache") + Shell -> $(embedStringFile "embedded/license/mit/shell.mustache") + MPL2 -> case fileType of + C -> $(embedStringFile "embedded/license/mpl2/c.mustache") + CPP -> $(embedStringFile "embedded/license/mpl2/cpp.mustache") + CSS -> $(embedStringFile "embedded/license/mpl2/css.mustache") + Haskell -> $(embedStringFile "embedded/license/mpl2/haskell.mustache") + HTML -> $(embedStringFile "embedded/license/mpl2/html.mustache") + Java -> $(embedStringFile "embedded/license/mpl2/java.mustache") + JS -> $(embedStringFile "embedded/license/mpl2/js.mustache") + Rust -> $(embedStringFile "embedded/license/mpl2/rust.mustache") + Scala -> $(embedStringFile "embedded/license/mpl2/scala.mustache") + Shell -> $(embedStringFile "embedded/license/mpl2/shell.mustache") diff --git a/src/Headroom/FileSupport.hs b/src/Headroom/FileSupport.hs new file mode 100644 --- /dev/null +++ b/src/Headroom/FileSupport.hs @@ -0,0 +1,250 @@ +{-| +Module : Headroom.FileSupport +Description : License header manipulation +Copyright : (c) 2019-2020 Vaclav Svejcar +License : BSD-3 +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/. +-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +module Headroom.FileSupport + ( -- * File info extraction + extractFileInfo + -- * License header manipulation + , addHeader + , dropHeader + , replaceHeader + -- * License header detection + , findHeader + , findBlockHeader + , findLineHeader + , firstMatching + , lastMatching + , splitInput + ) +where + +import Control.Lens.TH ( makeLensesFor ) +import Headroom.Types ( FileInfo(..) + , FileType(..) + , HeaderConfig(..) + , HeaderSyntax(..) + ) +import RIO +import qualified RIO.HashMap as HM +import qualified RIO.List as L +import qualified RIO.Text as T +import Text.Regex.PCRE.Light ( Regex + , compile + , match + ) +import Text.Regex.PCRE.Light.Char8 ( utf8 ) + + +makeLensesFor [("fiHeaderPos", "fiHeaderPosL")] ''FileInfo + + +-- | Extracts info about the processed file to be later used by the header +-- detection/manipulation functions. +extractFileInfo :: FileType -- ^ type of the detected file + -> HeaderConfig -- ^ appropriate header configuration + -> Text -- ^ text used for detection + -> FileInfo -- ^ resulting file info +extractFileInfo fiFileType fiHeaderConfig input = + let fiHeaderPos = findHeader fiHeaderConfig input + fiVariables = extractVariables fiFileType fiHeaderConfig input + 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 = T.unlines $ 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 = T.lines text + result = T.unlines (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'. +-- +-- >>> let hc = HeaderConfig ["hs"] 0 0 [] [] (BlockComment "{-" "-}") +-- >>> findHeader hc "foo\nbar\n{- HEADER -}\nbaz" +-- Just (2,2) +findHeader :: HeaderConfig -- ^ 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 + + +-- | Finds very first line that matches the given /regex/ (numbered from zero). +-- +-- >>> firstMatching (compile "^foo" [utf8]) ["some text", "foo bar", "foo baz", "last"] +-- Just 1 +firstMatching :: Regex -- /regex/ used for matching + -> [Text] -- input lines + -> Maybe Int -- matching line number +firstMatching regex input = go input 0 + where + cond x = isJust $ match regex (encodeUtf8 x) [] + go (x : _) i | cond x = Just i + go (_ : xs) i = go xs (i + 1) + go [] _ = Nothing + + +-- | Finds very last line that matches the given /regex/ (numbered from zero). +-- +-- >>> lastMatching (compile "^foo" [utf8]) ["some text", "foo bar", "foo baz", "last"] +-- Just 2 +lastMatching :: Regex -- /regex/ used for matching + -> [Text] -- input lines + -> Maybe Int -- matching line number +lastMatching regex input = go input 0 Nothing + where + cond x = isJust $ match regex (encodeUtf8 x) [] + go (x : xs) i _ | cond x = go xs (i + 1) (Just i) + go (_ : xs) i pos = go xs (i + 1) pos + go [] _ pos = pos + + +-- | Splits input lines into three parts: +-- +-- 1. list of all lines located before the very last occurence of one of +-- the conditions from the first condition list +-- 2. list of all lines between the first and last lists +-- 3. list of all lines located after the very first occurence of one of +-- the conditions from the second condition list +-- +-- If both first and second patterns are empty, then all lines are returned in +-- the middle list. +-- +-- >>> splitInput ["->"] ["<-"] "text\n->\nRESULT\n<-\nfoo" +-- (["text","->"],["RESULT"],["<-","foo"]) +-- +-- >>> splitInput [] ["<-"] "text\n->\nRESULT\n<-\nfoo" +-- ([],["text","->","RESULT"],["<-","foo"]) +-- +-- >>> splitInput [] [] "one\ntwo" +-- ([],["one","two"],[]) +splitInput :: [Text] -> [Text] -> Text -> ([Text], [Text], [Text]) +splitInput [] [] input = ([], T.lines input, []) +splitInput fstSplit sndSplit input = (before, middle, after) + where + (middle', after ) = L.splitAt sndSplitAt inLines + (before , middle) = L.splitAt fstSplitAt middle' + fstSplitAt = maybe 0 (+ 1) (findSplit lastMatching fstSplit middle') + sndSplitAt = fromMaybe len (findSplit firstMatching sndSplit inLines) + inLines = T.lines input + len = L.length inLines + findSplit f r i = compile' r >>= (`f` i) + compile' [] = Nothing + compile' ps = Just $ compile (encodeUtf8 $ T.intercalate "|" ps) [utf8] + + +-- TODO: https://github.com/vaclavsvejcar/headroom/issues/25 +extractVariables :: FileType -> HeaderConfig -> Text -> HashMap Text Text +extractVariables _ _ _ = HM.empty + + +stripLinesEnd :: [Text] -> [Text] +stripLinesEnd = takeWhile (not . T.null . T.strip) + + +stripLinesStart :: [Text] -> [Text] +stripLinesStart = dropWhile (T.null . T.strip) diff --git a/src/Headroom/FileSystem.hs b/src/Headroom/FileSystem.hs --- a/src/Headroom/FileSystem.hs +++ b/src/Headroom/FileSystem.hs @@ -1,30 +1,41 @@ {-| Module : Headroom.FileSystem -Description : Files/directories manipulation +Description : Operations related to files and file system Copyright : (c) 2019-2020 Vaclav Svejcar License : BSD-3 Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX -Functions for manipulating files and directories. +Module providing functions for working with the local file system, its file and +directories. -} {-# LANGUAGE NoImplicitPrelude #-} module Headroom.FileSystem - ( fileExtension - , findFiles + ( -- * Traversing the File System + findFiles , findFilesByExts , findFilesByTypes , listFiles , loadFile + -- * Working with Files/Directories + , doesFileExist + , getCurrentDirectory + , createDirectory + -- * Working with Files Metadata + , fileExtension ) where -import Headroom.FileType ( FileType - , listExtensions +import Headroom.FileType ( listExtensions ) +import Headroom.Types ( FileType + , HeadersConfig(..) ) import RIO -import RIO.Directory ( doesDirectoryExist +import RIO.Directory ( createDirectory + , doesDirectoryExist + , doesFileExist + , getCurrentDirectory , getDirectoryContents ) import RIO.FilePath ( isExtensionOf @@ -34,6 +45,7 @@ import qualified RIO.Text as T + -- | Returns file extension for given path (if file), or nothing otherwise. -- -- >>> fileExtension "path/to/some/file.txt" @@ -43,6 +55,7 @@ '.' : xs -> Just $ T.pack xs _ -> Nothing + -- | Recursively finds files on given path whose filename matches the predicate. findFiles :: MonadIO m => FilePath -- ^ path to search @@ -50,6 +63,7 @@ -> m [FilePath] -- ^ found files findFiles path predicate = fmap (filter predicate) (listFiles path) + -- | Recursively finds files on given path by file extensions. findFilesByExts :: MonadIO m => FilePath -- ^ path to search @@ -58,13 +72,17 @@ findFilesByExts path exts = findFiles path predicate where predicate p = any (`isExtensionOf` p) (fmap T.unpack exts) + -- | Recursively find files on given path by their file types. findFilesByTypes :: MonadIO m - => FilePath -- ^ path to search - -> [FileType] -- ^ list of file types - -> m [FilePath] -- ^ list of found files -findFilesByTypes path types = findFilesByExts path (types >>= listExtensions) + => HeadersConfig -- ^ configuration of license headers + -> [FileType] -- ^ list of file types + -> FilePath -- ^ path to search + -> m [FilePath] -- ^ list of found files +findFilesByTypes headersConfig types path = + findFilesByExts path (types >>= listExtensions headersConfig) + -- | Recursively find all files on given path. If file reference is passed -- instead of directory, such file path is returned. listFiles :: MonadIO m @@ -82,6 +100,7 @@ isDirectory <- doesDirectoryExist path if isDirectory then listFiles path else pure [path] pure $ concat paths + -- | Loads file content in UTF8 encoding. loadFile :: MonadIO m diff --git a/src/Headroom/FileType.hs b/src/Headroom/FileType.hs --- a/src/Headroom/FileType.hs +++ b/src/Headroom/FileType.hs @@ -1,79 +1,66 @@ {-| Module : Headroom.FileType -Description : Supported source code file types +Description : Logic for handlig supported file types Copyright : (c) 2019-2020 Vaclav Svejcar License : BSD-3 Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX -This application can generate source code headers from templates for various -type of source code files. Such headers are usually represented as a top level -comment, the application must render such header with correct syntax. -The 'FileType' represents such type of source code file, which is recognized by -this application and for which the license headers can be manipulated. +Module providing functions for working with the 'FileType', such as performing +detection based on the file extension, etc. -} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} module Headroom.FileType - ( FileType(..) + ( configByFileType , fileTypeByExt , listExtensions - , fileTypeByName ) where -import Headroom.Types.Utils ( allValues - , readEnumCI +import Headroom.Types ( FileType(..) + , HeaderConfig(..) + , HeadersConfig(..) ) +import Headroom.Types.EnumExtra ( EnumExtra(..) ) import RIO import qualified RIO.List as L -import qualified RIO.Text as T -import Text.Read ( readsPrec ) --- | Represents supported type of source code file, where license headers may --- be added, replaced or removed. -data FileType - = CSS -- ^ /CSS/ source code file - | Haskell -- ^ /Haskell/ source code file - | HTML -- ^ /HTML/ source code file - | Java -- ^ /Java/ source code file - | JS -- ^ /JavaScript/ source code file - | Scala -- ^ /Scala/ source code file - deriving (Bounded, Enum, Eq, Ord, Show) -instance Read FileType where - readsPrec _ = readEnumCI +-- | Returns 'FileType' for given file extension (without dot), using configured +-- values from the 'HeadersConfig'. +fileTypeByExt :: HeadersConfig -- ^ license headers configuration + -> Text -- ^ file extension (without dot) + -> Maybe FileType -- ^ found 'FileType' +fileTypeByExt config ext = + L.find (elem ext . listExtensions config) (allValues @FileType) --- | Returns 'FileType' for given file extension (without dot). --- --- >>> fileTypeByExt "hs" --- Just Haskell -fileTypeByExt :: Text -- ^ file extension to search for - -> Maybe FileType -- ^ corresponding 'FileType' (if found) -fileTypeByExt ext = - L.find (elem ext . listExtensions) (allValues :: [FileType]) --- | Lists all recognized file extensions for given 'FileType'. --- --- >>> listExtensions Haskell --- ["hs"] -listExtensions :: FileType -- ^ 'FileType' to list extensions for - -> [Text] -- ^ list of found file extensions -listExtensions = \case - CSS -> ["css"] - Haskell -> ["hs"] - HTML -> ["html", "htm"] - Java -> ["java"] - JS -> ["js"] - Scala -> ["scala"] +-- | Lists all recognized file extensions for given 'FileType', using configured +-- values from the 'HeadersConfig'. +listExtensions :: HeadersConfig -- ^ license headers configuration + -> FileType -- ^ 'FileType' for which to list extensions + -> [Text] -- ^ list of appropriate file extensions +listExtensions config fileType = + hcFileExtensions (configByFileType config fileType) --- | Reads 'FileType' from its textual representation. --- --- >>> fileTypeByName "haskell" --- Just Haskell -fileTypeByName :: Text -- ^ textual representation of 'FileType' - -> Maybe FileType -- ^ corresponding 'FileType' (if found) -fileTypeByName = readMaybe . T.unpack + +-- | Returns the proper 'HeaderConfig' for the given 'FileType', selected +-- from the 'HeadersConfig'. +configByFileType :: HeadersConfig -- ^ license headers configuration + -> FileType -- ^ selected 'FileType' + -> HeaderConfig -- ^ appropriate 'HeaderConfig' +configByFileType HeadersConfig {..} fileType = case fileType of + C -> hscC + CPP -> hscCpp + CSS -> hscCss + Haskell -> hscHaskell + HTML -> hscHtml + Java -> hscJava + JS -> hscJs + Rust -> hscRust + Scala -> hscScala + Shell -> hscShell diff --git a/src/Headroom/Global.hs b/src/Headroom/Global.hs deleted file mode 100644 --- a/src/Headroom/Global.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-| -Module : Headroom.Global -Description : Global data types and programmatic configuration -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -Contains data types and configuration that needs to be expressed as compile -time code. --} -{-# LANGUAGE NoImplicitPrelude #-} -module Headroom.Global - ( TemplateType - ) -where - -import Headroom.Template.Mustache ( Mustache ) - --- | Type of the template format. -type TemplateType = Mustache diff --git a/src/Headroom/Header.hs b/src/Headroom/Header.hs deleted file mode 100644 --- a/src/Headroom/Header.hs +++ /dev/null @@ -1,91 +0,0 @@ -{-| -Module : Headroom.Header -Description : License header manipulation -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -License header is usually the very top comment in source code, holding some -short text about license type, author and copyright. This module provides data -types and functions for adding, dropping and replacing such headers. The license -header is represented by 'Header' data type, where 'FileType' defines for which -programming language source code this header is generated and the header text -itself. --} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NoImplicitPrelude #-} -module Headroom.Header - ( Header(..) - , addHeader - , containsHeader - , dropHeader - , headerSize - , replaceHeader - ) -where - -import Headroom.FileType ( FileType(..) ) -import Headroom.Header.Impl -import qualified Headroom.Text as T -import Headroom.Types ( NewLine(..) ) -import RIO -import qualified RIO.List as L - - --- | Generated license header for specified source code file type. -data Header = Header - { hFileType :: FileType -- ^ type of the source code - , hContent :: Text -- ^ text of the header - } - deriving (Eq, Show) - --- | Adds header to the given source code text if no existing header is --- detected, otherwise returns the unchanged input text. If you need to replace --- the header, use the 'replaceHeader' instead. -addHeader :: Header -- ^ license header to add to the input text - -> Text -- ^ source code text - -> Text -- ^ source code text with added license header -addHeader (Header fileType content) input = output - where - output = if containsHeader' then input else content <> newLine <> input - containsHeader' = containsHeader fileType input - newLine = T.showNewLine $ fromMaybe LF (T.detectNewLine input) - --- | Checks whether the license header is present in given source code text. -containsHeader :: FileType -- ^ type of the input source code text - -> Text -- ^ source code text - -> Bool -- ^ result of check -containsHeader fileType input = headerSize fileType input > 0 - --- | Drops license header (if detected) from the given source code text. -dropHeader :: FileType -- ^ type of the input source code text - -> Text -- ^ source code text - -> Text -- ^ source code text without the license header -dropHeader fileType input = T.unlines' newLine . L.drop numLines $ lines' - where - numLines = headerSize fileType input - (newLine, lines') = T.lines' input - --- | Detects what is the header size in terms of lines in the given source code --- text. Returns @0@ if no header detected. -headerSize :: FileType -- ^ type of the input source code text - -> Text -- ^ source code text - -> Int -- ^ size of the headers (number of lines) -headerSize = \case - CSS -> headerSizeCSS - Haskell -> headerSizeHaskell - HTML -> headerSizeHTML - Java -> headerSizeJava - JS -> headerSizeJS - Scala -> headerSizeScala - --- | Replaces already existing (or adds if none detected) license header with --- the new one in the given source code text. If you need to only add header if --- none detected and skip if it already contains one, use the 'addHeader' --- instead. -replaceHeader :: Header -- ^ new license header to use for replacement - -> Text -- ^ source code text - -> Text -- ^ source code text with replaced license header -replaceHeader h@(Header fileType _) = addHeader h . dropHeader fileType diff --git a/src/Headroom/Header/Impl.hs b/src/Headroom/Header/Impl.hs deleted file mode 100644 --- a/src/Headroom/Header/Impl.hs +++ /dev/null @@ -1,28 +0,0 @@ -{-| -Module : Headroom.Header.Impl -Description : All license header implementations -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -Re-exports @headerSizeXY@ functions from all existing implementation modules. --} -{-# LANGUAGE NoImplicitPrelude #-} -module Headroom.Header.Impl - ( headerSizeCSS - , headerSizeHaskell - , headerSizeHTML - , headerSizeJava - , headerSizeJS - , headerSizeScala - ) -where - -import Headroom.Header.Impl.CSS ( headerSizeCSS ) -import Headroom.Header.Impl.Haskell ( headerSizeHaskell ) -import Headroom.Header.Impl.HTML ( headerSizeHTML ) -import Headroom.Header.Impl.Java ( headerSizeJava ) -import Headroom.Header.Impl.JS ( headerSizeJS ) -import Headroom.Header.Impl.Scala ( headerSizeScala ) diff --git a/src/Headroom/Header/Impl/CSS.hs b/src/Headroom/Header/Impl/CSS.hs deleted file mode 100644 --- a/src/Headroom/Header/Impl/CSS.hs +++ /dev/null @@ -1,29 +0,0 @@ -{-| -Module : Headroom.Header.Impl.CSS -Description : Support for license header in CSS files -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -Support for detecting license header in /CSS/ source code files. --} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE QuasiQuotes #-} -module Headroom.Header.Impl.CSS - ( headerSizeCSS - ) -where - -import Headroom.Header.Utils ( linesCountByRegex - , reML - ) -import RIO - - --- | Returns size of license header (as number of lines) in given /CSS/ source --- code. The very first comment block is considered as license header, anything --- after as start of the actual code. -headerSizeCSS :: Text -> Int -headerSizeCSS = linesCountByRegex [reML|(\/\*(?:.*?)\*\/)\s*|(\s*)|] diff --git a/src/Headroom/Header/Impl/HTML.hs b/src/Headroom/Header/Impl/HTML.hs deleted file mode 100644 --- a/src/Headroom/Header/Impl/HTML.hs +++ /dev/null @@ -1,29 +0,0 @@ -{-| -Module : Headroom.Header.Impl.HTML -Description : Support for license header in HTML files -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -Support for detecting license header in /HTML/ source code files. --} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE QuasiQuotes #-} -module Headroom.Header.Impl.HTML - ( headerSizeHTML - ) -where - -import Headroom.Header.Utils ( linesCountByRegex - , reML - ) -import RIO - - --- | Returns size of license header (as number of lines) in given /HTML/ source --- code. The very first /HTML/ comment is considered as license header, anything --- after as start of the actual code. -headerSizeHTML :: Text -> Int -headerSizeHTML = linesCountByRegex [reML|()\s*|] diff --git a/src/Headroom/Header/Impl/Haskell.hs b/src/Headroom/Header/Impl/Haskell.hs deleted file mode 100644 --- a/src/Headroom/Header/Impl/Haskell.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-| -Module : Headroom.Header.Impl.Haskell -Description : Support for license header in Haskell files -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -Support for detecting license header in /Haskell/ source code files. --} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Headroom.Header.Impl.Haskell - ( headerSizeHaskell - ) -where - -import Headroom.Header.Utils ( findLineStartingWith ) -import RIO - - --- | Returns size of license header (as number of lines) in given /Haskell/ --- source code. Current implementation is pretty simple and it only takes line --- starting with one of the following keywords as the start of code itself: --- --- * @{-#@ --- * @module@ -headerSizeHaskell :: Text -> Int -headerSizeHaskell = findLineStartingWith ["{-#", "module"] diff --git a/src/Headroom/Header/Impl/JS.hs b/src/Headroom/Header/Impl/JS.hs deleted file mode 100644 --- a/src/Headroom/Header/Impl/JS.hs +++ /dev/null @@ -1,29 +0,0 @@ -{-| -Module : Headroom.Header.Impl.JS -Description : Support for license header in JavaScript files -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -Support for detecting license header in /JavaScript/ source code files. --} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE QuasiQuotes #-} -module Headroom.Header.Impl.JS - ( headerSizeJS - ) -where - -import Headroom.Header.Utils ( linesCountByRegex - , reML - ) -import RIO - - --- | Returns size of license header (as number of lines) in given /JS/ source --- code. The very first comment block is considered as license header, anything --- after as start of the actual code. -headerSizeJS :: Text -> Int -headerSizeJS = linesCountByRegex [reML|(\/\*(?:.*?)\*\/)\s*|(\s*)|] diff --git a/src/Headroom/Header/Impl/Java.hs b/src/Headroom/Header/Impl/Java.hs deleted file mode 100644 --- a/src/Headroom/Header/Impl/Java.hs +++ /dev/null @@ -1,29 +0,0 @@ -{-| -Module : Headroom.Header.Impl.Java -Description : Support for license header in Java files -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -Support for detecting license header in /Java/ source code files. --} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Headroom.Header.Impl.Java - ( headerSizeJava - ) -where - -import Headroom.Header.Utils ( findLineStartingWith ) -import RIO - - --- | Returns size of license header (as number of lines) in given /Java/ --- source code. Current implementation is pretty simple and it only takes line --- starting with one of the following keywords as the start of code itself: --- --- * @package@ -headerSizeJava :: Text -> Int -headerSizeJava = findLineStartingWith ["package"] diff --git a/src/Headroom/Header/Impl/Scala.hs b/src/Headroom/Header/Impl/Scala.hs deleted file mode 100644 --- a/src/Headroom/Header/Impl/Scala.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-| -Module : Headroom.Header.Impl.Scala -Description : Support for license header in Scala files -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -Support for detecting license header in /Scala/ source code files. --} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Headroom.Header.Impl.Scala - ( headerSizeScala - ) -where - -import Headroom.Header.Utils ( findLineStartingWith ) -import RIO - - --- | Returns size of license header (as number of lines) in given /Scala/ --- source code. Current implementation is pretty simple and it only takes line --- starting with one of the following keywords as the start of code itself: --- --- * @class@ --- * @object@ --- * @package@ -headerSizeScala :: Text -> Int -headerSizeScala = findLineStartingWith ["class", "object", "package"] diff --git a/src/Headroom/Header/Utils.hs b/src/Headroom/Header/Utils.hs deleted file mode 100644 --- a/src/Headroom/Header/Utils.hs +++ /dev/null @@ -1,56 +0,0 @@ -{-| -Module : Headroom.Header.Utils -Description : License header utilities -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -Useful functions for searching specific text fragments in input text, used by -other modules to detect existing license headers in source code files. --} -{-# LANGUAGE NoImplicitPrelude #-} -module Headroom.Header.Utils - ( findLine - , findLineStartingWith - , linesCountByRegex - , reML - ) -where - -import Language.Haskell.TH.Quote ( QuasiQuoter ) -import RIO -import qualified RIO.List as L -import qualified RIO.Text as T -import Text.Regex.PCRE.Heavy -import Text.Regex.PCRE.Light - --- | Finds line in given text that matches given predicate and returns its line --- number. -findLine :: (Text -> Bool) -- ^ predicate to find line - -> Text -- ^ input text - -> Int -- ^ number of line that matches given predicate -findLine predicate text = - fromMaybe 0 $ L.findIndex (predicate . T.strip) (T.lines text) - --- | Finds line starting with one of given patterns and returns its line number --- (specialized form of 'findLine'). -findLineStartingWith :: [Text] -- ^ patterns to use - -> Text -- ^ input text - -> Int -- ^ number of line starting with one of patterns -findLineStartingWith patterns = findLine predicate - where predicate line = or $ fmap (`T.isPrefixOf` line) patterns - --- | Count lines that matches the given (multiline) regex. Useful for example to --- find how many lines are taken by multi-line comment in source code. -linesCountByRegex :: Regex -- ^ regular expression to use - -> Text -- ^ input text - -> Int -- ^ number of lines matching given regex -linesCountByRegex regex text = case L.headMaybe $ scan regex text of - Just (comment, _) -> L.length . T.lines $ comment - _ -> 0 - --- | Regex configuration for matching multi-line UTF strings. -reML :: QuasiQuoter -reML = mkRegexQQ [dotall, utf8] diff --git a/src/Headroom/License.hs b/src/Headroom/License.hs deleted file mode 100644 --- a/src/Headroom/License.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-| -Module : Headroom.License -Description : Representation of various license types -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -This module provides data types and functions for representing various -opensource licenses, for which this application can generate /Jinja/ templates. -As the template text itself of given license may differ based on target -programming language (i.e. syntax for comments is different), each 'License' is -represented by the 'LicenseType' and 'FileType'. --} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Headroom.License - ( License(..) - , LicenseType(..) - , parseLicense - , parseLicenseType - ) -where - -import Headroom.FileType ( FileType(..) - , fileTypeByName - ) -import Headroom.Types.Utils ( readEnumCI ) -import RIO -import qualified RIO.Text as T -import qualified RIO.Text.Partial as TP -import Text.Read ( readsPrec ) - - --- | Type of the license. -data LicenseType - = Apache2 -- ^ /Apache License, version 2.0/ - | BSD3 -- ^ /BSD-3/ license - | GPL2 -- ^ /GNU GPL v.2/ license - | GPL3 -- ^ /GNU GPL v.3/ license - | MIT -- ^ /MIT/ license - deriving (Bounded, Enum, Eq, Ord, Show) - -instance Read LicenseType where - readsPrec _ = readEnumCI - --- | License (specified by 'LicenseType' and 'FileType') -data License = License LicenseType FileType - deriving (Show, Eq) - --- | Parses 'License' from the raw string representation, formatted as --- @licenseType:fileType@. --- --- >>> parseLicense "bsd3:haskell" --- Just (License BSD3 Haskell) -parseLicense :: Text -- ^ raw string representation - -> Maybe License -- ^ parsed 'License' -parseLicense raw - | [rawLicenseType, rawFileType] <- TP.splitOn ":" raw = do - licenseType <- parseLicenseType rawLicenseType - fileType <- fileTypeByName rawFileType - pure $ License licenseType fileType - | otherwise = Nothing - --- | Parses 'LicenseType' from the raw string representation. --- --- >>> parseLicenseType "bsd3" --- Just BSD3 -parseLicenseType :: Text -> Maybe LicenseType -parseLicenseType = readMaybe . T.unpack diff --git a/src/Headroom/Meta.hs b/src/Headroom/Meta.hs --- a/src/Headroom/Meta.hs +++ b/src/Headroom/Meta.hs @@ -1,24 +1,59 @@ {-| Module : Headroom.Meta -Description : Application metadata +Description : Application metadata (name, vendor, etc.) Copyright : (c) 2019-2020 Vaclav Svejcar License : BSD-3 Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX -Metadata about the application (e.g. build version, application name, etc). +Module providing application metadata, such as application name, vendor, +version, etc. -} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} module Headroom.Meta - ( buildVer + ( TemplateType + , buildVersion + , productDesc + , productInfo + , productName + , website ) where import Data.Version ( showVersion ) +import Headroom.Template.Mustache ( Mustache ) import Paths_headroom ( version ) import RIO +import qualified RIO.Text as T --- | Returns application version, as specified in @headroom.cabal@ file. -buildVer :: String -buildVer = showVersion version + + +-- | Type of the template format used for license headers. +type TemplateType = Mustache + + +-- | Application version, as specified in @headroom.cabal@ file. +buildVersion :: Text +buildVersion = T.pack . showVersion $ version + + +-- | Full product description. +productDesc :: Text +productDesc = "manage your source code license headers" + + +-- | Product info. +productInfo :: Text +productInfo = mconcat [productName, ", v", buildVersion, " :: ", website] + + +-- | Product name. +productName :: Text +productName = "headroom" + + +-- | Homepage website of the product. +website :: Text +website = "https://github.com/vaclavsvejcar/headroom" diff --git a/src/Headroom/Serialization.hs b/src/Headroom/Serialization.hs new file mode 100644 --- /dev/null +++ b/src/Headroom/Serialization.hs @@ -0,0 +1,75 @@ +{-| +Module : Headroom.Serialization +Description : Various functions for data (de)serialization +Copyright : (c) 2019-2020 Vaclav Svejcar +License : BSD-3 +Maintainer : vaclav.svejcar@gmail.com +Stability : experimental +Portability : POSIX + +Module providing support for data (de)serialization, mainly from/to /JSON/ +and /YAML/. +-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NoImplicitPrelude #-} +module Headroom.Serialization + ( -- * JSON/YAML Serialization + aesonOptions + , dropFieldPrefix + , symbolCase + -- * Pretty Printing + , prettyPrintYAML + ) +where + +import Data.Aeson ( Options + , ToJSON(..) + , defaultOptions + , fieldLabelModifier + ) +import qualified Data.Yaml.Pretty as YP +import RIO +import qualified RIO.Char as C + + + +-- | Custom /Aeson/ encoding options used for generic mapping between data +-- records and /JSON/ or /YAML/ values. Expects the fields in input to be +-- without the prefix and with words formated in /symbol case/ +-- (example: record field @uUserName@, /JSON/ field @user-name@). +aesonOptions :: Options +aesonOptions = + defaultOptions { fieldLabelModifier = symbolCase '-' . dropFieldPrefix } + + +-- | Drops prefix from camel-case text. +-- +-- >>> dropFieldPrefix "xxHelloWorld" +-- "helloWorld" +dropFieldPrefix :: String -> String +dropFieldPrefix = \case + (x : n : xs) | C.isUpper x && C.isUpper n -> x : n : xs + (x : n : xs) | C.isUpper x -> C.toLower x : n : xs + (_ : xs) -> dropFieldPrefix xs + [] -> [] + + +-- | Transforms camel-case text into text cased with given symbol. +-- +-- >>> symbolCase '-' "fooBar" +-- "foo-bar" +symbolCase :: Char -- ^ word separator symbol + -> String -- ^ input text + -> String -- ^ processed text +symbolCase sym = \case + [] -> [] + (x : xs) | C.isUpper x -> sym : C.toLower x : symbolCase sym xs + | otherwise -> x : symbolCase sym xs + + +-- | Pretty prints given data as /YAML/. +prettyPrintYAML :: ToJSON a + => a -- ^ data to pretty print + -> Text -- ^ pretty printed /YAML/ output +prettyPrintYAML = decodeUtf8Lenient . YP.encodePretty prettyConfig + where prettyConfig = YP.setConfCompare compare YP.defConfig diff --git a/src/Headroom/Template.hs b/src/Headroom/Template.hs --- a/src/Headroom/Template.hs +++ b/src/Headroom/Template.hs @@ -1,51 +1,38 @@ {-| Module : Headroom.Template -Description : Generic support for license header templates +Description : Generic representation of supported template type Copyright : (c) 2019-2020 Vaclav Svejcar License : BSD-3 Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX -Provides generic support for the license header templates, represented by the -'Template' type class. Various implementations can be plugged in by creating -custom instance of this type class. +Module providing generic representation of supported template type, using +the 'Template' /type class/. -} -{-# LANGUAGE NoImplicitPrelude #-} -module Headroom.Template - ( Template(..) - , loadTemplate - ) -where +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE NoImplicitPrelude #-} +module Headroom.Template where -import Headroom.FileSystem ( loadFile ) import RIO -import qualified RIO.Text as T - -- | Type class representing generic license header template support. class Template t where + + -- | Returns list of supported file extensions for this template type. - templateExtensions :: proxy t -- ^ phantom parameter, not used - -> NonEmpty Text -- ^ list of supported file extensions + templateExtensions :: NonEmpty Text -- ^ list of supported file extensions + -- | Parses template from given raw text. parseTemplate :: MonadThrow m => Maybe Text -- ^ name of the template (optional) -> Text -- ^ raw template text -> m t -- ^ parsed template - -- | Renders parsed template and replaces all variables. - renderTemplate :: MonadThrow m - => HashMap Text Text -- ^ variables to replace - -> t -- ^ parsed template to render - -> m Text -- ^ rendered template text --- | Loads and parses template from file. -loadTemplate :: (MonadIO m, Template t) - => FilePath -- ^ path to template file - -> m t -- ^ loaded and parsed template -loadTemplate path = do - raw <- loadFile path - liftIO $ parseTemplate (Just $ T.pack path) raw - + -- | Renders parsed template and replaces all variables with actual values. + renderTemplate :: MonadThrow m + => HashMap Text Text -- ^ values of variables to replace + -> t -- ^ parsed template to render + -> m Text -- ^ rendered template text diff --git a/src/Headroom/Template/Mustache.hs b/src/Headroom/Template/Mustache.hs --- a/src/Headroom/Template/Mustache.hs +++ b/src/Headroom/Template/Mustache.hs @@ -1,16 +1,16 @@ {-| Module : Headroom.Template.Mustache -Description : Support for Mustache templates +Description : Implementation of /Mustache/ template support Copyright : (c) 2019-2020 Vaclav Svejcar License : BSD-3 Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX -Provides support for templates using the -'Template' type class. +This module provides support for templates. -} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Headroom.Template.Mustache @@ -19,29 +19,33 @@ where import Headroom.Template ( Template(..) ) +import Headroom.Types ( ApplicationError(..) + , TemplateError(..) + ) import RIO +import qualified RIO.Text as T import qualified Text.Mustache as MU import Text.Mustache.Render ( SubstitutionError(..) ) -import Headroom.Types ( HeadroomError(..) ) -import qualified RIO.Text as T - -- | The /Mustache/ template. newtype Mustache = Mustache MU.Template deriving (Show) + -- | Support for /Mustache/ templates. instance Template Mustache where - templateExtensions _ = "mustache" :| [] - parseTemplate = parseTemplate' - renderTemplate = renderTemplate' + templateExtensions = "mustache" :| [] + parseTemplate = parseTemplate' + renderTemplate = renderTemplate' + parseTemplate' :: MonadThrow m => Maybe Text -> Text -> m Mustache parseTemplate' name raw = case MU.compileTemplate templateName raw of - Left err -> throwM $ ParseError (T.pack . show $ err) + Left err -> throwM $ TemplateError (ParseError (T.pack . show $ err)) Right res -> pure $ Mustache res where templateName = T.unpack . fromMaybe "" $ name + renderTemplate' :: MonadThrow m => HashMap Text Text -> Mustache -> m Text renderTemplate' variables (Mustache t@(MU.Template name _ _)) = case MU.checkedSubstitute t variables of @@ -49,7 +53,7 @@ (errs, rendered) -> let errs' = missingVariables errs in if length errs == length errs' - then throwM $ MissingVariables (T.pack name) errs' + then throwM $ TemplateError (MissingVariables (T.pack name) errs') else pure rendered where missingVariables = concatMap @@ -57,4 +61,3 @@ (VariableNotFound ps) -> ps _ -> [] ) - diff --git a/src/Headroom/Text.hs b/src/Headroom/Text.hs deleted file mode 100644 --- a/src/Headroom/Text.hs +++ /dev/null @@ -1,69 +0,0 @@ -{-| -Module : MODULE_NAME -Description : Extras for text manipulation -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -Adds some extra functionality to the "Data.Text" module. --} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Headroom.Text - ( detectNewLine - , showNewLine - , lines' - , unlines' - ) -where - -import Headroom.Types ( NewLine(..) ) -import RIO -import RIO.Text ( isInfixOf ) -import qualified RIO.Text as T -import qualified RIO.Text.Partial as TP - - --- | Detects which newline character is used in given text (if any). --- --- >>> detectNewLine "foo\nbar" --- Just LF -detectNewLine :: Text -- ^ input text - -> Maybe NewLine -- ^ detected newline character -detectNewLine text | showNewLine CRLF `isInfixOf` text = Just CRLF - | showNewLine CR `isInfixOf` text = Just CR - | showNewLine LF `isInfixOf` text = Just LF - | otherwise = Nothing - --- | Renders appropriate newline character (e.g. @\n@) for given 'NewLine' --- representation. --- --- >>> showNewLine LF --- "\n" -showNewLine :: NewLine -- ^ newline character to render - -> Text -- ^ rendered character -showNewLine = \case - CR -> "\r" - CRLF -> "\r\n" - LF -> "\n" - --- | Split text into lines, return lines and detected newline separator. --- --- >>> lines' "foo\nbar" --- (LF,["foo","bar"]) -lines' :: Text -- ^ text to split - -> (NewLine, [Text]) -- ^ detected newline separator and split lines -lines' text = (newLine, chunks) - where - newLine = fromMaybe LF (detectNewLine text) - chunks = TP.splitOn (showNewLine newLine) text - --- | Join individual text lines into single text, using given newline separator. --- --- >>> unlines' LF ["foo", "bar"] --- "foo\nbar" -unlines' :: NewLine -> [Text] -> Text -unlines' newLine = T.intercalate $ showNewLine newLine diff --git a/src/Headroom/Types.hs b/src/Headroom/Types.hs --- a/src/Headroom/Types.hs +++ b/src/Headroom/Types.hs @@ -1,115 +1,456 @@ {-| Module : Headroom.Types -Description : Data types and instances +Description : Application data types Copyright : (c) 2019-2020 Vaclav Svejcar License : BSD-3 Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX -Data types and type class instances shared between modules. +Module containing most of the data types used by the application. -} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module Headroom.Types - ( AppConfigError(..) - , HeadroomError(..) - , NewLine(..) + ( + -- * Configuration Data Types + -- ** Total Configuration + Configuration(..) + , HeaderConfig(..) + , HeadersConfig(..) + -- ** Partial Configuration + , PartialConfiguration(..) + , PartialHeaderConfig(..) + , PartialHeadersConfig(..) + -- ** Other Configuration Data Types + , HeaderSyntax(..) + -- * Command Data Types + , Command(..) + , CommandGenOptions(..) + , CommandInitOptions(..) + , CommandRunOptions(..) + , ConfigurationError(..) , RunMode(..) - , InitCommandError(..) + , GenMode(..) + -- * Error Data Types + , ApplicationError(..) + , CommandGenError(..) + , CommandInitError(..) + , TemplateError(..) + -- * Other Data Types + , LicenseType(..) + , FileType(..) + , FileInfo(..) ) where -import Data.Aeson ( FromJSON(parseJSON) - , ToJSON(toJSON) +import Control.Exception ( throw ) +import Data.Aeson ( FromJSON(..) , Value(String) + , genericParseJSON + , withObject + , (.!=) + , (.:?) ) +import Data.Monoid ( Last(..) ) +import Headroom.Serialization ( aesonOptions ) +import Headroom.Types.EnumExtra ( EnumExtra(..) ) import RIO -import qualified RIO.List as L import qualified RIO.Text as T --- | Error occured during validation of application configuration. -data AppConfigError - = EmptySourcePaths -- ^ no paths to source code files provided - | EmptyTemplatePaths -- ^ no paths to license header templates provided +-- | Represents what action should the @run@ command perform. +data RunMode + = Add + | Drop + | Replace + deriving (Eq, Show) + +instance FromJSON RunMode where + parseJSON = \case + String s -> case T.toLower s of + "add" -> pure Add + "drop" -> pure Drop + "replace" -> pure Replace + _ -> error $ "Unknown run mode: " <> T.unpack s + other -> error $ "Invalid value for run mode: " <> show other + +-- | Represents what action should the @gen@ command perform. +data GenMode + = GenConfigFile -- ^ generate /YAML/ config file stub + | GenLicense !(LicenseType, FileType) -- ^ generate license header template + deriving (Eq, Show) + +-- | Represents error that can occur during the application execution. +data ApplicationError + = CommandGenError !CommandGenError -- ^ error specific for the @gen@ command + | CommandInitError !CommandInitError -- ^ error specific for the @init@ command + | ConfigurationError !ConfigurationError -- ^ error processing configuration + | TemplateError !TemplateError -- ^ error processing template + deriving (Eq, Show) + +instance Exception ApplicationError where + displayException = T.unpack . \case + CommandGenError error' -> commandGenError error' + CommandInitError error' -> commandInitError error' + ConfigurationError error' -> configurationError error' + TemplateError error' -> templateError error' + +-- | Error specific for the @gen@ command. +data CommandGenError = NoGenModeSelected -- ^ no mode of /Gen/ command selected + deriving (Eq, Show) + +-- | Error specific for the @init@ command. +data CommandInitError + = AppConfigAlreadyExists !FilePath -- ^ application configuration file already exists + | NoProvidedSourcePaths -- ^ no paths to source code files provided + | NoSupportedFileType -- ^ no supported file types found on source paths + deriving (Eq, Show) + +-- | Error during processing configuration. +data ConfigurationError + = InvalidVariable !Text -- ^ invalid variable input (as @key=value@) + | MixedHeaderSyntax -- ^ illegal configuration for 'HeaderSyntax' + | NoFileExtensions !FileType -- ^ no configuration for @file-extensions@ + | NoHeaderSyntax !FileType -- ^ no configuration for header syntax + | NoMarginAfter !FileType -- ^ no configuration for @margin-after@ + | NoMarginBefore !FileType -- ^ no configuration for @margin-before@ + | NoPutAfter !FileType -- ^ no configuration for @put-after@ + | NoPutBefore !FileType -- ^ no configuration for @put-before@ + | NoRunMode -- ^ no configuration for @run-mode@ + | NoSourcePaths -- ^ no configuration for @source-paths@ + | NoTemplatePaths -- ^ no configuration for @template-paths@ + | NoVariables -- ^ no configuration for @variables@ + deriving (Eq, Show) + +-- | Error during processing template. +data TemplateError + = MissingVariables !Text ![Text] -- ^ missing variable values + | ParseError !Text -- ^ error parsing raw template text + deriving (Eq, Show) + +-------------------------------------------------------------------------------- + +-- | Application command. +data Command + = Run [FilePath] [FilePath] [Text] (Maybe RunMode) Bool -- ^ @run@ command + | Gen Bool (Maybe (LicenseType, FileType)) -- ^ @gen@ command + | Init LicenseType [FilePath] -- ^ @init@ command deriving (Show) --- | Represents fatal application error, that should be displayed to user in --- some human readable form. -data HeadroomError - = InvalidAppConfig [AppConfigError] -- ^ invalid application configuration - | InvalidLicense Text -- ^ unknown license is selected in /Generator/ - | InvalidVariable Text -- ^ invalid variable format (@key=value@) - | MissingVariables Text [Text] -- ^ not all variables were filled in template - | NoGenModeSelected -- ^ no mode for /Generator/ command is selected - | ParseError Text -- ^ error parsing template file - | InitCommandError InitCommandError -- ^ error during execution of /Init/ command - deriving (Show, Typeable) +-------------------------------------------------------------------------------- --- | Errors specific for the /Init/ command. -data InitCommandError - = AppConfigAlreadyExists -- ^ application configuration file already exists - | InvalidLicenseType Text -- ^ invalid license type specified - | NoSourcePaths -- ^ no paths to source code files provided - | NoSupportedFileType -- ^ no supported file types found on source paths +-- | Options for the @gen@ command. +newtype CommandGenOptions = CommandGenOptions + { cgoGenMode :: GenMode -- ^ selected mode + } deriving (Show) --- | Represents newline separator. -data NewLine - = CR -- ^ line ends with @\r@ - | CRLF -- ^ line ends with @\r\n@ - | LF -- ^ line ends with @\n@ +-- | Options for the @init@ command. +data CommandInitOptions = CommandInitOptions + { cioSourcePaths :: ![FilePath] -- ^ paths to source code files + , cioLicenseType :: !LicenseType -- ^ license type + } + deriving Show + +-- | Options for the @run@ command. +data CommandRunOptions = CommandRunOptions + { croRunMode :: !(Maybe RunMode) -- ^ used /Run/ command mode + , croSourcePaths :: ![FilePath] -- ^ source code file paths + , croTemplatePaths :: ![FilePath] -- ^ template file paths + , croVariables :: ![Text] -- ^ raw variables + , croDebug :: !Bool -- ^ whether to run in debug mode + } deriving (Eq, Show) --- | Mode of the /Run/ command, states how to license headers in source code --- files. -data RunMode - = Add -- ^ add license header if missing in source code file - | Drop -- ^ drop any license header if present in source code file - | Replace -- ^ replace existing or add license header +-------------------------------------------------------------------------------- + +-- | Supported type of source code file. +data FileType + = C -- ^ support for /C/ programming language + | CPP -- ^ support for /C++/ programming language + | CSS -- ^ support for /CSS/ + | Haskell -- ^ support for /Haskell/ programming language + | HTML -- ^ support for /HTML/ + | Java -- ^ support for /Java/ programming language + | JS -- ^ support for /JavaScript/ programming language + | Rust -- ^ support for /Rust/ programming language + | Scala -- ^ support for /Scala/ programming language + | Shell -- ^ support for /Shell/ + deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) + +-------------------------------------------------------------------------------- + +-- | Supported type of open source license. +data LicenseType + = Apache2 -- ^ support for /Apache-2.0/ license + | BSD3 -- ^ support for /BSD-3-Clause/ license + | GPL2 -- ^ support for /GNU GPL2/ license + | GPL3 -- ^ support for /GNU GPL3/ license + | MIT -- ^ support for /MIT/ license + | MPL2 -- ^ support for /MPL2/ license + deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) + +-------------------------------------------------------------------------------- + +-- | Info extracted about the concrete source code file. +data FileInfo = FileInfo + { fiFileType :: !FileType -- ^ type of the file + , fiHeaderConfig :: !HeaderConfig -- ^ configuration for license header + , fiHeaderPos :: !(Maybe (Int, Int)) -- ^ position of existing license header + , fiVariables :: !(HashMap Text Text) -- ^ additional extracted variables + } deriving (Eq, Show) -displayAppConfigError :: AppConfigError -> Text -displayAppConfigError = \case - EmptySourcePaths -> "no paths to source code files" - EmptyTemplatePaths -> "no paths to template files" +-------------------------------------------------------------------------------- ----------------------------- TYPE CLASS INSTANCES ---------------------------- +-- | Syntax of the license header comment. +data HeaderSyntax + = BlockComment !Text !Text -- ^ block (multi-line) comment syntax (e.g. @/* */@) + | LineComment !Text -- ^ single line comment syntax (e.g. @//@) + deriving (Eq, Show) -instance Exception HeadroomError where - displayException = \case - InvalidAppConfig errors -> mconcat - [ "Invalid configuration, following problems found:\n" - , L.intercalate - "\n" - (fmap (\e -> "\t- " <> (T.unpack . displayAppConfigError $ e)) errors) - ] - InvalidLicense raw -> "Cannot parse license type from: " <> T.unpack raw - InvalidVariable raw -> - "Cannot parse variable key=value from: " <> T.unpack raw - NoGenModeSelected - -> "Please select at least one option what to generate (see --help for details)" - MissingVariables name variables -> mconcat - ["Missing variables for template '", T.unpack name, "': ", show variables] - ParseError msg -> "Error parsing template: " <> T.unpack msg - InitCommandError icError -> case icError of - AppConfigAlreadyExists -> "Config file '.headroom.yaml' already exists" - InvalidLicenseType raw -> "Invalid license type: " <> T.unpack raw - NoSourcePaths -> "No path to source code files defined" - NoSupportedFileType -> "No supported file type found" +-- | Application configuration. +data Configuration = Configuration + { cRunMode :: !RunMode -- ^ mode of the @run@ command + , cSourcePaths :: ![FilePath] -- ^ paths to source code files + , cTemplatePaths :: ![FilePath] -- ^ paths to template files + , cVariables :: !(HashMap Text Text) -- ^ variable values for templates + , cLicenseHeaders :: !HeadersConfig -- ^ configuration of license headers + } + deriving (Eq, Show) -instance FromJSON RunMode where - parseJSON (String s) = case T.toLower s of - "add" -> pure Add - "drop" -> pure Drop - "replace" -> pure Replace - _ -> error $ "Unknown run mode: " <> T.unpack s - parseJSON other = error $ "Invalid value for run mode: " <> show other +-- | Configuration for specific license header. +data HeaderConfig = HeaderConfig + { hcFileExtensions :: ![Text] -- ^ list of file extensions (without dot) + , hcMarginAfter :: !Int -- ^ number of empty lines to put after header + , hcMarginBefore :: !Int -- ^ number of empty lines to put before header + , hcPutAfter :: ![Text] -- ^ /regexp/ patterns after which to put the header + , hcPutBefore :: ![Text] -- ^ /regexp/ patterns before which to put the header + , hcHeaderSyntax :: !HeaderSyntax -- ^ syntax of the license header comment + } + deriving (Eq, Show) -instance ToJSON RunMode where - toJSON = \case - Add -> "add" - Drop -> "drop" - Replace -> "replace" +-- | Group of 'HeaderConfig' configurations for supported file types. +data HeadersConfig = HeadersConfig + { hscC :: !HeaderConfig -- ^ configuration for /C/ programming language + , hscCpp :: !HeaderConfig -- ^ configuration for /C++/ programming language + , hscCss :: !HeaderConfig -- ^ configuration for /CSS/ + , hscHaskell :: !HeaderConfig -- ^ configuration for /Haskell/ programming language + , hscHtml :: !HeaderConfig -- ^ configuration for /HTML/ + , hscJava :: !HeaderConfig -- ^ configuration for /Java/ programming language + , hscJs :: !HeaderConfig -- ^ configuration for /JavaScript/ programming language + , hscRust :: !HeaderConfig -- ^ configuration for /Rust/ programming language + , hscScala :: !HeaderConfig -- ^ configuration for /Scala/ programming language + , hscShell :: !HeaderConfig -- ^ configuration for /Shell/ + } + deriving (Eq, Show) + +-------------------------------------------------------------------------------- + +-- | Internal representation of block comment style of 'HeaderSyntax'. +data BlockComment' = BlockComment' + { bcStartsWith :: !Text -- ^ starting pattern (e.g. @/*@) + , bcEndsWith :: !Text -- ^ ending pattern (e.g. @*/@) + } + deriving (Eq, Generic, Show) + +-- | Internal representation of the line style of 'HeaderSyntax'. +newtype LineComment' = LineComment' + { lcPrefixedBy :: Text -- ^ prefix of the comment line (e.g. @//@) + } + deriving (Eq, Generic, Show) + +-- | Partial (possibly incomplete) version of 'Configuration'. +data PartialConfiguration = PartialConfiguration + { pcRunMode :: !(Last RunMode) -- ^ mode of the @run@ command + , pcSourcePaths :: !(Last [FilePath]) -- ^ paths to source code files + , pcTemplatePaths :: !(Last [FilePath]) -- ^ paths to template files + , pcVariables :: !(Last (HashMap Text Text)) -- ^ variable values for templates + , pcLicenseHeaders :: !PartialHeadersConfig -- ^ configuration of license headers + } + deriving (Eq, Generic, Show) + +-- | Partial (possibly incomplete) version of 'HeaderConfig'. +data PartialHeaderConfig = PartialHeaderConfig + { phcFileExtensions :: !(Last [Text]) -- ^ list of file extensions (without dot) + , phcMarginAfter :: !(Last Int) -- ^ number of empty lines to put after header + , phcMarginBefore :: !(Last Int) -- ^ number of empty lines to put before header + , phcPutAfter :: !(Last [Text]) -- ^ /regexp/ patterns after which to put the header + , phcPutBefore :: !(Last [Text]) -- ^ /regexp/ patterns before which to put the header + , phcHeaderSyntax :: !(Last HeaderSyntax) -- ^ syntax of the license header comment + } + deriving (Eq, Generic, Show) + +-- | Partial (possibly incomplete) version of 'HeadersConfig'. +data PartialHeadersConfig = PartialHeadersConfig + { phscC :: !PartialHeaderConfig -- ^ configuration for /C/ programming language + , phscCpp :: !PartialHeaderConfig -- ^ configuration for /C++/ programming language + , phscCss :: !PartialHeaderConfig -- ^ configuration for /CSS/ + , phscHaskell :: !PartialHeaderConfig -- ^ configuration for /Haskell/ programming language + , phscHtml :: !PartialHeaderConfig -- ^ configuration for /HTML/ + , phscJava :: !PartialHeaderConfig -- ^ configuration for /Java/ programming language + , phscJs :: !PartialHeaderConfig -- ^ configuration for /JavaScript/ programming language + , phscRust :: !PartialHeaderConfig -- ^ configuration for /Rust/ programming language + , phscScala :: !PartialHeaderConfig -- ^ configuration for /Scala/ programming language + , phscShell :: !PartialHeaderConfig -- ^ configuration for /Shell/ + } + deriving (Eq, Generic, Show) + +instance FromJSON BlockComment' where + parseJSON = genericParseJSON aesonOptions + +instance FromJSON LineComment' where + parseJSON = genericParseJSON aesonOptions + +instance FromJSON PartialConfiguration where + parseJSON = withObject "PartialConfiguration" $ \obj -> do + pcRunMode <- Last <$> obj .:? "run-mode" + pcSourcePaths <- Last <$> obj .:? "source-paths" + pcTemplatePaths <- Last <$> obj .:? "template-paths" + pcVariables <- Last <$> obj .:? "variables" + pcLicenseHeaders <- obj .:? "license-headers" .!= mempty + pure PartialConfiguration { .. } + +instance FromJSON PartialHeaderConfig where + parseJSON = withObject "PartialHeaderConfig" $ \obj -> do + phcFileExtensions <- Last <$> obj .:? "file-extensions" + phcMarginAfter <- Last <$> obj .:? "margin-after" + phcMarginBefore <- Last <$> obj .:? "margin-before" + phcPutAfter <- Last <$> obj .:? "put-after" + phcPutBefore <- Last <$> obj .:? "put-before" + blockComment <- obj .:? "block-comment" + lineComment <- obj .:? "line-comment" + let phcHeaderSyntax = Last $ headerSyntax blockComment lineComment + pure PartialHeaderConfig { .. } + 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 error' + error' = ConfigurationError MixedHeaderSyntax + +instance FromJSON PartialHeadersConfig where + parseJSON = withObject "PartialHeadersConfig" $ \obj -> do + phscC <- obj .:? "c" .!= mempty + phscCpp <- obj .:? "cpp" .!= mempty + phscCss <- obj .:? "css" .!= mempty + phscHaskell <- obj .:? "haskell" .!= mempty + phscHtml <- obj .:? "html" .!= mempty + phscJava <- obj .:? "java" .!= mempty + phscJs <- obj .:? "js" .!= mempty + phscRust <- obj .:? "rust" .!= mempty + phscScala <- obj .:? "scala" .!= mempty + phscShell <- obj .:? "shell" .!= mempty + pure PartialHeadersConfig { .. } + +instance Semigroup PartialConfiguration where + x <> y = PartialConfiguration + { pcRunMode = pcRunMode x <> pcRunMode y + , pcSourcePaths = pcSourcePaths x <> pcSourcePaths y + , pcTemplatePaths = pcTemplatePaths x <> pcTemplatePaths y + , pcVariables = pcVariables x <> pcVariables y + , pcLicenseHeaders = pcLicenseHeaders x <> pcLicenseHeaders y + } + +instance Semigroup PartialHeaderConfig where + x <> y = PartialHeaderConfig + { phcFileExtensions = phcFileExtensions x <> phcFileExtensions y + , phcMarginAfter = phcMarginAfter x <> phcMarginAfter y + , phcMarginBefore = phcMarginBefore x <> phcMarginBefore y + , phcPutAfter = phcPutAfter x <> phcPutAfter y + , phcPutBefore = phcPutBefore x <> phcPutBefore y + , phcHeaderSyntax = phcHeaderSyntax x <> phcHeaderSyntax y + } + +instance Semigroup PartialHeadersConfig where + x <> y = PartialHeadersConfig { phscC = phscC x <> phscC y + , phscCpp = phscCpp x <> phscCpp y + , phscCss = phscCss x <> phscCss y + , phscHaskell = phscHaskell x <> phscHaskell y + , phscHtml = phscHtml x <> phscHtml y + , phscJava = phscJava x <> phscJava y + , phscJs = phscJs x <> phscJs y + , phscRust = phscRust x <> phscRust y + , phscScala = phscScala x <> phscScala y + , phscShell = phscShell x <> phscShell y + } + +instance Monoid PartialConfiguration where + mempty = PartialConfiguration mempty mempty mempty mempty mempty + +instance Monoid PartialHeaderConfig where + mempty = PartialHeaderConfig mempty mempty mempty mempty mempty mempty + +instance Monoid PartialHeadersConfig where + mempty = PartialHeadersConfig mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + +-------------------------------------------------------------------------------- + +commandGenError :: CommandGenError -> Text +commandGenError = \case + NoGenModeSelected -> noGenModeSelected + where + noGenModeSelected = mconcat + [ "Please select at least one option what to generate " + , "(see --help for details)" + ] + +commandInitError :: CommandInitError -> Text +commandInitError = \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" + +configurationError :: ConfigurationError -> Text +configurationError = \case + InvalidVariable input -> invalidVariable input + MixedHeaderSyntax -> mixedHeaderSyntax + NoFileExtensions fileType -> noProp "file-extensions" fileType + NoHeaderSyntax fileType -> noProp "block-comment/line-comment" fileType + NoMarginAfter fileType -> noProp "margin-after" fileType + NoMarginBefore fileType -> noProp "margin-before" fileType + NoPutAfter fileType -> noProp "put-after" fileType + NoPutBefore fileType -> noProp "put-before" fileType + NoRunMode -> noFlag "run-mode" + NoSourcePaths -> noFlag "source-paths" + NoTemplatePaths -> noFlag "template-paths" + NoVariables -> noFlag "variables" + where + invalidVariable = ("Cannot parse variable key=value from: " <>) + noProp prop fileType = T.pack $ mconcat + ["Missing '", prop, "' configuration key for file type", show fileType] + noFlag flag = mconcat ["Missing configuration key: ", flag] + 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." + ] + +templateError :: TemplateError -> Text +templateError = \case + MissingVariables name variables -> missingVariables name variables + ParseError msg -> parseError msg + where + missingVariables name variables = mconcat + ["Missing variables for template '", name, "': ", T.pack $ show variables] + parseError msg = "Error parsing template: " <> msg diff --git a/src/Headroom/Types/EnumExtra.hs b/src/Headroom/Types/EnumExtra.hs new file mode 100644 --- /dev/null +++ b/src/Headroom/Types/EnumExtra.hs @@ -0,0 +1,71 @@ +{-| +Module : Headroom.Types.EnumExtra +Description : Extra functionality for enum types +Copyright : (c) 2019-2020 Vaclav Svejcar +License : BSD-3 +Maintainer : vaclav.svejcar@gmail.com +Stability : experimental +Portability : POSIX + +Provides extended functionality for enum-like types, e.g. reading/writing +from/to textual representation, etc. +-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Headroom.Types.EnumExtra where + +import RIO +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 +-- @DeriveAnyClass@ extension. +class (Bounded a, Enum a, Eq a, Ord a, Show a) => EnumExtra a where + + + -- | Returns list of all enum values. + -- + -- >>> :set -XDeriveAnyClass -XTypeApplications + -- >>> data Test = Foo | Bar deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) + -- >>> allValues @Test + -- [Foo,Bar] + allValues :: [a] + allValues = [minBound ..] + + + -- | Returns all values of enum as single string, individual values separated + -- with comma. + -- + -- >>> :set -XDeriveAnyClass -XTypeApplications + -- >>> data Test = Foo | Bar deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) + -- >>> allValuesToText @Test + -- "Foo, Bar" + allValuesToText :: Text + allValuesToText = T.intercalate ", " (fmap enumToText (allValues :: [a])) + + + -- | Returns textual representation of enum value. Opposite to 'textToEnum'. + -- + -- >>> :set -XDeriveAnyClass + -- >>> data Test = Foo | Bar deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) + -- >>> enumToText Bar + -- "Bar" + enumToText :: a -> Text + enumToText = T.pack . show + + + -- | Returns enum value from its textual representation. + -- Opposite to 'enumToText'. + -- + -- >>> :set -XDeriveAnyClass + -- >>> data Test = Foo | Bar deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) + -- >>> (textToEnum "Foo") :: (Maybe Test) + -- Just Foo + textToEnum :: Text -> Maybe a + textToEnum text = + let enumValue v = (T.toLower . enumToText $ v) == T.toLower text + in L.find enumValue allValues diff --git a/src/Headroom/Types/Utils.hs b/src/Headroom/Types/Utils.hs deleted file mode 100644 --- a/src/Headroom/Types/Utils.hs +++ /dev/null @@ -1,70 +0,0 @@ -{-| -Module : Headroom.Types.Utils -Description : tilities related to data types -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -Utilities related to data types. --} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NoImplicitPrelude #-} -module Headroom.Types.Utils - ( allValues - , customOptions - , dropFieldPrefix - , readEnumCI - , symbolCase - ) -where - -import Data.Aeson ( Options - , defaultOptions - , fieldLabelModifier - ) -import RIO -import qualified RIO.Char as C -import qualified RIO.List as L -import Text.Read ( ReadS ) - - --- | Returns all values of enum. -allValues :: (Bounded a, Enum a) => [a] -allValues = [minBound ..] - --- | Custom /Aeson/ options. -customOptions :: Options -customOptions = - defaultOptions { fieldLabelModifier = symbolCase '-' . dropFieldPrefix } - --- | Drops prefix from camel-case text. --- --- >>> dropFieldPrefix "xxHelloWorld" --- "helloWorld" -dropFieldPrefix :: String -> String -dropFieldPrefix = \case - (x : n : xs) | C.isUpper x && C.isUpper n -> x : n : xs - (x : n : xs) | C.isUpper x -> C.toLower x : n : xs - (_ : xs) -> dropFieldPrefix xs - [] -> [] - --- | Parses enum value from its string representation. -readEnumCI :: (Bounded a, Enum a, Show a) => ReadS a -readEnumCI str = - let textRepr = fmap C.toLower . show - result = L.find (\item -> textRepr item == fmap C.toLower str) allValues - in maybe [] (\item -> [(item, "")]) result - --- | Transforms camel-case text into text cased with given symbol. --- --- >>> symbolCase '-' "fooBar" --- "foo-bar" -symbolCase :: Char -- ^ word separator symbol - -> String -- ^ input text - -> String -- ^ processed text -symbolCase sym = \case - [] -> [] - (x : xs) | C.isUpper x -> sym : C.toLower x : symbolCase sym xs - | otherwise -> x : symbolCase sym xs diff --git a/src/Headroom/UI.hs b/src/Headroom/UI.hs new file mode 100644 --- /dev/null +++ b/src/Headroom/UI.hs @@ -0,0 +1,18 @@ +{-| +Module : Headroom.UI +Description : UI Components +Copyright : (c) 2019-2020 Vaclav Svejcar +License : BSD-3 +Maintainer : vaclav.svejcar@gmail.com +Stability : experimental +Portability : POSIX + +Various UI components. +-} +{-# LANGUAGE NoImplicitPrelude #-} +module Headroom.UI + ( module Headroom.UI.Progress + ) +where + +import Headroom.UI.Progress diff --git a/src/Headroom/UI/Progress.hs b/src/Headroom/UI/Progress.hs --- a/src/Headroom/UI/Progress.hs +++ b/src/Headroom/UI/Progress.hs @@ -1,13 +1,13 @@ {-| Module : Headroom.UI.Progress -Description : Console UI component for progress indication +Description : UI component for displaying progress Copyright : (c) 2019-2020 Vaclav Svejcar License : BSD-3 Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX -UI component that allows to display progress in console line interface. +This component displays progress in format @[CURR of TOTAL]@. -} {-# LANGUAGE NoImplicitPrelude #-} module Headroom.UI.Progress @@ -24,9 +24,10 @@ -- | Progress indication. First argument is current progress, second the maximum -- value. -data Progress = Progress Int Int +data Progress = Progress !Int !Int deriving (Eq, Show) + instance Display Progress where textDisplay (Progress current total) = T.pack $ mconcat ["[", currentS, " of ", totalS, "]"] @@ -35,11 +36,13 @@ currentS = printf format current totalS = show total + -- | Zips given list with the progress info. -- -- >>> zipWithProgress ["a", "b"] -- [(Progress 1 2,"a"),(Progress 2 2,"b")] -zipWithProgress :: [a] -> [(Progress, a)] +zipWithProgress :: [a] -- ^ list to zip with progress + -> [(Progress, a)] -- ^ zipped result zipWithProgress list = zip progresses list where listLength = L.length list diff --git a/test-data/code-samples/c/sample1.c b/test-data/code-samples/c/sample1.c new file mode 100644 --- /dev/null +++ b/test-data/code-samples/c/sample1.c @@ -0,0 +1,12 @@ + +/* + * This is header + */ + +#include +/* This is not header */ +int main() { + // printf() displays the string inside quotation + printf("Hello, World!"); + return 0; +} diff --git a/test-data/code-samples/c/sample2.c b/test-data/code-samples/c/sample2.c new file mode 100644 --- /dev/null +++ b/test-data/code-samples/c/sample2.c @@ -0,0 +1,8 @@ + +#include +/* This is not header */ +int main() { + // printf() displays the string inside quotation + printf("Hello, World!"); + return 0; +} diff --git a/test-data/code-samples/cpp/sample1.cpp b/test-data/code-samples/cpp/sample1.cpp new file mode 100644 --- /dev/null +++ b/test-data/code-samples/cpp/sample1.cpp @@ -0,0 +1,13 @@ + +/* + * This is header + */ + +#include + +/* This is not header */ + +int main() { + std::cout << "Hello World!"; + return 0; +} diff --git a/test-data/code-samples/cpp/sample2.cpp b/test-data/code-samples/cpp/sample2.cpp new file mode 100644 --- /dev/null +++ b/test-data/code-samples/cpp/sample2.cpp @@ -0,0 +1,10 @@ + + +#include + +/* This is not header */ + +int main() { + std::cout << "Hello World!"; + return 0; +} diff --git a/test-data/code-samples/css/sample1.css b/test-data/code-samples/css/sample1.css --- a/test-data/code-samples/css/sample1.css +++ b/test-data/code-samples/css/sample1.css @@ -1,19 +1,12 @@ + /* - * Copyright AUTHOR - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. + * This is + * the header */ body { - background: white; + /* This is not header */ + color: black } + +/* This is not header */ diff --git a/test-data/code-samples/css/sample2.css b/test-data/code-samples/css/sample2.css --- a/test-data/code-samples/css/sample2.css +++ b/test-data/code-samples/css/sample2.css @@ -1,6 +1,6 @@ - - body { - background: white; - } - + /* This is not header */ + color: black +} + +/* This is not header */ diff --git a/test-data/code-samples/css/sample3.css b/test-data/code-samples/css/sample3.css deleted file mode 100644 --- a/test-data/code-samples/css/sample3.css +++ /dev/null @@ -1,4 +0,0 @@ -body { - background: white; - } - diff --git a/test-data/code-samples/haskell/replaced-simple.hs b/test-data/code-samples/haskell/replaced-simple.hs deleted file mode 100644 --- a/test-data/code-samples/haskell/replaced-simple.hs +++ /dev/null @@ -1,6 +0,0 @@ --- This is header -{-# LANGUAGE OverloadedStrings #-} -module Test where - -foo :: String -foo = "Hello, world!" diff --git a/test-data/code-samples/haskell/sample1.hs b/test-data/code-samples/haskell/sample1.hs new file mode 100644 --- /dev/null +++ b/test-data/code-samples/haskell/sample1.hs @@ -0,0 +1,15 @@ + +{-| +This is header +-} + +{-# LANGUAGE OverloadedStrings #-} +module Test where + +{-| +This is not header +-} + +foo :: String +foo = "Hello, World!" +{-# INLINE key_function #-} diff --git a/test-data/code-samples/haskell/sample2.hs b/test-data/code-samples/haskell/sample2.hs new file mode 100644 --- /dev/null +++ b/test-data/code-samples/haskell/sample2.hs @@ -0,0 +1,11 @@ + +{-# LANGUAGE OverloadedStrings #-} +module Test where + +{-| +This is not header +-} + +foo :: String +foo = "Hello, World!" +{-# INLINE key_function #-} diff --git a/test-data/code-samples/haskell/stripped.hs b/test-data/code-samples/haskell/stripped.hs deleted file mode 100644 --- a/test-data/code-samples/haskell/stripped.hs +++ /dev/null @@ -1,5 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Test where - -foo :: String -foo = "Hello, world!" diff --git a/test-data/code-samples/html/sample1.html b/test-data/code-samples/html/sample1.html new file mode 100644 --- /dev/null +++ b/test-data/code-samples/html/sample1.html @@ -0,0 +1,16 @@ + + + + + + + + Test title + + + Hello, World! + + diff --git a/test-data/code-samples/html/sample2.html b/test-data/code-samples/html/sample2.html new file mode 100644 --- /dev/null +++ b/test-data/code-samples/html/sample2.html @@ -0,0 +1,12 @@ + + + + + + + Test title + + + Hello, World! + + diff --git a/test-data/code-samples/html/with-doctype.html b/test-data/code-samples/html/with-doctype.html deleted file mode 100644 --- a/test-data/code-samples/html/with-doctype.html +++ /dev/null @@ -1,14 +0,0 @@ - - - - - - Test title - - - Hello, World! - - diff --git a/test-data/code-samples/html/without-doctype.html b/test-data/code-samples/html/without-doctype.html deleted file mode 100644 --- a/test-data/code-samples/html/without-doctype.html +++ /dev/null @@ -1,14 +0,0 @@ - - - - - - Test title - - - Hello, World! - - diff --git a/test-data/code-samples/java/full.java b/test-data/code-samples/java/full.java deleted file mode 100644 --- a/test-data/code-samples/java/full.java +++ /dev/null @@ -1,11 +0,0 @@ -/* - * Some existing header here - */ - -package foo; - -class Hello { - public static void main(String[] args) { - System.out.println("Hello, world!"); - } -} diff --git a/test-data/code-samples/java/sample1.java b/test-data/code-samples/java/sample1.java new file mode 100644 --- /dev/null +++ b/test-data/code-samples/java/sample1.java @@ -0,0 +1,14 @@ +/* + * This is header. + */ + +package foo; + +/* This is not header */ + +class Hello { + /* This is not header */ + public static void main(String[] args) { + System.out.println("Hello, world!"); + } +} diff --git a/test-data/code-samples/java/sample2.java b/test-data/code-samples/java/sample2.java new file mode 100644 --- /dev/null +++ b/test-data/code-samples/java/sample2.java @@ -0,0 +1,12 @@ + + +package foo; + +/* This is not header */ + +class Hello { + /* This is not header */ + public static void main(String[] args) { + System.out.println("Hello, world!"); + } +} diff --git a/test-data/code-samples/js/sample1.js b/test-data/code-samples/js/sample1.js --- a/test-data/code-samples/js/sample1.js +++ b/test-data/code-samples/js/sample1.js @@ -1,19 +1,8 @@ /* - * Copyright AUTHOR - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. + * This is header */ function answer() { + /* This is not header */ return 42; } diff --git a/test-data/code-samples/js/sample2.js b/test-data/code-samples/js/sample2.js --- a/test-data/code-samples/js/sample2.js +++ b/test-data/code-samples/js/sample2.js @@ -1,6 +1,6 @@ function answer() { + /* This is not header */ return 42; } - diff --git a/test-data/code-samples/js/sample3.js b/test-data/code-samples/js/sample3.js deleted file mode 100644 --- a/test-data/code-samples/js/sample3.js +++ /dev/null @@ -1,3 +0,0 @@ -function answer() { - return 42; -} diff --git a/test-data/code-samples/rust/sample1.rs b/test-data/code-samples/rust/sample1.rs new file mode 100644 --- /dev/null +++ b/test-data/code-samples/rust/sample1.rs @@ -0,0 +1,8 @@ +/* + * This is header + */ + + fn main() { + /* This is not header */ + println!("Hello World!"); +} diff --git a/test-data/code-samples/scala/full.scala b/test-data/code-samples/scala/full.scala deleted file mode 100644 --- a/test-data/code-samples/scala/full.scala +++ /dev/null @@ -1,9 +0,0 @@ -/* - * Some existing header here - */ - -package foo - -object Hello extends App { - println("Hello, world!") -} diff --git a/test-data/code-samples/scala/sample1.scala b/test-data/code-samples/scala/sample1.scala new file mode 100644 --- /dev/null +++ b/test-data/code-samples/scala/sample1.scala @@ -0,0 +1,11 @@ +/* + * This is header + */ + +package foo + +/* This is not header */ + +object Hello extends App { + println("Hello, world!") +} diff --git a/test-data/code-samples/scala/sample2.scala b/test-data/code-samples/scala/sample2.scala new file mode 100644 --- /dev/null +++ b/test-data/code-samples/scala/sample2.scala @@ -0,0 +1,8 @@ + +package foo + +/* This is not header */ + +object Hello extends App { + println("Hello, world!") +} diff --git a/test-data/code-samples/shell/sample1.sh b/test-data/code-samples/shell/sample1.sh new file mode 100644 --- /dev/null +++ b/test-data/code-samples/shell/sample1.sh @@ -0,0 +1,8 @@ +#!/bin/bash + +# This is +# header + +# This is not + +echo "TEST" diff --git a/test/Headroom/AppConfigSpec.hs b/test/Headroom/AppConfigSpec.hs deleted file mode 100644 --- a/test/Headroom/AppConfigSpec.hs +++ /dev/null @@ -1,73 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Headroom.AppConfigSpec - ( spec - ) -where - -import Headroom.AppConfig -import Headroom.Types ( AppConfigError(..) - , HeadroomError(..) - , RunMode(..) - ) -import RIO -import qualified RIO.HashMap as HM -import Test.Hspec -import Test.Utils ( matchesException ) - - -spec :: Spec -spec = do - describe "loadAppConfig" $ do - it "loads full configuration from YAML file" $ do - appConfig <- loadAppConfig "test-data/configs/full.yaml" - let options = HM.fromList - [ ("copyright", "(c) 2019 John Smith") - , ("email" , "john.smith@example.com") - ] - sourcePaths = ["test-data/configs/path/to/src"] - templatePaths = - ["test-data/configs/path/to/dir1", "test-data/configs/path/to/dir2"] - expected = AppConfig Add sourcePaths templatePaths options - appConfig `shouldBe` expected - - describe "parseVariables" $ do - it "parses variables map from raw string list" $ do - let raw = ["key1=value1", "key2=value with spaces"] - expected = - HM.fromList [("key1", "value1"), ("key2", "value with spaces")] - parseVariables raw `shouldBe` Just expected - - let ph1 = HM.fromList [("key1", "value1")] - ph2 = HM.fromList [("key2", "value2")] - appConfig1 = AppConfig Replace ["source1"] [] ph1 - appConfig2 = AppConfig Add ["source2"] ["template1"] ph2 - appConfig3 = AppConfig Add [] ["template1"] ph2 - expected' = AppConfig - Replace - ["source1", "source2"] - ["template1"] - (HM.fromList [("key1", "value1"), ("key2", "value2")]) - - describe "prettyPrintAppConfig" $ do - it "can pretty print AppConfig" $ do - let result = prettyPrintAppConfig appConfig2 - expected = mconcat - [ "run-mode: add\nsource-paths:\n- source2\n" - , "template-paths:\n- template1\nvariables:\n key2: value2\n" - ] - result `shouldBe` expected - - describe "validateAppConfig" $ do - it "validates configuration version" $ do - let check (Just (InvalidAppConfig [EmptySourcePaths])) = True - check _ = False - validateAppConfig appConfig3 `shouldSatisfy` matchesException check - - describe "<>" $ do - it "joins two AppConfig records" $ do - (appConfig1 <> appConfig2) `shouldBe` expected' - - describe "mconcat" $ do - it "folds a list of AppConfig records" $ do - mconcat [appConfig1, appConfig2] `shouldBe` expected' diff --git a/test/Headroom/Command/InitSpec.hs b/test/Headroom/Command/InitSpec.hs --- a/test/Headroom/Command/InitSpec.hs +++ b/test/Headroom/Command/InitSpec.hs @@ -5,9 +5,10 @@ where import Headroom.Command.Init -import Headroom.Command.Init.Env -import Headroom.FileType ( FileType(HTML) ) -import Headroom.License ( LicenseType(..) ) +import Headroom.Types ( CommandInitOptions(..) + , FileType(HTML) + , LicenseType(..) + ) import RIO import RIO.FilePath ( () ) import qualified RIO.List as L @@ -31,9 +32,10 @@ env = Env { envLogFunc = logFunc, envInitOptions = opts, envPaths = paths } where logFunc = mkLogFunc (\_ _ _ _ -> pure ()) - opts = InitOptions { ioSourcePaths = ["test-data" "test-traverse"] - , ioLicenseType = BSD3 - } + opts = CommandInitOptions + { cioSourcePaths = ["test-data" "test-traverse"] + , cioLicenseType = BSD3 + } paths = Paths { pCurrentDir = "." , pConfigFile = "test-data" "configs" "full.yaml" , pTemplatesDir = "headroom-templates" diff --git a/test/Headroom/Command/ReadersSpec.hs b/test/Headroom/Command/ReadersSpec.hs new file mode 100644 --- /dev/null +++ b/test/Headroom/Command/ReadersSpec.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module Headroom.Command.ReadersSpec + ( spec + ) +where + +import Headroom.Command.Readers +import Headroom.Types ( FileType + , LicenseType + ) +import Headroom.Types.EnumExtra ( EnumExtra(..) ) +import RIO +import qualified RIO.Text as T +import Test.Hspec +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 + + 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) diff --git a/test/Headroom/ConfigurationSpec.hs b/test/Headroom/ConfigurationSpec.hs new file mode 100644 --- /dev/null +++ b/test/Headroom/ConfigurationSpec.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Headroom.ConfigurationSpec + ( spec + ) +where + +import Headroom.Configuration +import Headroom.Embedded ( defaultConfig ) +import RIO +import Test.Hspec + + +spec :: Spec +spec = do + describe "parseConfiguration" $ do + it "should parse default bundled configuration" $ do + parseConfiguration defaultConfig `shouldSatisfy` isJust diff --git a/test/Headroom/FileSupportSpec.hs b/test/Headroom/FileSupportSpec.hs new file mode 100644 --- /dev/null +++ b/test/Headroom/FileSupportSpec.hs @@ -0,0 +1,326 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module Headroom.FileSupportSpec + ( spec + ) +where + +import Headroom.Configuration ( makeHeadersConfig + , parseConfiguration + ) +import Headroom.Embedded ( defaultConfig ) +import Headroom.FileSupport +import Headroom.FileSystem ( loadFile ) +import Headroom.Types ( FileInfo(..) + , FileType(..) + , HeaderConfig(..) + , HeaderSyntax(..) + , HeadersConfig(..) + , PartialConfiguration(..) + ) +import RIO +import RIO.FilePath ( () ) +import qualified RIO.HashMap as HM +import Test.Hspec +import Text.Regex.PCRE.Light ( compile ) +import Text.Regex.PCRE.Light.Char8 ( utf8 ) + + +spec :: Spec +spec = do + let samplesDir = "test-data" "code-samples" + lHeaderConfig pb pa = HeaderConfig ["hs"] 0 0 pb pa (LineComment "--") + bHeaderConfig = bHeaderConfigM 0 0 + bHeaderConfigM mb ma pb pa = + HeaderConfig ["hs"] mb ma pb pa (BlockComment "{-|" "-}") + + describe "addHeader" $ do + let fileInfo config = FileInfo Haskell config Nothing HM.empty + + it "adds header at the beginning of text" $ do + let info = fileInfo $ bHeaderConfig [] [] + header = "HEADER" + sample = "1\n2\nbefore\nafter\n4\n" + expected = "HEADER\n1\n2\nbefore\nafter\n4\n" + addHeader info header sample `shouldBe` expected + + it "adds header at the beginning of text (with correct margins)" $ do + let info = fileInfo $ bHeaderConfigM 2 2 [] [] + header = "HEADER" + sample = "1\n2\nbefore\nafter\n4\n" + expected = "HEADER\n\n\n1\n2\nbefore\nafter\n4\n" + addHeader info header sample `shouldBe` expected + + it "adds header at correct position" $ do + let info = fileInfo $ bHeaderConfig ["^before"] ["^after"] + header = "{-| HEADER -}" + sample = "1\n2\nbefore\nafter\n4\n" + expected = "1\n2\nbefore\n{-| HEADER -}\nafter\n4\n" + addHeader info header sample `shouldBe` expected + + it "adds header at correct position (with correct margins)" $ do + let info = fileInfo $ bHeaderConfigM 2 2 ["^before"] ["^after"] + header = "{-| HEADER -}" + sample = "1\n2\nbefore\nafter\n4\n" + expected = "1\n2\nbefore\n\n\n{-| HEADER -}\n\n\nafter\n4\n" + addHeader info header sample `shouldBe` expected + + it "adds header at the end of text (with correct margins)" $ do + let info = fileInfo $ bHeaderConfigM 2 2 ["^before"] [] + header = "{-| HEADER -}" + sample = "1\n2\nbefore" + expected = "1\n2\nbefore\n\n\n{-| HEADER -}\n" + addHeader info header sample `shouldBe` expected + + it "does nothing if header is already present" $ do + let config = bHeaderConfig ["^before"] [] + header = "{-| HEADER -}" + info = FileInfo Haskell config (Just (3, 3)) HM.empty + sample = "1\n2\nbefore\n{-| OLDHEADER -}\nafter\n4" + addHeader info header sample `shouldBe` sample + + + describe "dropHeader" $ do + it "does nothing if no header is present" $ do + let config = bHeaderConfig [] [] + info = FileInfo Haskell config Nothing HM.empty + sample = "1\n2\nbefore\nafter\n4\n" + dropHeader info sample `shouldBe` sample + + it "drops existing single line header" $ do + let config = bHeaderConfig [] [] + info = FileInfo Haskell config (Just (3, 3)) HM.empty + sample = "1\n2\nbefore\n{-| HEADER -}\nafter\n4\n" + expected = "1\n2\nbefore\nafter\n4\n" + dropHeader info sample `shouldBe` expected + + it "drops existing multi line header" $ do + let config = bHeaderConfig [] [] + info = FileInfo Haskell config (Just (3, 4)) HM.empty + sample = "1\n2\nbefore\n{-| HEADER\nHERE -}\nafter\n4\n" + expected = "1\n2\nbefore\nafter\n4\n" + dropHeader info sample `shouldBe` expected + + + describe "replaceHeader" $ do + it "adds header if there's none present" $ do + let config = bHeaderConfig ["^before"] [] + info = FileInfo Haskell config Nothing HM.empty + header = "{-| NEWHEADER -}" + sample = "1\n2\nbefore\nafter\n4\n" + expected = "1\n2\nbefore\n{-| NEWHEADER -}\nafter\n4\n" + replaceHeader info header sample `shouldBe` expected + + it "replaces header if there's existing one" $ do + let config = bHeaderConfig ["^before"] [] + info = FileInfo Haskell config (Just (3, 4)) HM.empty + header = "{-| NEWHEADER -}" + sample = "1\n2\nbefore\n{-| OLD\nHEADER -}\nafter\n4\n" + expected = "1\n2\nbefore\n{-| NEWHEADER -}\nafter\n4\n" + replaceHeader info header sample `shouldBe` expected + + + describe "extractFileInfo" $ do + it "extracts FileInfo from given raw input" $ do + let config = bHeaderConfig [] [] + expected = FileInfo Haskell config (Just (1, 13)) HM.empty + sample <- readFileUtf8 $ samplesDir "haskell" "full.hs" + extractFileInfo Haskell config sample `shouldBe` expected + + + describe "findHeader" $ do + it "finds block header (one line long)" $ do + let sample = "\n{-| single line -}\n\n" + config = bHeaderConfig [] [] + findHeader config sample `shouldBe` Just (1, 1) + + it "finds line header (one line long)" $ do + let sample = "\n-- single line\n\n" + config = lHeaderConfig [] [] + findHeader config sample `shouldBe` Just (1, 1) + + it "finds block comment header put after 'putAfter' constraint" $ do + let sample = "{-| 1 -}\nfoo\n{-| 2\n2 -}\nbar\n{-| 3\n3 -}" + config = bHeaderConfig ["^foo"] [] + findHeader config sample `shouldBe` Just (2, 3) + + it "finds line comment header put after 'putAfter' constraint" $ do + let sample = "-- 1\nfoo\n-- 2\n-- 2\nbar\n-- 3\n-- 3" + config = lHeaderConfig ["^foo"] [] + findHeader config sample `shouldBe` Just (2, 3) + + it "finds block comment header put after composed constraint" $ do + let sample = "{-| 1 -}\nfoo\n{-| 2\n2 -}\nbar\n{-| 3\n3 -}" + config = bHeaderConfig ["^bar", "^foo"] [] + findHeader config sample `shouldBe` Just (5, 6) + + it "finds line comment header put after composed constraint" $ do + let sample = "-- 1\nfoo\n-- 2\n-- 2\nbar\n-- 3\n-- 3" + config = lHeaderConfig ["^bar", "^foo"] [] + findHeader config sample `shouldBe` Just (5, 6) + + it "finds nothing if no header present" $ do + let sample = "some\nrandom\text without header" + config = bHeaderConfig [] [] + findHeader config sample `shouldBe` Nothing + + it "finds nothing if header is present before 'putAfter' constraint" $ do + let sample = "foo\n{-| 1 -}\nbar\nsome text" + config = bHeaderConfig ["^bar"] [] + findHeader config sample `shouldBe` Nothing + + it "correctly detects headers using default YAML configuration" $ do + let path = "test-data" "code-samples" + defaultConfig' <- parseConfiguration defaultConfig + HeadersConfig {..} <- makeHeadersConfig (pcLicenseHeaders defaultConfig') + sampleC1 <- loadFile $ path "c" "sample1.c" + sampleC2 <- loadFile $ path "c" "sample2.c" + sampleCpp1 <- loadFile $ path "cpp" "sample1.cpp" + sampleCpp2 <- loadFile $ path "cpp" "sample2.cpp" + sampleCss1 <- loadFile $ path "css" "sample1.css" + sampleCss2 <- loadFile $ path "css" "sample2.css" + sampleHs1 <- loadFile $ path "haskell" "sample1.hs" + sampleHs2 <- loadFile $ path "haskell" "sample2.hs" + sampleHtml1 <- loadFile $ path "html" "sample1.html" + sampleHtml2 <- loadFile $ path "html" "sample2.html" + sampleJava1 <- loadFile $ path "java" "sample1.java" + sampleJava2 <- loadFile $ path "java" "sample2.java" + sampleJs1 <- loadFile $ path "js" "sample1.js" + sampleRust1 <- loadFile $ path "rust" "sample1.rs" + sampleScala1 <- loadFile $ path "scala" "sample1.scala" + sampleScala2 <- loadFile $ path "scala" "sample2.scala" + sampleShell1 <- loadFile $ path "shell" "sample1.sh" + findHeader hscC sampleC1 `shouldBe` Just (1, 3) + findHeader hscC sampleC2 `shouldBe` Nothing + findHeader hscCpp sampleCpp1 `shouldBe` Just (1, 3) + findHeader hscCpp sampleCpp2 `shouldBe` Nothing + findHeader hscCss sampleCss1 `shouldBe` Just (1, 4) + findHeader hscCss sampleCss2 `shouldBe` Nothing + findHeader hscHaskell sampleHs1 `shouldBe` Just (1, 3) + findHeader hscHaskell sampleHs2 `shouldBe` Nothing + findHeader hscHtml sampleHtml1 `shouldBe` Just (1, 4) + findHeader hscHtml sampleHtml2 `shouldBe` Nothing + findHeader hscJava sampleJava1 `shouldBe` Just (0, 2) + findHeader hscJava sampleJava2 `shouldBe` Nothing + findHeader hscJs sampleJs1 `shouldBe` Just (0, 2) + findHeader hscRust sampleRust1 `shouldBe` Just (0, 2) + findHeader hscScala sampleScala1 `shouldBe` Just (0, 2) + findHeader hscScala sampleScala2 `shouldBe` Nothing + findHeader hscShell sampleShell1 `shouldBe` Just (2, 3) + + + describe "findBlockHeader" $ do + it "finds single line header" $ do + let sample = ["", "{-| single line -}", "", ""] + findBlockHeader "{-|" "-}" sample 0 `shouldBe` Just (1, 1) + + it "finds multi line header" $ do + let sample = ["", "{-| multi", "line -}", "", ""] + findBlockHeader "{-|" "-}" sample 0 `shouldBe` Just (1, 2) + + it "finds only the first occurence of header" $ do + let sample = ["{-| this", "and this -}", "", "{-| no this -}"] + findBlockHeader "{-|" "-}" sample 0 `shouldBe` Just (0, 1) + + it "finds nothing if no header is present" $ do + let sample = ["foo", "bar"] + findBlockHeader "{-|" "-}" sample 0 `shouldBe` Nothing + + + describe "findLineHeader" $ do + it "finds single line header" $ do + let sample = ["-- foo", ""] + findLineHeader "--" sample 0 `shouldBe` Just (0, 0) + + it "finds single line header with nothing surrounding it" $ do + let sample = ["-- foo"] + findLineHeader "--" sample 0 `shouldBe` Just (0, 0) + + it "finds multi line header with nothing surrounding it" $ do + let sample = ["-- 3", "-- 3"] + findLineHeader "--" sample 0 `shouldBe` Just (0, 1) + + it "finds multi line header" $ do + let sample = ["", "a", "-- first", "--second", "foo"] + findLineHeader "--" sample 0 `shouldBe` Just (2, 3) + + it "finds only the first occurence of header" $ do + let sample = ["a", "-- this one", "-- and this", "", "-- not this"] + findLineHeader "--" sample 0 `shouldBe` Just (1, 2) + + it "finds nothing if no header is present" $ do + let sample = ["foo", "bar"] + findLineHeader "--" sample 0 `shouldBe` Nothing + + + describe "lastMatching" $ do + let regex = compile "^foo" [utf8] + + it "finds very last line that matches given regex" $ do + let sample = ["some text", "hello", "foo bar", "foo baz", "last one"] + lastMatching regex sample `shouldBe` Just 3 + + it "returns Nothing if no matching input found" $ do + let sample = ["some text", "hello", "last one"] + lastMatching regex sample `shouldBe` Nothing + + it "returns Nothing the input is empty" $ do + lastMatching regex [] `shouldBe` Nothing + + + describe "firstMatching" $ do + let regex = compile "^foo" [utf8] + + it "finds very first line that matches given regex" $ do + let sample = ["some text", "hello", "foo bar", "foo baz", "last one"] + firstMatching regex sample `shouldBe` Just 2 + + it "returns Nothing if the input is empty" $ do + firstMatching regex [] `shouldBe` Nothing + + + describe "splitInput" $ do + let sample = "text\n->\nRESULT\n<-\nfoo" + fstSplit = ["->"] + sndSplit = ["<-"] + + it "handles empty input and conditions" $ do + splitInput [] [] "" `shouldBe` ([], [], []) + + it "handles input and empty conditions" $ do + splitInput [] [] "one\ntwo" `shouldBe` ([], ["one", "two"], []) + + it "splits input with 1st split condition" $ do + let expected = (["text", "->"], ["RESULT", "<-", "foo"], []) + splitInput fstSplit [] sample `shouldBe` expected + + it "splits input with 2nd split condition" $ do + let expected = ([], ["text", "->", "RESULT"], ["<-", "foo"]) + splitInput [] sndSplit sample `shouldBe` expected + + it "splits input with both conditions" $ do + let expected = (["text", "->"], ["RESULT"], ["<-", "foo"]) + splitInput fstSplit sndSplit sample `shouldBe` expected + + it "splits input when nothing matches the 1st split condition" $ do + let expected = ([], ["text", "RESULT", "<-", "foo"], []) + splitInput fstSplit [] "text\nRESULT\n<-\nfoo" `shouldBe` expected + + it "splits input when nothing matches the 2nd split condition" $ do + let expected = ([], ["text", "->", "RESULT", "foo"], []) + splitInput [] sndSplit "text\n->\nRESULT\nfoo" `shouldBe` expected + + it "splits input when nothing matches both conditions" $ do + let expected = ([], ["text", "RESULT", "foo"], []) + splitInput fstSplit sndSplit "text\nRESULT\nfoo" `shouldBe` expected + + it "handles case when 2nd split is found before 1st split" $ do + let expected = ([], ["text"], ["->", "RESULT", "<-", "foo"]) + splitInput sndSplit fstSplit sample `shouldBe` expected + + it "handles case when 1st split is also after 2nd split" $ do + let expected = (["foo", "->"], ["RESULT"], ["<-", "bar", "->", "end"]) + sample' = "foo\n->\nRESULT\n<-\nbar\n->\nend" + splitInput fstSplit sndSplit sample' `shouldBe` expected + diff --git a/test/Headroom/FileTypeSpec.hs b/test/Headroom/FileTypeSpec.hs --- a/test/Headroom/FileTypeSpec.hs +++ b/test/Headroom/FileTypeSpec.hs @@ -5,7 +5,14 @@ ) where +import Headroom.Configuration ( makeHeadersConfig + , parseConfiguration + ) +import Headroom.Embedded ( defaultConfig ) import Headroom.FileType +import Headroom.Types ( FileType(..) + , PartialConfiguration(..) + ) import RIO import Test.Hspec @@ -14,10 +21,6 @@ spec = do describe "fileTypeByExt" $ do it "parses FileType from file extension" $ do - fileTypeByExt "hs" `shouldBe` Just Haskell - - describe "fileTypeByName" $ do - it "reads FileType from string representation" $ do - let actual = fileTypeByName "haskell" - expected = Just Haskell - actual `shouldBe` expected + pHeadersConfig <- pcLicenseHeaders <$> parseConfiguration defaultConfig + headersConfig <- makeHeadersConfig pHeadersConfig + fileTypeByExt headersConfig "hs" `shouldBe` Just Haskell diff --git a/test/Headroom/Header/Impl/CSSSpec.hs b/test/Headroom/Header/Impl/CSSSpec.hs deleted file mode 100644 --- a/test/Headroom/Header/Impl/CSSSpec.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Headroom.Header.Impl.CSSSpec - ( spec - ) -where - -import Headroom.Header.Impl.CSS -import RIO -import Test.Hspec - -spec :: Spec -spec = do - describe "headerSizeCSS" $ do - it "detects size of header comment in CSS" $ do - sample1 <- readFileUtf8 "test-data/code-samples/css/sample1.css" - sample2 <- readFileUtf8 "test-data/code-samples/css/sample2.css" - sample3 <- readFileUtf8 "test-data/code-samples/css/sample3.css" - headerSizeCSS sample1 `shouldBe` 16 - headerSizeCSS sample2 `shouldBe` 2 - headerSizeCSS sample3 `shouldBe` 0 - - it "handles empty files" $ do - headerSizeCSS "" `shouldBe` 0 diff --git a/test/Headroom/Header/Impl/HTMLSpec.hs b/test/Headroom/Header/Impl/HTMLSpec.hs deleted file mode 100644 --- a/test/Headroom/Header/Impl/HTMLSpec.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Headroom.Header.Impl.HTMLSpec - ( spec - ) -where - -import Headroom.Header.Impl.HTML -import RIO -import Test.Hspec - - -spec :: Spec -spec = do - describe "headerSizeHTML" $ do - it "detects size of header comment in HTML with DOCTYPE" $ do - source <- readFileUtf8 "test-data/code-samples/html/with-doctype.html" - headerSizeHTML source `shouldBe` 4 - - it "detects size of header comment in HTML without DOCTYPE" $ do - source <- readFileUtf8 "test-data/code-samples/html/without-doctype.html" - headerSizeHTML source `shouldBe` 5 - - it "handles empty files" $ do - headerSizeHTML "" `shouldBe` 0 diff --git a/test/Headroom/Header/Impl/HaskellSpec.hs b/test/Headroom/Header/Impl/HaskellSpec.hs deleted file mode 100644 --- a/test/Headroom/Header/Impl/HaskellSpec.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Headroom.Header.Impl.HaskellSpec - ( spec - ) -where - -import Headroom.Header.Impl.Haskell -import RIO -import Test.Hspec - - -spec :: Spec -spec = do - describe "headerSizeHaskell" $ do - it "detects size of existing module header" $ do - source <- readFileUtf8 "test-data/code-samples/haskell/full.hs" - headerSizeHaskell source `shouldBe` 15 - - it "handles empty files" $ do - headerSizeHaskell "" `shouldBe` 0 diff --git a/test/Headroom/Header/Impl/JSSpec.hs b/test/Headroom/Header/Impl/JSSpec.hs deleted file mode 100644 --- a/test/Headroom/Header/Impl/JSSpec.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Headroom.Header.Impl.JSSpec - ( spec - ) -where - -import Headroom.Header.Impl.JS -import RIO -import Test.Hspec - -spec :: Spec -spec = do - describe "headerSizeJS" $ do - it "detects size of header comment in JS" $ do - sample1 <- readFileUtf8 "test-data/code-samples/css/sample1.css" - sample2 <- readFileUtf8 "test-data/code-samples/css/sample2.css" - sample3 <- readFileUtf8 "test-data/code-samples/css/sample3.css" - headerSizeJS sample1 `shouldBe` 16 - headerSizeJS sample2 `shouldBe` 2 - headerSizeJS sample3 `shouldBe` 0 - - it "handles empty files" $ do - headerSizeJS "" `shouldBe` 0 diff --git a/test/Headroom/Header/Impl/JavaSpec.hs b/test/Headroom/Header/Impl/JavaSpec.hs deleted file mode 100644 --- a/test/Headroom/Header/Impl/JavaSpec.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Headroom.Header.Impl.JavaSpec - ( spec - ) -where - -import Headroom.Header.Impl.Java -import RIO -import Test.Hspec - - -spec :: Spec -spec = do - describe "headerSizeJava" $ do - it "detects size of existing license header" $ do - source <- readFileUtf8 "test-data/code-samples/java/full.java" - headerSizeJava source `shouldBe` 4 - - it "handles empty files" $ do - headerSizeJava "" `shouldBe` 0 diff --git a/test/Headroom/Header/Impl/ScalaSpec.hs b/test/Headroom/Header/Impl/ScalaSpec.hs deleted file mode 100644 --- a/test/Headroom/Header/Impl/ScalaSpec.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Headroom.Header.Impl.ScalaSpec - ( spec - ) -where - -import Headroom.Header.Impl.Scala -import RIO -import Test.Hspec - - -spec :: Spec -spec = do - describe "headerSizeScala" $ do - it "detects size of existing license header" $ do - source <- readFileUtf8 "test-data/code-samples/scala/full.scala" - headerSizeScala source `shouldBe` 4 - - it "handles empty files" $ do - headerSizeScala "" `shouldBe` 0 diff --git a/test/Headroom/Header/UtilsSpec.hs b/test/Headroom/Header/UtilsSpec.hs deleted file mode 100644 --- a/test/Headroom/Header/UtilsSpec.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Headroom.Header.UtilsSpec - ( spec - ) -where - -import Headroom.Header.Utils -import RIO -import RIO.FilePath ( () ) -import qualified RIO.Text as T -import Test.Hspec - - - -spec :: Spec -spec = do - let readTemplate p = readFileUtf8 $ "test-data/code-samples/haskell" p - - describe "findLine" $ do - it "should find first line matching given predicate" $ do - text <- readTemplate "full.hs" - findLine ("{-#" `T.isPrefixOf`) text `shouldBe` 15 - - it "should return 0 for empty input" $ do - findLine ("{-#" `T.isPrefixOf`) "" `shouldBe` 0 - - describe "findLineStartingWith" $ do - it "should find first line matching one of given prefixes" $ do - text <- readTemplate "full.hs" - let prefixes = ["{-#", "module"] - findLineStartingWith prefixes text `shouldBe` 15 - diff --git a/test/Headroom/HeaderSpec.hs b/test/Headroom/HeaderSpec.hs deleted file mode 100644 --- a/test/Headroom/HeaderSpec.hs +++ /dev/null @@ -1,52 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Headroom.HeaderSpec - ( spec - ) -where - -import Headroom.FileType ( FileType(..) ) -import Headroom.Header -import RIO -import RIO.FilePath -import Test.Hspec - -spec :: Spec -spec = do - let readTemplate p = readFileUtf8 $ "test-data/code-samples/haskell" p - describe "addHeader" $ do - it "adds header to source code if no header is present" $ do - let header = Header Haskell "-- This is header" - source <- readTemplate "stripped.hs" - expected <- readTemplate "replaced-simple.hs" - addHeader header source `shouldBe` expected - - it "does nothing if some header is already present" $ do - let header = Header Haskell "-- This is header" - source <- readTemplate "full.hs" - addHeader header source `shouldBe` source - - describe "containsHeader" $ do - it "detects whether source code header is present" $ do - withHeader <- readTemplate "full.hs" - withoutHeader <- readTemplate "stripped.hs" - containsHeader Haskell withHeader `shouldBe` True - containsHeader Haskell withoutHeader `shouldBe` False - - describe "dropHeader" $ do - it "drops header from source code" $ do - source <- readTemplate "full.hs" - expected <- readTemplate "stripped.hs" - dropHeader Haskell source `shouldBe` expected - - describe "headerSize" $ do - it "returns correct size of header for source code" $ do - source <- readTemplate "full.hs" - headerSize Haskell source `shouldBe` 15 - - describe "replaceHeader" $ do - it "replaces header in source code" $ do - let header = Header Haskell "-- This is header" - source <- readTemplate "full.hs" - expected <- readTemplate "replaced-simple.hs" - replaceHeader header source `shouldBe` expected diff --git a/test/Headroom/LicenseSpec.hs b/test/Headroom/LicenseSpec.hs deleted file mode 100644 --- a/test/Headroom/LicenseSpec.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Headroom.LicenseSpec - ( spec - ) -where - -import Headroom.FileType ( FileType(..) ) -import Headroom.License -import RIO -import Test.Hspec - -spec :: Spec -spec = do - describe "parseLicense" $ do - it "parses license from raw input" $ do - parseLicense "bsd3:haskell" `shouldBe` Just (License BSD3 Haskell) - parseLicense "foo" `shouldBe` Nothing - - describe "parseLicenseType" $ do - it "parses license type from raw input" $ do - parseLicenseType "bsd3" `shouldBe` Just BSD3 - parseLicenseType "foo" `shouldBe` Nothing diff --git a/test/Headroom/SerializationSpec.hs b/test/Headroom/SerializationSpec.hs new file mode 100644 --- /dev/null +++ b/test/Headroom/SerializationSpec.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Headroom.SerializationSpec + ( spec + ) +where + +import Headroom.Serialization +import RIO +import Test.Hspec + + +spec :: Spec +spec = do + describe "dropFieldPrefix" $ do + it "removes prefix and lowercases first letter for 'prSomeField'" $ do + dropFieldPrefix "prSomeField" `shouldBe` "someField" + + it "removes prefix and keeps case for 'prURLField'" $ do + dropFieldPrefix "prURLField" `shouldBe` "URLField" + + describe "symbolCase" $ do + it "replaces camel cased string into symbol cased" $ do + let input = "camelCasedValue" + expected = "camel-cased-value" + symbolCase '-' input `shouldBe` expected diff --git a/test/Headroom/Template/MustacheSpec.hs b/test/Headroom/Template/MustacheSpec.hs --- a/test/Headroom/Template/MustacheSpec.hs +++ b/test/Headroom/Template/MustacheSpec.hs @@ -8,13 +8,14 @@ import Headroom.Template import Headroom.Template.Mustache -import Headroom.Types +import Headroom.Types ( ApplicationError(..) + , TemplateError(..) + ) import RIO import qualified RIO.HashMap as HM import Test.Hspec import Test.Utils ( matchesException ) - spec :: Spec spec = do describe "parseTemplate" $ do @@ -32,11 +33,13 @@ rendered `shouldBe` Just "Hello, John" it "fails if not enough variables is provided" $ do - let template = "Hello, {{ name }} {{ surname }}" - variables = HM.fromList [("name", "John")] - parsed :: Either SomeException Mustache - parsed = parseTemplate (Just "test") template - rendered = parsed >>= renderTemplate variables - check (Just (MissingVariables "test" ["surname"])) = True - check _ = False + let + template = "Hello, {{ name }} {{ surname }}" + variables = HM.fromList [("name", "John")] + parsed :: Either SomeException Mustache + parsed = parseTemplate (Just "test") template + rendered = parsed >>= renderTemplate variables + check (Just (TemplateError (MissingVariables "test" ["surname"]))) = + True + check _ = False rendered `shouldSatisfy` matchesException check diff --git a/test/Headroom/TextSpec.hs b/test/Headroom/TextSpec.hs deleted file mode 100644 --- a/test/Headroom/TextSpec.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Headroom.TextSpec - ( spec - ) -where - -import Headroom.Text -import Headroom.Types ( NewLine(..) ) -import RIO -import Test.Hspec - - -spec :: Spec -spec = do - describe "detectNewLine" $ do - it "detects that given text uses CR new line sequence" $ do - detectNewLine "hello\rworld" `shouldBe` Just CR - - it "detects that given text uses CRLF new line sequence" $ do - detectNewLine "hello\r\nworld" `shouldBe` Just CRLF - - it "detects that given text uses LF new line sequence" $ do - detectNewLine "hello\nworld" `shouldBe` Just LF - - it "detects no new line sequence" $ do - detectNewLine "hello world" `shouldBe` Nothing - - describe "lines'" $ do - it "detects new line separator and split text into lines" $ do - lines' "foo\nbar" `shouldBe` (LF, ["foo", "bar"]) - - describe "unlines'" $ do - it "joins lines into single text, using the given line separator" $ do - unlines' LF ["foo", "bar"] `shouldBe` "foo\nbar" - diff --git a/test/Headroom/Types/EnumExtraSpec.hs b/test/Headroom/Types/EnumExtraSpec.hs new file mode 100644 --- /dev/null +++ b/test/Headroom/Types/EnumExtraSpec.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +module Headroom.Types.EnumExtraSpec + ( spec + ) +where + +import Headroom.Types.EnumExtra +import RIO +import Test.Hspec + +data TestEnum + = Foo + | Bar + deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) + +spec :: Spec +spec = do + describe "allValues" $ do + it "should return list of all enum values" $ do + allValues @TestEnum `shouldBe` [Foo, Bar] + + describe "allValuesToText" $ do + it "should pretty print all enum values" $ do + allValuesToText @TestEnum `shouldBe` "Foo, Bar" + + describe "enumToText" $ do + it "should show textual representation of enum value" $ do + enumToText Foo `shouldBe` "Foo" + + describe "textToEnum" $ do + it "should read enum value from textual representation" $ do + textToEnum "foo" `shouldBe` Just Foo + diff --git a/test/Headroom/Types/UtilsSpec.hs b/test/Headroom/Types/UtilsSpec.hs deleted file mode 100644 --- a/test/Headroom/Types/UtilsSpec.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -module Headroom.Types.UtilsSpec - ( spec - ) -where - -import Headroom.FileType ( FileType(..) ) -import Headroom.Types.Utils -import RIO -import RIO.List ( sort ) -import Test.Hspec - - -spec :: Spec -spec = do - describe "allValues" $ do - it "should list all values of FileType enum" $ do - let actual = allValues :: [FileType] - expected = [CSS, Haskell, HTML, Java, JS, Scala] - sort actual `shouldBe` sort expected - - describe "dropFieldPrefix" $ do - it "removes prefix and lowercases first letter for 'prSomeField'" $ do - dropFieldPrefix "prSomeField" `shouldBe` "someField" - - it "removes prefix and keeps case for 'prURLField'" $ do - dropFieldPrefix "prURLField" `shouldBe` "URLField" - - describe "readEnumCI" $ do - it "reads enum value from string representation (case insensitive)" $ do - let expected = [(Haskell, "")] - readEnumCI "haskell" `shouldBe` expected - readEnumCI "Haskell" `shouldBe` expected - readEnumCI "HASKELL" `shouldBe` expected - - describe "symbolCase" $ do - it "replaces camel cased string into symbol cased" $ do - let input = "camelCasedValue" - expected = "camel-cased-value" - symbolCase '-' input `shouldBe` expected - diff --git a/test/Headroom/TypesSpec.hs b/test/Headroom/TypesSpec.hs deleted file mode 100644 --- a/test/Headroom/TypesSpec.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Headroom.TypesSpec - ( spec - ) -where - -import Data.Aeson ( eitherDecode ) -import Headroom.Types -import RIO -import Test.Hspec - - -spec :: Spec -spec = do - describe "parseJSON" $ do - it "should parse RunMode value" $ do - eitherDecode "\"add\"" `shouldBe` Right Add - eitherDecode "\"drop\"" `shouldBe` Right Drop - eitherDecode "\"replace\"" `shouldBe` Right Replace - eitherDecode "\"ADD\"" `shouldBe` Right Add - eitherDecode "\"DROP\"" `shouldBe` Right Drop - eitherDecode "\"REPLACE\"" `shouldBe` Right Replace -