headroom (empty) → 0.1.0.0
raw patch · 51 files changed
+2685/−0 lines, 51 filesdep +aesondep +basedep +doctestsetup-changed
Dependencies added: aeson, base, doctest, either, file-embed, headroom, hspec, lens, mustache, optparse-applicative, pcre-heavy, pcre-light, rio, template-haskell, text, time, validation, yaml
Files
- CHANGELOG.md +5/−0
- LICENSE +29/−0
- README.md +253/−0
- Setup.hs +2/−0
- app/Main.hs +51/−0
- doctest/Main.hs +6/−0
- headroom.cabal +145/−0
- src/Headroom/AppConfig.hs +121/−0
- src/Headroom/Command.hs +103/−0
- src/Headroom/Command/Gen.hs +45/−0
- src/Headroom/Command/Gen/Env.hs +42/−0
- src/Headroom/Command/Run.hs +194/−0
- src/Headroom/Command/Run/Env.hs +96/−0
- src/Headroom/Command/Shared.hs +32/−0
- src/Headroom/Embedded.hs +72/−0
- src/Headroom/FileSystem.hs +79/−0
- src/Headroom/FileType.hs +79/−0
- src/Headroom/Header.hs +91/−0
- src/Headroom/Header/Impl.hs +28/−0
- src/Headroom/Header/Impl/CSS.hs +29/−0
- src/Headroom/Header/Impl/HTML.hs +29/−0
- src/Headroom/Header/Impl/Haskell.hs +30/−0
- src/Headroom/Header/Impl/JS.hs +29/−0
- src/Headroom/Header/Impl/Java.hs +29/−0
- src/Headroom/Header/Impl/Scala.hs +31/−0
- src/Headroom/Header/Utils.hs +56/−0
- src/Headroom/License.hs +64/−0
- src/Headroom/Meta.hs +24/−0
- src/Headroom/Template.hs +51/−0
- src/Headroom/Template/Mustache.hs +60/−0
- src/Headroom/Text.hs +69/−0
- src/Headroom/Types.hs +106/−0
- src/Headroom/Types/Utils.hs +70/−0
- test/Headroom/AppConfigSpec.hs +65/−0
- test/Headroom/FileSystemSpec.hs +43/−0
- test/Headroom/FileTypeSpec.hs +23/−0
- test/Headroom/Header/Impl/CSSSpec.hs +24/−0
- test/Headroom/Header/Impl/HTMLSpec.hs +25/−0
- test/Headroom/Header/Impl/HaskellSpec.hs +21/−0
- test/Headroom/Header/Impl/JSSpec.hs +24/−0
- test/Headroom/Header/Impl/JavaSpec.hs +21/−0
- test/Headroom/Header/Impl/ScalaSpec.hs +21/−0
- test/Headroom/Header/UtilsSpec.hs +33/−0
- test/Headroom/HeaderSpec.hs +52/−0
- test/Headroom/LicenseSpec.hs +18/−0
- test/Headroom/Template/MustacheSpec.hs +42/−0
- test/Headroom/TextSpec.hs +36/−0
- test/Headroom/Types/UtilsSpec.hs +41/−0
- test/Headroom/TypesSpec.hs +29/−0
- test/Spec.hs +2/−0
- test/Test/Utils.hs +15/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Changelog+All notable changes to this project will be documented in this file.++## 0.1.0.0 (not released yet)+- initial release
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2019-2020, Vaclav Svejcar+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,253 @@+<p align="center"><img src ="https://github.com/vaclavsvejcar/headroom/blob/master/doc/assets/logo.png?raw=true" width="200" /></p>++[](https://travis-ci.com/vaclavsvejcar/headroom)++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__+<!-- TOC -->++- [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. Case Example](#4-case-example)+ - [4.1. Adding License Header Templates](#41-adding-license-header-templates)+ - [4.2. Adding Headroom Configuration](#42-adding-headroom-configuration)+ - [4.3. Running Headroom](#43-running-headroom)+- [5. Command Line Interface Overview](#5-command-line-interface-overview)+ - [5.1. Run Command](#51-run-command)+ - [5.2. Generator Command](#52-generator-command)+ - [5.2.1. Supported License Types](#521-supported-license-types)+ - [5.2.2. Supported File Types](#522-supported-file-types)++<!-- /TOC -->++## 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.++## 2. Planned Features+- __init command__ - automates initial Headroom setup for your project (generates config files, detects source code file types and generates license template stubs for them)+- __binary distribution__ - pre-built binaries will be generated for each release for major OS platforms++## 3. Installation+> Binary distribution, pre-built packages and installation from Stackage will be available soon.++### 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. clone this repository+1. run `stack install` inside the `headroom/` directory+1. add `$HOME/.local/bin` to your `$PATH`++## 4. Case Example+Let's demonstrate how to use Headroom in real world example: imagine 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+```++### 4.1. Adding License Header Templates+Let's say our project is licensed under the [3-Clause BSD License][web:bsd-3] license, so we want to use appropriate license headers. Headroom already provides templates for this license which you can use without modifications, or as starting point for your customization. Now we need to generate template file for each source code file type we have. The template must be always named as `<FILE_TYPE>.mustache`, for reference see list of [supported file types](#422-supported-file-types) and [supported license types](#421-supported-license-types).++```shell+cd project/+mkdir templates/+cd templates/++headroom gen -l bsd3:css >./css.mustache+headroom gen -l bsd3:html >./html.mustache+headroom gen -l bsd3:scala >./scala.mustache+```++Now the project structure should be following:++```+project/+ ├── src/+ │ ├── scala/+ │ │ ├── Foo.scala+ │ │ └── Bar.scala+ │ └── html/+ │ └── template1.html+ └── templates/+ ├── css.mustache+ ├── html.mustache+ └── scala.mustache+```++### 4.2. Adding Headroom Configuration+Now we need to add configuration file where we specify path to source code files, template files and define values for variables in templates. The configuration file should be placed in project root directory and should be named `.headroom.yaml`, so Headroom can locate it:++```+cd project/+headroom gen -c >./.headroom.yaml+```++The project structure should now be following:++```+project/+ ├── src/+ │ ├── scala/+ │ │ ├── Foo.scala+ │ │ └── Bar.scala+ │ └── html/+ │ └── template1.html+ ├── templates/+ │ ├── css.mustache+ │ ├── html.mustache+ │ └── scala.mustache+ └── .headroom.yaml+```++Let's now edit configuration file to match our project:++```yaml+## 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+## - drop = drops existing license header from without replacement+## - replace = adds or replaces existing license header+run-mode: add++## Paths to source code files (either files or directories).+source-paths:+ - src++## Paths to template files (either files or directories).+template-paths:+ - templates++## Variables (key-value) to replace in templates.+variables:+ author: John Smith+ year: "2019"+```++### 4.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+```++## 5. 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.0.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+```++### 5.1. 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` |+++### 5.2. 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`.++#### 5.2.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` |++#### 5.2.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].++| Language | Used Name | Supported Extensions |+|--------------|-----------|----------------------|+| _CSS_ | `css` | `.css` |+| _Haskell_ | `haskell` | `.hs` |+| _HTML_ | `html` | `.html`, `.htm` |+| _Java_ | `java` | `.java` |+| _JavaScript_ | `js` | `.js` |+| _Scala_ | `scala` | `.scala` |+++[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/+[web:haskell]: https://haskell.org+[web:mustache]: https://mustache.github.io+[web:stack]: https://www.haskellstack.org+[wiki:yaml]: https://en.wikipedia.org/wiki/YAML
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,51 @@+{-|+Module : Main+Description : Application entry point+Copyright : (c) 2019-2020 Vaclav Svejcar+License : BSD-3+Maintainer : vaclav.svejcar@gmail.com+Stability : experimental+Portability : POSIX++Functions responsible for application bootstrap.+-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Headroom.Command ( Command(..)+ , commandParser+ )+import Headroom.Command.Gen ( commandGen )+import Headroom.Command.Gen.Env ( GenMode(..)+ , GenOptions(GenOptions)+ )+import Headroom.Command.Run ( commandRun )+import Headroom.Command.Run.Env ( RunOptions(RunOptions) )+import Headroom.Types ( HeadroomError(..) )+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)+ exitWith $ ExitFailure 1+ )++bootstrap :: Command -> IO ()+bootstrap command' = case command' of+ Run sourcePaths templatePaths variables runMode debug ->+ commandRun (RunOptions runMode sourcePaths templatePaths variables debug)+ c@(Gen _ _) -> do+ genMode <- parseGenMode c+ commandGen (GenOptions genMode)++parseGenMode :: MonadThrow m => Command -> m GenMode+parseGenMode (Gen True Nothing ) = return GenConfigFile+parseGenMode (Gen False (Just license)) = return $ GenLicense license+parseGenMode _ = throwM NoGenModeSelected
+ doctest/Main.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Test.DocTest+ +main :: IO ()+main = doctest ["-XOverloadedStrings", "src"]
+ headroom.cabal view
@@ -0,0 +1,145 @@+cabal-version: 1.12+name: headroom+version: 0.1.0.0+license: BSD3+license-file: LICENSE+copyright: Copyright (c) 2019-2020 Vaclav Svejcar+maintainer: vaclav.svejcar@gmail.com+author: Vaclav Svejcar+homepage: https://github.com/vaclavsvejcar/headroom+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.+category: Utils+build-type: Simple+extra-source-files:+ CHANGELOG.md+ LICENSE+ README.md++source-repository head+ type: git+ location: https://github.com/vaclavsvejcar/headroom++library+ exposed-modules:+ Headroom.AppConfig+ Headroom.Command+ Headroom.Command.Gen+ Headroom.Command.Gen.Env+ Headroom.Command.Run+ Headroom.Command.Run.Env+ Headroom.Command.Shared+ Headroom.Embedded+ Headroom.FileSystem+ Headroom.FileType+ 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.Template+ Headroom.Template.Mustache+ Headroom.Text+ Headroom.Types+ Headroom.Types.Utils+ hs-source-dirs: src+ other-modules:+ Paths_headroom+ default-language: Haskell2010+ ghc-options: -optP-Wno-nonportable-include-path -Wall -Wcompat+ -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns+ -Wpartial-fields -Wredundant-constraints+ -Werror=incomplete-patterns+ build-depends:+ aeson >=1.4.6.0 && <1.5,+ base >=4.7 && <5,+ either >=5.0.1.1 && <5.1,+ file-embed >=0.0.11.1 && <0.1,+ lens >=4.18.1 && <4.19,+ mustache >=2.3.1 && <2.4,+ 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.0 && <0.2,+ template-haskell >=2.15.0.0 && <2.16,+ text >=1.2.4.0 && <1.3,+ time >=1.9.3 && <1.10,+ validation ==1.1.*,+ yaml >=0.11.2.0 && <0.12++executable headroom+ main-is: Main.hs+ hs-source-dirs: app+ other-modules:+ Paths_headroom+ default-language: Haskell2010+ ghc-options: -optP-Wno-nonportable-include-path -Wall -Wcompat+ -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns+ -Wpartial-fields -Wredundant-constraints+ -Werror=incomplete-patterns -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5,+ headroom -any,+ optparse-applicative >=0.15.1.0 && <0.16,+ rio >=0.1.14.0 && <0.2++test-suite doctest+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: doctest+ other-modules:+ Paths_headroom+ default-language: Haskell2010+ ghc-options: -optP-Wno-nonportable-include-path -Wall -Wcompat+ -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns+ -Wpartial-fields -Wredundant-constraints+ -Werror=incomplete-patterns+ build-depends:+ base >=4.7 && <5,+ doctest >=0.16.2 && <0.17,+ optparse-applicative >=0.15.1.0 && <0.16,+ rio >=0.1.14.0 && <0.2++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test+ other-modules:+ Headroom.AppConfigSpec+ 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.Template.MustacheSpec+ Headroom.TextSpec+ Headroom.Types.UtilsSpec+ Headroom.TypesSpec+ Test.Utils+ Paths_headroom+ default-language: Haskell2010+ ghc-options: -optP-Wno-nonportable-include-path -Wall -Wcompat+ -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns+ -Wpartial-fields -Wredundant-constraints+ -Werror=incomplete-patterns+ build-depends:+ aeson >=1.4.6.0 && <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.0 && <0.2
+ src/Headroom/AppConfig.hs view
@@ -0,0 +1,121 @@+{-|+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+ , validateAppConfig+ )+where++import Control.Lens+import Data.Aeson ( FromJSON(parseJSON)+ , genericParseJSON+ )+import Data.Validation+import qualified Data.Yaml as Y+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++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+ return $ 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] -> return (key, value)+ _ -> throwM $ InvalidVariable input++-- | 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' -> return 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
+ src/Headroom/Command.hs view
@@ -0,0 +1,103 @@+{-|+Module : Headroom.Command+Description : Command line options processing+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.+-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module Headroom.Command+ ( Command(..)+ , commandParser+ )+where++import Headroom.Meta ( buildVer )+import Headroom.Types ( RunMode(..) )+import Options.Applicative+import RIO+++-- | Application command.+data Command+ = Run [FilePath] [FilePath] [Text] RunMode Bool -- ^ /Run/ command+ | Gen Bool (Maybe Text) -- ^ /Generator/ command+ deriving (Show)++-- | Parses command line arguments.+commandParser :: ParserInfo Command+commandParser = info+ (commands <**> helper)+ ( fullDesc+ <> progDesc "manage your source code license headers"+ <> header header'+ )+ where+ header' =+ "headroom v" <> buildVer <> " :: https://github.com/vaclavsvejcar/headroom"+ commands = subparser (runCommand <> genCommand)+ runCommand = command+ "run"+ (info (runOptions <**> helper)+ (progDesc "add or replace source code headers")+ )+ genCommand = command+ "gen"+ (info (genOptions <**> helper)+ (progDesc "generate stub configuration and template files")+ )+++runOptions :: Parser Command+runOptions =+ Run+ <$> many+ (strOption+ (long "source-path" <> short 's' <> metavar "PATH" <> help+ "path to source code file/directory"+ )+ )+ <*> many+ (strOption+ (long "template-path" <> short 't' <> metavar "PATH" <> help+ "path to header template file/directory"+ )+ )+ <*> many+ (strOption+ (long "variables" <> short 'v' <> metavar "KEY=VALUE" <> help+ "values for template variables"+ )+ )+ <*> ( 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"+ )+ <|> pure Add+ )+ <*> switch (long "debug" <> help "produce more verbose output")++genOptions :: Parser Command+genOptions =+ Gen+ <$> switch+ (long "config-file" <> short 'c' <> help+ "generate stub YAML config file to stdout"+ )+ <*> optional+ (strOption+ (long "license" <> short 'l' <> metavar "name:type" <> help+ "generate template for license and file type"+ )+ )
+ src/Headroom/Command/Gen.hs view
@@ -0,0 +1,45 @@+{-|+Module : Headroom.Command.Gen+Description : Logic for Generate 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.+-}+{-# LANGUAGE NoImplicitPrelude #-}+module Headroom.Command.Gen+ ( commandGen+ )+where++import Headroom.Command.Gen.Env+import Headroom.Command.Shared ( bootstrap )+import Headroom.Embedded ( configFileStub+ , licenseTemplate+ )+import Headroom.License ( parseLicense )+import Headroom.Types ( HeadroomError(..) )+import Prelude ( putStrLn )+import RIO+++env' :: GenOptions -> LogFunc -> IO Env+env' opts logFunc = return $ Env { envLogFunc = logFunc, envGenOptions = opts }++-- | 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++printConfigFile :: IO ()+printConfigFile = putStrLn configFileStub++printLicense :: Text -> IO ()+printLicense license = case parseLicense license of+ Just license' -> putStrLn $ licenseTemplate license'+ Nothing -> throwM $ InvalidLicense license
+ src/Headroom/Command/Gen/Env.hs view
@@ -0,0 +1,42 @@+{-|+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+ ( GenMode(..)+ , GenOptions(..)+ , Env(..)+ )+where++import RIO+++-- | Options for the /Generator/ command.+newtype GenOptions = GenOptions+ { goGenMode :: GenMode -- ^ used /Generator/ command mode+ }+ deriving Show++-- | /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)++instance HasLogFunc Env where+ logFuncL = lens envLogFunc (\x y -> x { envLogFunc = y })
+ src/Headroom/Command/Run.hs view
@@ -0,0 +1,194 @@+{-|+Module : Headroom.Command.Run+Description : Logic for 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.+-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+module Headroom.Command.Run+ ( commandRun+ )+where++import Data.Time.Clock.POSIX ( getPOSIXTime )+import Headroom.AppConfig ( AppConfig(..)+ , loadAppConfig+ , validateAppConfig+ )+import Headroom.Command.Run.Env+import Headroom.Command.Shared ( bootstrap )+import Headroom.FileSystem ( findFilesByExts+ , findFilesByTypes+ )+import Headroom.FileType ( FileType+ , fileTypeByExt+ , fileTypeByName+ )+import Headroom.Header ( Header(..)+ , addHeader+ , containsHeader+ , dropHeader+ , replaceHeader+ )+import Headroom.Template ( Template(..)+ , loadTemplate+ )+import Headroom.Template.Mustache ( Mustache(..) )+import Headroom.Types ( Progress(..)+ , RunMode(..)+ )+import RIO hiding ( second )+import RIO.Directory+import RIO.FilePath ( takeBaseName+ , takeExtension+ , (</>)+ )+import qualified RIO.List as L+import qualified RIO.Map as M+import qualified RIO.Text as T+++type TemplateType = Mustache++env' :: RunOptions -> LogFunc -> IO Env+env' opts logFunc = do+ let startupEnv = StartupEnv { envLogFunc = logFunc, envRunOptions = opts }+ merged <- runRIO startupEnv mergedAppConfig+ let env = Env { envEnv = startupEnv, envAppConfig = merged }+ return env++-- | 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 " <> displayShow (M.size templates) <> " template(s)"+ logInfo "Searching for source code files..."+ sourceFiles <- findSourceFiles (M.keys templates)+ let sourceFilesNum = displayShow . 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)+ logInfo $ mconcat+ [ "Done: modified "+ , displayShow (total - skipped)+ , ", skipped "+ , displayShow skipped+ , " files in "+ , displayShow (elapsedSeconds :: Integer)+ , " 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+ where+ loadAppConfigSafe path = catch+ (fmap Just (loadAppConfig path))+ (\ex -> do+ logDebug $ displayShow (ex :: IOException)+ logWarn $ "Skipping missing configuration file: " <> fromString path+ return Nothing+ )+ mergeAppConfigs appConfigs = do+ let merged = mconcat appConfigs+ logDebug $ "Source AppConfig instances: " <> displayShow appConfigs+ logDebug $ "Merged AppConfig: " <> displayShow merged+ return merged++loadTemplates :: (HasAppConfig env, HasLogFunc env)+ => RIO env (M.Map FileType Text)+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+ return $ M.fromList rendered+ where+ extensions = templateExtensions (Proxy :: Proxy TemplateType)+ findPaths path = findFilesByExts path extensions+ filterTemplate (fileType, path) = (\ft -> Just (ft, path)) =<< fileType++extractTemplateType :: HasLogFunc env => FilePath -> RIO env (Maybe FileType)+extractTemplateType path = do+ let fileType = fileTypeByName . T.pack . takeBaseName $ path+ when (isNothing fileType)+ (logWarn $ "Skipping unrecognized template type: " <> fromString path)+ return 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+ return (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) (fileTypeFor path)+ fileTypeFor = fileTypeByExt . T.pack . fileExt+ fileExt path = case takeExtension path of+ '.' : xs -> xs+ other -> other++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)+ return skipped+ where+ log' msg = logInfo $ displayShow 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
+ src/Headroom/Command/Run/Env.hs view
@@ -0,0 +1,96 @@+{-|+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)+ return $ mempty { acSourcePaths = roSourcePaths opts+ , acTemplatePaths = roTemplatePaths opts+ , acRunMode = roRunMode opts+ , acVariables = variables'+ }
@@ -0,0 +1,32 @@+{-|+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
+ src/Headroom/Embedded.hs view
@@ -0,0 +1,72 @@+{-|+Module : Headroom.Embedded+Description : Embedded resource 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.+-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}+module Headroom.Embedded+ ( configFileStub+ , licenseTemplate+ )+where++import Data.FileEmbed ( embedStringFile )+import Headroom.FileType ( FileType(..) )+import Headroom.License ( License(..)+ , 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'.+licenseTemplate :: IsString a+ => License -- ^ 'License' for which to return the template+ -> a -- ^ template text+licenseTemplate (License licenseType fileType) = case licenseType of+ Apache2 -> case fileType of+ 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")+ Scala -> $(embedStringFile "embedded/license/apache2/scala.mustache")+ BSD3 -> case fileType of+ 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")+ Scala -> $(embedStringFile "embedded/license/bsd3/scala.mustache")+ GPL2 -> case fileType of+ 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")+ Scala -> $(embedStringFile "embedded/license/gpl2/scala.mustache")+ GPL3 -> case fileType of+ 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")+ Scala -> $(embedStringFile "embedded/license/gpl3/scala.mustache")+ MIT -> case fileType of+ 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")+ Scala -> $(embedStringFile "embedded/license/mit/scala.mustache")
+ src/Headroom/FileSystem.hs view
@@ -0,0 +1,79 @@+{-|+Module : Headroom.FileSystem+Description : Files/directories manipulation+Copyright : (c) 2019-2020 Vaclav Svejcar+License : BSD-3+Maintainer : vaclav.svejcar@gmail.com+Stability : experimental+Portability : POSIX++Functions for manipulating files and directories.+-}+{-# LANGUAGE NoImplicitPrelude #-}+module Headroom.FileSystem+ ( findFiles+ , findFilesByExts+ , findFilesByTypes+ , listFiles+ , loadFile+ )+where++import Headroom.FileType ( FileType+ , listExtensions+ )+import RIO+import RIO.Directory ( doesDirectoryExist+ , getDirectoryContents+ )+import RIO.FilePath ( isExtensionOf+ , (</>)+ )+import qualified RIO.Text as T+++-- | Recursively finds files on given path whose filename matches the predicate.+findFiles :: MonadIO m+ => FilePath -- ^ path to search+ -> (FilePath -> Bool) -- ^ predicate to match filename+ -> 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+ -> [Text] -- ^ list of file extensions (without dot)+ -> m [FilePath] -- ^ list of found files+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)++-- | Recursively find all files on given path. If file reference is passed+-- instead of directory, such file path is returned.+listFiles :: MonadIO m+ => FilePath -- ^ path to search+ -> m [FilePath] -- ^ list of found files+listFiles fileOrDir = do+ isDir <- doesDirectoryExist fileOrDir+ if isDir then listDirectory fileOrDir else return [fileOrDir]+ where+ listDirectory dir = do+ names <- getDirectoryContents dir+ let filteredNames = filter (`notElem` [".", ".."]) names+ paths <- forM filteredNames $ \name -> do+ let path = dir </> name+ isDirectory <- doesDirectoryExist path+ if isDirectory then listFiles path else return [path]+ return $ concat paths++-- | Loads file content in UTF8 encoding.+loadFile :: MonadIO m+ => FilePath -- ^ file path+ -> m Text -- ^ file content+loadFile = readFileUtf8
+ src/Headroom/FileType.hs view
@@ -0,0 +1,79 @@+{-|+Module : Headroom.FileType+Description : Supported source code 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.+-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module Headroom.FileType+ ( FileType(..)+ , fileTypeByExt+ , listExtensions+ , fileTypeByName+ )+where++import Headroom.Types.Utils ( allValues+ , readEnumCI+ )+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).+--+-- >>> 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"]++-- | 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
+ src/Headroom/Header.hs view
@@ -0,0 +1,91 @@+{-|+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
+ src/Headroom/Header/Impl.hs view
@@ -0,0 +1,28 @@+{-|+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 )
+ src/Headroom/Header/Impl/CSS.hs view
@@ -0,0 +1,29 @@+{-|+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*)|]
+ src/Headroom/Header/Impl/HTML.hs view
@@ -0,0 +1,29 @@+{-|+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*|]
+ src/Headroom/Header/Impl/Haskell.hs view
@@ -0,0 +1,30 @@+{-|+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"]
+ src/Headroom/Header/Impl/JS.hs view
@@ -0,0 +1,29 @@+{-|+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*)|]
+ src/Headroom/Header/Impl/Java.hs view
@@ -0,0 +1,29 @@+{-|+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"]
+ src/Headroom/Header/Impl/Scala.hs view
@@ -0,0 +1,31 @@+{-|+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"]
+ src/Headroom/Header/Utils.hs view
@@ -0,0 +1,56 @@+{-|+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]
+ src/Headroom/License.hs view
@@ -0,0 +1,64 @@+{-|+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+ )+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)++-- | License (specified by 'LicenseType' and 'FileType')+data License = License LicenseType FileType+ deriving (Show, Eq)++instance Read LicenseType where+ readsPrec _ = readEnumCI++-- | 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+ return $ License licenseType fileType+ | otherwise = Nothing+ where parseLicenseType = readMaybe . T.unpack
+ src/Headroom/Meta.hs view
@@ -0,0 +1,24 @@+{-|+Module : Headroom.Meta+Description : Application metadata+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).+-}+{-# LANGUAGE NoImplicitPrelude #-}+module Headroom.Meta+ ( buildVer+ )+where++import Data.Version ( showVersion )+import Paths_headroom ( version )+import RIO++-- | Returns application version, as specified in @headroom.cabal@ file.+buildVer :: String+buildVer = showVersion version
+ src/Headroom/Template.hs view
@@ -0,0 +1,51 @@+{-|+Module : Headroom.Template+Description : Generic support for license header templates+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.+-}+{-# LANGUAGE NoImplicitPrelude #-}+module Headroom.Template+ ( Template(..)+ , loadTemplate+ )+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+ -> [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+
+ src/Headroom/Template/Mustache.hs view
@@ -0,0 +1,60 @@+{-|+Module : Headroom.Template.Mustache+Description : Support for Mustache templates+Copyright : (c) 2019-2020 Vaclav Svejcar+License : BSD-3+Maintainer : vaclav.svejcar@gmail.com+Stability : experimental+Portability : POSIX++Provides support for <https://mustache.github.io Mustache> templates using the+'Template' type class.+-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module Headroom.Template.Mustache+ ( Mustache(..)+ )+where++import Headroom.Template ( Template(..) )+import RIO+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'++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)+ Right res -> return $ 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+ ([], rendered) -> return rendered+ (errs, rendered) ->+ let errs' = missingVariables errs+ in if length errs == length errs'+ then throwM $ MissingVariables (T.pack name) errs'+ else return rendered+ where+ missingVariables = concatMap+ (\case+ (VariableNotFound ps) -> ps+ _ -> []+ )+
+ src/Headroom/Text.hs view
@@ -0,0 +1,69 @@+{-|+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
+ src/Headroom/Types.hs view
@@ -0,0 +1,106 @@+{-|+Module : Headroom.Types+Description : Data types and instances+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.+-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module Headroom.Types+ ( AppConfigError(..)+ , HeadroomError(..)+ , NewLine(..)+ , Progress(..)+ , RunMode(..)+ )+where++import Data.Aeson ( FromJSON(parseJSON)+ , Value(String)+ )+import RIO+import qualified RIO.List as L+import qualified RIO.Text as T+import Text.Printf ( printf )++-- | 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+ 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@)+ | NoGenModeSelected -- ^ no mode for /Generator/ command is selected+ | MissingVariables Text [Text] -- ^ not all variables were filled in template+ | ParseError Text -- ^ error parsing template file+ deriving (Show, Typeable)++-- | Represents newline separator.+data NewLine+ = CR -- ^ line ends with @\r@+ | CRLF -- ^ line ends with @\r\n@+ | LF -- ^ line ends with @\n@+ deriving (Eq, Show)++-- | Progress indication. First argument is current progress, second the maximum+-- value.+data Progress = Progress Int Int+ deriving Eq++-- | 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+ deriving (Eq, Show)++displayAppConfigError :: AppConfigError -> Text+displayAppConfigError = \case+ EmptySourcePaths -> "no paths to source code files"+ EmptyTemplatePaths -> "no paths to template files"++---------------------------- TYPE CLASS INSTANCES ----------------------------++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++instance Show Progress where+ show (Progress current total) = mconcat ["[", currentS, " of ", totalS, "]"]+ where+ format = "%" <> (show . L.length $ totalS) <> "d"+ currentS = printf format current+ totalS = show total++instance FromJSON RunMode where+ parseJSON (String s) = case T.toLower s of+ "add" -> return Add+ "drop" -> return Drop+ "replace" -> return Replace+ _ -> error $ "Unknown run mode: " <> T.unpack s+ parseJSON other = error $ "Invalid value for run mode: " <> show other
+ src/Headroom/Types/Utils.hs view
@@ -0,0 +1,70 @@+{-|+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
+ test/Headroom/AppConfigSpec.hs view
@@ -0,0 +1,65 @@+{-# 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 "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'+
+ test/Headroom/FileSystemSpec.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module Headroom.FileSystemSpec+ ( spec+ )+where++import Headroom.FileSystem+import RIO+import RIO.List ( sort )+import qualified RIO.List as L+import Test.Hspec+++spec :: Spec+spec = do+ describe "findFiles" $ do+ it "recursively finds files filtered by given predicate" $ do+ files <- findFiles "test-data/test-traverse/" ("b.html" `L.isSuffixOf`)+ let expected = ["test-data/test-traverse/foo/b.html"]+ files `shouldBe` expected++ describe "findFilesByExts" $ do+ it "recursively finds files filtered by its file extension" $ do+ files <- findFilesByExts "test-data/test-traverse/" ["xml"]+ let expected = ["test-data/test-traverse/foo/test.xml"]+ files `shouldBe` expected++ describe "listFiles" $ do+ it "recursively finds all files in directory" $ do+ filePaths <- listFiles "test-data/test-traverse/"+ let expected =+ [ "test-data/test-traverse/a.html"+ , "test-data/test-traverse/foo/b.html"+ , "test-data/test-traverse/foo/test.xml"+ , "test-data/test-traverse/foo/bar/c.html"+ ]+ sort filePaths `shouldBe` sort expected++ it "returns file if file path is passed as argument" $ do+ filePaths <- listFiles "test-data/test-traverse/a.html"+ let expected = ["test-data/test-traverse/a.html"]+ sort filePaths `shouldBe` sort expected
+ test/Headroom/FileTypeSpec.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module Headroom.FileTypeSpec+ ( spec+ )+where++import Headroom.FileType+import RIO+import Test.Hspec+++spec :: Spec+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
+ test/Headroom/Header/Impl/CSSSpec.hs view
@@ -0,0 +1,24 @@+{-# 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
+ test/Headroom/Header/Impl/HTMLSpec.hs view
@@ -0,0 +1,25 @@+{-# 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
+ test/Headroom/Header/Impl/HaskellSpec.hs view
@@ -0,0 +1,21 @@+{-# 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
+ test/Headroom/Header/Impl/JSSpec.hs view
@@ -0,0 +1,24 @@+{-# 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
+ test/Headroom/Header/Impl/JavaSpec.hs view
@@ -0,0 +1,21 @@+{-# 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
+ test/Headroom/Header/Impl/ScalaSpec.hs view
@@ -0,0 +1,21 @@+{-# 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
+ test/Headroom/Header/UtilsSpec.hs view
@@ -0,0 +1,33 @@+{-# 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+
+ test/Headroom/HeaderSpec.hs view
@@ -0,0 +1,52 @@+{-# 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
+ test/Headroom/LicenseSpec.hs view
@@ -0,0 +1,18 @@+{-# 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
+ test/Headroom/Template/MustacheSpec.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Headroom.Template.MustacheSpec+ ( spec+ )+where++import Headroom.Template+import Headroom.Template.Mustache+import Headroom.Types+import RIO+import qualified RIO.HashMap as HM+import Test.Hspec+import Test.Utils ( matchesException )+++spec :: Spec+spec = do+ describe "parseTemplate" $ do+ it "parses Mustache template from raw text" $ do+ let template = "Hello, {{ name }}"+ parsed = parseTemplate (Just "template") template :: Maybe Mustache+ parsed `shouldSatisfy` isJust++ describe "renderTemplate" $ do+ it "renders Mustache template with given variables" $ do+ let template = "Hello, {{ name }}"+ variables = HM.fromList [("name", "John")]+ parsed = parseTemplate (Just "template") template :: Maybe Mustache+ rendered = parsed >>= renderTemplate variables :: Maybe Text+ 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+ rendered `shouldSatisfy` matchesException check
+ test/Headroom/TextSpec.hs view
@@ -0,0 +1,36 @@+{-# 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"+
+ test/Headroom/Types/UtilsSpec.hs view
@@ -0,0 +1,41 @@+{-# 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+
+ test/Headroom/TypesSpec.hs view
@@ -0,0 +1,29 @@+{-# 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 "show" $ do+ it "shows correct output for Progress data type" $ do+ show (Progress 1 1) `shouldBe` "[1 of 1]"+ show (Progress 10 250) `shouldBe` "[ 10 of 250]"++ 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+
+ test/Spec.hs view
@@ -0,0 +1,2 @@+-- hspec test auto discovery - https://hspec.github.io/hspec-discover.html+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/Test/Utils.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Test.Utils+ ( matchesException+ )+where++import RIO++matchesException :: Exception e+ => (Maybe e -> Bool)+ -> Either SomeException r+ -> Bool+matchesException cond (Left ex) | cond (fromException ex) = True+ | otherwise = False+matchesException _ _ = False