diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,12 @@ # Changelog All notable changes to this project will be documented in this file. +## 0.3.1.0 (released 2020-08-18) +- [#48] Decouple IO actions for easier testing +- [#53] Add support for _PureScript_ source code files +- [#54] Extract _dynamic variables_ from _Java_ source code files +- Bump _LTS Haskell_ to `16.10` + ## 0.3.0.0 (released 2020-06-28) - [#25] Extract _dynamic variables_ from Haskell source code files - [#29] Add _dynamic variable_ for current year and add support for updating years diff --git a/embedded/default-config.yaml b/embedded/default-config.yaml --- a/embedded/default-config.yaml +++ b/embedded/default-config.yaml @@ -45,6 +45,8 @@ _haskell_module_portability: "!!! INSERT MODULE PORTABILITY !!!" _haskell_module_longdesc: "!!! INSERT MODULE LONG DESCRIPTION !!!" _haskell_module_shortdesc: "!!! INSERT MODULE SHORT DESCRIPTION !!!" + _java_package_name: "!!! UNKNOWN JAVA PACKAGE NAME !!!" + _purescript_module_name: "!!! INSERT PURESCRIPT MODULE NAME !!!" ## Allows to change behaviour of license header detection and placement. Such ## configuration is defined for every supported file type, where individual @@ -151,6 +153,16 @@ starts-with: "/*" ends-with: "*/" + ## PureScript configuration + purescript: + file-extensions: ["purs"] + margin-after: 0 + margin-before: 0 + put-after: [] + put-before: ["^module"] + line-comment: + prefixed-by: "--" + ## Rust configuration rust: file-extensions: ["rs"] @@ -183,13 +195,11 @@ line-comment: prefixed-by: "#" - ## Configuration for post-processing license header functions. These functions ## allows to modify/enhance already rendered license headers, e.g. update years ## in copyright statements, etc. Each function can be enabled/disabled using the ## 'enabled' key and eventually customized using the 'config' key. post-process: - ## License header function that updates years in copyright statements in ## rendered license header. If you need to update copyright year only for ## selected author(s), define them in 'selected-authors-only' key, otherwise @@ -198,5 +208,5 @@ update-copyright: enabled: false config: - ## If used, updates copyright statements of selected authors only. - # selected-authors-only: ["John Smith"] + ## If used, updates copyright statements of selected authors only. + # selected-authors-only: ["John Smith"] diff --git a/embedded/license/apache2/purescript.mustache b/embedded/license/apache2/purescript.mustache new file mode 100644 --- /dev/null +++ b/embedded/license/apache2/purescript.mustache @@ -0,0 +1,14 @@ +-- {{ 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/bsd3/purescript.mustache b/embedded/license/bsd3/purescript.mustache new file mode 100644 --- /dev/null +++ b/embedded/license/bsd3/purescript.mustache @@ -0,0 +1,27 @@ +-- {{ project }} +-- Copyright (c) {{ year }} {{ author }} +-- 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 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 OWNER 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. diff --git a/embedded/license/gpl2/purescript.mustache b/embedded/license/gpl2/purescript.mustache new file mode 100644 --- /dev/null +++ b/embedded/license/gpl2/purescript.mustache @@ -0,0 +1,17 @@ +-- {{ project }} +-- Copyright (c) {{ year }} {{ author }} +-- +-- This program is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or (at +-- your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, but +-- WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program; if not, write to the Free Software +-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +-- USA. diff --git a/embedded/license/gpl3/purescript.mustache b/embedded/license/gpl3/purescript.mustache new file mode 100644 --- /dev/null +++ b/embedded/license/gpl3/purescript.mustache @@ -0,0 +1,15 @@ +-- {{ project }} +-- Copyright (C) {{ year }} {{ author }} +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see http://www.gnu.org/licenses/. diff --git a/embedded/license/mit/purescript.mustache b/embedded/license/mit/purescript.mustache new file mode 100644 --- /dev/null +++ b/embedded/license/mit/purescript.mustache @@ -0,0 +1,22 @@ +-- The MIT License +-- +-- {{ project }} +-- Copyright (c) {{ year }} {{ author }} +-- +-- Permission is hereby granted, free of charge, to any person obtaining a copy +-- of this software and associated documentation files (the "Software"), to deal +-- in the Software without restriction, including without limitation the rights +-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +-- copies of the Software, and to permit persons to whom the Software is +-- furnished to do so, subject to the following conditions: +-- +-- The above copyright notice and this permission notice shall be included in +-- all copies or substantial portions of the Software. +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +-- THE SOFTWARE. diff --git a/embedded/license/mpl2/purescript.mustache b/embedded/license/mpl2/purescript.mustache new file mode 100644 --- /dev/null +++ b/embedded/license/mpl2/purescript.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,19 +1,24 @@ -cabal-version: 2.2 -name: headroom -version: 0.3.0.0 -license: BSD-3-Clause -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: - 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. +cabal-version: 2.2 -category: Utils -build-type: Simple +-- This file has been generated from package.yaml by hpack version 0.33.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: f49109b0113a73a61d4c99db85698fd193e3cbc6ffd87671cebaed06bcaa61f4 + +name: headroom +version: 0.3.1.0 +synopsis: License Header Manager +description: Would you like to have nice, up-to-date license/copyright headers in your source code files but hate to manage them by hand? Then Headroom is the right tool for you! Now you can define your license header as Mustache template, put all the variables (such as author's name, year, etc.) into the YAML config file and Headroom will take care to add such license headers to all your source code files. +category: Utils +homepage: https://github.com/vaclavsvejcar/headroom +bug-reports: https://github.com/vaclavsvejcar/headroom/issues +author: Vaclav Svejcar +maintainer: vaclav.svejcar@gmail.com +copyright: Copyright (c) 2019-2020 Vaclav Svejcar +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple extra-source-files: CHANGELOG.md LICENSE @@ -27,6 +32,7 @@ embedded/license/apache2/html.mustache embedded/license/apache2/java.mustache embedded/license/apache2/js.mustache + embedded/license/apache2/purescript.mustache embedded/license/apache2/rust.mustache embedded/license/apache2/scala.mustache embedded/license/apache2/shell.mustache @@ -37,6 +43,7 @@ embedded/license/bsd3/html.mustache embedded/license/bsd3/java.mustache embedded/license/bsd3/js.mustache + embedded/license/bsd3/purescript.mustache embedded/license/bsd3/rust.mustache embedded/license/bsd3/scala.mustache embedded/license/bsd3/shell.mustache @@ -47,6 +54,7 @@ embedded/license/gpl2/html.mustache embedded/license/gpl2/java.mustache embedded/license/gpl2/js.mustache + embedded/license/gpl2/purescript.mustache embedded/license/gpl2/rust.mustache embedded/license/gpl2/scala.mustache embedded/license/gpl2/shell.mustache @@ -57,6 +65,7 @@ embedded/license/gpl3/html.mustache embedded/license/gpl3/java.mustache embedded/license/gpl3/js.mustache + embedded/license/gpl3/purescript.mustache embedded/license/gpl3/rust.mustache embedded/license/gpl3/scala.mustache embedded/license/gpl3/shell.mustache @@ -67,6 +76,7 @@ embedded/license/mit/html.mustache embedded/license/mit/java.mustache embedded/license/mit/js.mustache + embedded/license/mit/purescript.mustache embedded/license/mit/rust.mustache embedded/license/mit/scala.mustache embedded/license/mit/shell.mustache @@ -77,6 +87,7 @@ embedded/license/mpl2/html.mustache embedded/license/mpl2/java.mustache embedded/license/mpl2/js.mustache + embedded/license/mpl2/purescript.mustache embedded/license/mpl2/rust.mustache embedded/license/mpl2/scala.mustache embedded/license/mpl2/shell.mustache @@ -97,6 +108,7 @@ 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/purescript/full.purs test-data/code-samples/rust/sample1.rs test-data/code-samples/scala/sample1.scala test-data/code-samples/scala/sample2.scala @@ -109,152 +121,143 @@ test-data/test-traverse/foo/bar/c.html source-repository head - type: git - location: https://github.com/vaclavsvejcar/headroom + type: git + location: https://github.com/vaclavsvejcar/headroom library - exposed-modules: - Headroom.Command - Headroom.Command.Gen - Headroom.Command.Init - Headroom.Command.Readers - Headroom.Command.Run - Headroom.Command.Types - Headroom.Command.Utils - Headroom.Configuration - Headroom.Configuration.Types - Headroom.Data.EnumExtra - Headroom.Data.Has - Headroom.Data.Lens - Headroom.Data.Regex - Headroom.Data.TextExtra - Headroom.Embedded - Headroom.Ext - Headroom.Ext.Haskell - Headroom.Ext.Haskell.Haddock - Headroom.FileSupport - Headroom.FileSupport.Types - Headroom.FileSystem - Headroom.FileType - Headroom.FileType.Types - Headroom.HeaderFn - Headroom.HeaderFn.Types - Headroom.HeaderFn.UpdateCopyright - Headroom.Meta - Headroom.Serialization - Headroom.Template - Headroom.Template.Mustache - Headroom.Types - Headroom.UI - Headroom.UI.Progress - Headroom.Variables - Headroom.Variables.Types - - hs-source-dirs: src - other-modules: Paths_headroom - autogen-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.7.1, - base >=4.7 && <5, - data-default-class >=0.1.2.0, - either >=5.0.1.1, - file-embed >=0.0.11.2, - microlens >=0.4.11.2, - microlens-th >=0.4.3.5, - mustache >=2.3.1, - optparse-applicative >=0.15.1.0, - pcre-heavy >=1.0.0.2, - pcre-light >=0.4.1.0, - rio >=0.1.17.0, - template-haskell >=2.15.0.0, - time >=1.9.3, - yaml >=0.11.4.0 + exposed-modules: + Headroom.Command + Headroom.Command.Gen + Headroom.Command.Init + Headroom.Command.Readers + Headroom.Command.Run + Headroom.Command.Types + Headroom.Command.Utils + Headroom.Configuration + Headroom.Configuration.Types + Headroom.Data.EnumExtra + Headroom.Data.Has + Headroom.Data.Lens + Headroom.Data.Regex + Headroom.Data.TextExtra + Headroom.Embedded + Headroom.Embedded.TH + Headroom.Ext + Headroom.Ext.Haskell + Headroom.Ext.Haskell.Haddock + Headroom.Ext.Java + Headroom.Ext.PureScript + Headroom.FileSupport + Headroom.FileSupport.Types + Headroom.FileSystem + Headroom.FileType + Headroom.FileType.Types + Headroom.HeaderFn + Headroom.HeaderFn.Types + Headroom.HeaderFn.UpdateCopyright + Headroom.Meta + Headroom.Serialization + Headroom.Template + Headroom.Template.Mustache + Headroom.Types + Headroom.UI + Headroom.UI.Progress + Headroom.Variables + Headroom.Variables.Types + other-modules: + Paths_headroom + autogen-modules: + Paths_headroom + hs-source-dirs: + src + 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 + , base >=4.7 && <5 + , data-default-class + , either + , file-embed + , microlens + , microlens-th + , mustache + , optparse-applicative + , pcre-heavy + , pcre-light + , rio + , template-haskell + , time + , yaml + default-language: Haskell2010 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, - rio >=0.1.17.0 + main-is: Main.hs + other-modules: + Paths_headroom + hs-source-dirs: + app + 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 + , optparse-applicative + , rio + default-language: Haskell2010 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.3, - optparse-applicative >=0.15.1.0, - rio >=0.1.17.0 + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + Paths_headroom + hs-source-dirs: + doctest + 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 + , optparse-applicative + , rio + default-language: Haskell2010 test-suite spec - type: exitcode-stdio-1.0 - main-is: Spec.hs - hs-source-dirs: test - other-modules: - Headroom.Command.InitSpec - Headroom.Command.ReadersSpec - Headroom.Command.RunSpec - Headroom.ConfigurationSpec - Headroom.Data.EnumExtraSpec - Headroom.Data.RegexSpec - Headroom.Data.TextExtraSpec - Headroom.Ext.Haskell.HaddockSpec - Headroom.Ext.HaskellSpec - Headroom.ExtSpec - Headroom.FileSupportSpec - Headroom.FileSystemSpec - Headroom.FileTypeSpec - Headroom.HeaderFn.TypesSpec - Headroom.HeaderFn.UpdateCopyrightSpec - Headroom.HeaderFnSpec - Headroom.SerializationSpec - Headroom.Template.MustacheSpec - Headroom.TypesSpec - Headroom.UI.ProgressSpec - Headroom.VariablesSpec - 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: - QuickCheck >=2.13.2, - aeson >=1.4.7.1, - base >=4.7 && <5, - headroom -any, - hspec >=2.7.1, - optparse-applicative >=0.15.1.0, - pcre-light >=0.4.1.0, - rio >=0.1.17.0, - time >=1.9.3 + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Headroom.Command.InitSpec + Headroom.Command.ReadersSpec + Headroom.Command.RunSpec + Headroom.ConfigurationSpec + Headroom.Data.EnumExtraSpec + Headroom.Data.RegexSpec + Headroom.Data.TextExtraSpec + Headroom.Ext.Haskell.HaddockSpec + Headroom.Ext.HaskellSpec + Headroom.Ext.JavaSpec + Headroom.Ext.PureScriptSpec + Headroom.ExtSpec + Headroom.FileSupportSpec + Headroom.FileSystemSpec + Headroom.FileTypeSpec + Headroom.HeaderFn.TypesSpec + Headroom.HeaderFn.UpdateCopyrightSpec + Headroom.HeaderFnSpec + Headroom.SerializationSpec + Headroom.Template.MustacheSpec + Headroom.TypesSpec + Headroom.UI.ProgressSpec + Headroom.VariablesSpec + Test.Utils + Paths_headroom + hs-source-dirs: + test + 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: + QuickCheck + , aeson + , base >=4.7 && <5 + , headroom + , hspec + , optparse-applicative + , pcre-light + , rio + , time + default-language: Haskell2010 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,9 +1,11 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} @@ -45,10 +47,10 @@ , defaultConfig , licenseTemplate ) -import Headroom.FileSystem ( createDirectory - , doesFileExist +import Headroom.FileSystem ( FileSystem(..) , fileExtension , findFiles + , mkFileSystem ) import Headroom.FileType ( fileTypeByExt ) import Headroom.FileType.Types ( FileType(..) ) @@ -73,15 +75,16 @@ -- | /RIO/ Environment for the @init@ command. data Env = Env - { envLogFunc :: !LogFunc - , envInitOptions :: !CommandInitOptions - , envPaths :: !Paths + { envLogFunc :: LogFunc + , envFileSystem :: FileSystem (RIO Env) + , envInitOptions :: CommandInitOptions + , envPaths :: Paths } -- | Paths to various locations of file system. data Paths = Paths - { pConfigFile :: !FilePath - , pTemplatesDir :: !FilePath + { pConfigFile :: FilePath + , pTemplatesDir :: FilePath } suffixLenses ''Env @@ -92,6 +95,9 @@ instance Has CommandInitOptions Env where hasLens = envInitOptionsL +instance Has (FileSystem (RIO Env)) Env where + hasLens = envFileSystemL + instance Has Paths Env where hasLens = envPathsL @@ -102,7 +108,11 @@ let paths = Paths { pConfigFile = ".headroom.yaml" , pTemplatesDir = "headroom-templates" } - pure $ Env { envLogFunc = logFunc, envInitOptions = opts, envPaths = paths } + pure $ Env { envLogFunc = logFunc + , envFileSystem = mkFileSystem + , envInitOptions = opts + , envPaths = paths + } -- | Handler for @init@ command. commandInit :: CommandInitOptions @@ -182,18 +192,28 @@ T.stripEnd . prettyPrintYAML $ M.fromList [(field :: Text, list)] -- | Checks whether application config file already exists. -doesAppConfigExist :: (HasLogFunc env, Has Paths env) => RIO env Bool +doesAppConfigExist :: ( HasLogFunc env + , Has (FileSystem (RIO env)) env + , Has Paths env + ) + => RIO env Bool doesAppConfigExist = do - Paths {..} <- viewL + FileSystem {..} <- viewL + Paths {..} <- viewL logInfo "Verifying that there's no existing Headroom configuration..." - doesFileExist pConfigFile + fsDoesFileExist pConfigFile -- | Creates directory for template files. -makeTemplatesDir :: (HasLogFunc env, Has Paths env) => RIO env () +makeTemplatesDir :: ( HasLogFunc env + , Has (FileSystem (RIO env)) env + , Has Paths env + ) + => RIO env () makeTemplatesDir = do - Paths {..} <- viewL + FileSystem {..} <- viewL + Paths {..} <- viewL logInfo $ "Creating directory for templates in " <> fromString pTemplatesDir - createDirectory pTemplatesDir + fsCreateDirectory pTemplatesDir --------------------------------- Error Types -------------------------------- 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 @@ -4,6 +4,7 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} @@ -54,11 +55,12 @@ , PtConfiguration , RunMode(..) , TemplateSource(..) - , cHeaderFnConfigsL ) import Headroom.Data.EnumExtra ( EnumExtra(..) ) import Headroom.Data.Has ( Has(..) ) -import Headroom.Data.Lens ( suffixLenses ) +import Headroom.Data.Lens ( suffixLenses + , suffixLensesFor + ) import Headroom.Data.TextExtra ( mapLines ) import Headroom.Embedded ( defaultConfig , licenseTemplate @@ -70,11 +72,10 @@ , replaceHeader ) import Headroom.FileSupport.Types ( FileInfo(..) ) -import Headroom.FileSystem ( excludePaths +import Headroom.FileSystem ( FileSystem(..) + , excludePaths , fileExtension - , findFilesByExts - , findFilesByTypes - , loadFile + , mkFileSystem ) import Headroom.FileType ( configByFileType , fileTypeByExt @@ -105,26 +106,29 @@ import qualified RIO.Text as T +suffixLensesFor ["cHeaderFnConfigs"] ''Configuration + + type TemplatesMap = Map FileType (Maybe TemplateMeta, TemplateType) -- | Action to be performed based on the selected 'RunMode'. data RunAction = RunAction - { raProcessed :: !Bool + { raProcessed :: Bool -- ^ whether the given file was processed - , raFunc :: !(Text -> Text) + , raFunc :: Text -> Text -- ^ function to process the file - , raProcessedMsg :: !Text + , raProcessedMsg :: Text -- ^ message to show when file was processed - , raSkippedMsg :: !Text + , raSkippedMsg :: Text -- ^ message to show when file was skipped } -- | Initial /RIO/ startup environment for the /Run/ command. data StartupEnv = StartupEnv - { envLogFunc :: !LogFunc + { envLogFunc :: LogFunc -- ^ logging function - , envRunOptions :: !CommandRunOptions + , envRunOptions :: CommandRunOptions -- ^ options } @@ -132,12 +136,14 @@ -- | Full /RIO/ environment for the /Run/ command. data Env = Env - { envEnv :: !StartupEnv + { envEnv :: StartupEnv -- ^ startup /RIO/ environment - , envConfiguration :: !CtConfiguration + , envConfiguration :: CtConfiguration -- ^ application configuration - , envCurrentYear :: !CurrentYear + , envCurrentYear :: CurrentYear -- ^ current year + , envFileSystem :: FileSystem (RIO Env) + -- ^ file system operations } suffixLenses ''Env @@ -169,10 +175,14 @@ instance Has CurrentYear Env where hasLens = envCurrentYearL +instance Has (FileSystem (RIO Env)) Env where + hasLens = envFileSystemL + env' :: CommandRunOptions -> LogFunc -> IO Env env' opts logFunc = do - let envEnv = StartupEnv { envLogFunc = logFunc, envRunOptions = opts } + let envEnv = StartupEnv { envLogFunc = logFunc, envRunOptions = opts } + envFileSystem = mkFileSystem envConfiguration <- runRIO envEnv finalConfiguration envCurrentYear <- currentYear pure Env { .. } @@ -214,13 +224,18 @@ when croDryRun $ logWarn "[!] Running with '--dry-run', no files are changed!" -findSourceFiles :: (Has CtConfiguration env, HasLogFunc env) +findSourceFiles :: ( Has CtConfiguration env + , Has (FileSystem (RIO env)) env + , HasLogFunc env + ) => [FileType] -> RIO env [FilePath] findSourceFiles fileTypes = do Configuration {..} <- viewL + FileSystem {..} <- viewL logDebug $ "Using source paths: " <> displayShow cSourcePaths - files <- mconcat <$> mapM (findFiles' cLicenseHeaders) cSourcePaths + files <- + mconcat <$> mapM (fsFindFilesByTypes cLicenseHeaders fileTypes) cSourcePaths let files' = excludePaths cExcludedPaths files logInfo $ mconcat [ "Found " @@ -230,7 +245,6 @@ , " file(s))" ] pure files' - where findFiles' licenseHeaders = findFilesByTypes licenseHeaders fileTypes processSourceFiles :: ( Has CtConfiguration env @@ -332,23 +346,25 @@ -- | Loads templates from the given paths. -loadTemplateFiles :: (HasLogFunc env) +loadTemplateFiles :: (Has (FileSystem (RIO env)) env, HasLogFunc env) => [FilePath] -- ^ paths to template files -> RIO env (Map FileType TemplateType) -- ^ map of file types and templates loadTemplateFiles paths' = do - paths <- mconcat <$> mapM (`findFilesByExts` extensions) paths' + FileSystem {..} <- viewL + paths <- mconcat <$> mapM (`fsFindFilesByExts` extensions) paths' logDebug $ "Using template paths: " <> displayShow paths withTypes <- catMaybes <$> mapM (\p -> fmap (, p) <$> typeOfTemplate p) paths - parsed <- mapM (\(t, p) -> (t, ) <$> load p) withTypes + parsed <- mapM + (\(t, p) -> + (t, ) <$> ((T.strip <$> fsLoadFile p) >>= parseTemplate (Just $ T.pack p)) + ) + withTypes logInfo $ mconcat ["Found ", display $ L.length parsed, " license template(s)"] pure $ M.fromList parsed - where - extensions = toList $ templateExtensions @TemplateType - load path = - liftIO $ (T.strip <$> loadFile path) >>= parseTemplate (Just $ T.pack path) + where extensions = toList $ templateExtensions @TemplateType -- | Loads built-in templates, stored in "Headroom.Embedded", for the given @@ -367,7 +383,10 @@ template = licenseTemplate licenseType -loadTemplates :: (Has CtConfiguration env, HasLogFunc env) +loadTemplates :: ( Has CtConfiguration env + , Has (FileSystem (RIO env)) env + , HasLogFunc env + ) => RIO env (Map FileType TemplateType) loadTemplates = do Configuration {..} <- viewL @CtConfiguration diff --git a/src/Headroom/Configuration.hs b/src/Headroom/Configuration.hs --- a/src/Headroom/Configuration.hs +++ b/src/Headroom/Configuration.hs @@ -2,6 +2,7 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} {-| Module : Headroom.Configuration @@ -52,17 +53,18 @@ , PtHeadersConfig , PtUpdateCopyrightConfig , UpdateCopyrightConfig(..) - , hfcConfigL - , hfcEnabledL - , hfcsUpdateCopyrightL - , hfcsUpdateCopyrightL - , uccSelectedAuthorsL ) +import Headroom.Data.Lens ( suffixLenses ) import Headroom.FileType.Types ( FileType(..) ) import RIO import qualified RIO.ByteString as B +suffixLenses ''HeaderFnConfig +suffixLenses ''HeaderFnConfigs +suffixLenses ''UpdateCopyrightConfig + + -- | Loads and parses application configuration from given /YAML/ file. loadConfiguration :: MonadIO m => FilePath @@ -105,16 +107,17 @@ -> m CtHeadersConfig -- ^ full 'CtHeadersConfig' makeHeadersConfig pt = do - hscC <- makeHeaderConfig C (hscC pt) - hscCpp <- makeHeaderConfig CPP (hscCpp pt) - hscCss <- makeHeaderConfig CSS (hscCss pt) - hscHaskell <- makeHeaderConfig Haskell (hscHaskell pt) - hscHtml <- makeHeaderConfig HTML (hscHtml pt) - hscJava <- makeHeaderConfig Java (hscJava pt) - hscJs <- makeHeaderConfig JS (hscJs pt) - hscRust <- makeHeaderConfig Rust (hscRust pt) - hscScala <- makeHeaderConfig Scala (hscScala pt) - hscShell <- makeHeaderConfig Shell (hscShell pt) + hscC <- makeHeaderConfig C (hscC pt) + hscCpp <- makeHeaderConfig CPP (hscCpp pt) + hscCss <- makeHeaderConfig CSS (hscCss pt) + hscHaskell <- makeHeaderConfig Haskell (hscHaskell pt) + hscHtml <- makeHeaderConfig HTML (hscHtml pt) + hscJava <- makeHeaderConfig Java (hscJava pt) + hscJs <- makeHeaderConfig JS (hscJs pt) + hscPureScript <- makeHeaderConfig PureScript (hscPureScript pt) + hscRust <- makeHeaderConfig Rust (hscRust pt) + hscScala <- makeHeaderConfig Scala (hscScala pt) + hscShell <- makeHeaderConfig Shell (hscShell pt) pure HeadersConfig { .. } diff --git a/src/Headroom/Configuration/Types.hs b/src/Headroom/Configuration/Types.hs --- a/src/Headroom/Configuration/Types.hs +++ b/src/Headroom/Configuration/Types.hs @@ -8,7 +8,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} @@ -66,18 +66,6 @@ , LicenseType(..) , RunMode(..) , TemplateSource(..) - -- * Lenses - , cRunModeL - , cSourcePathsL - , cExcludedPathsL - , cTemplateSourceL - , cVariablesL - , cLicenseHeadersL - , cHeaderFnConfigsL - , uccSelectedAuthorsL - , hfcEnabledL - , hfcConfigL - , hfcsUpdateCopyrightL ) where @@ -91,7 +79,6 @@ ) import Data.Monoid ( Last(..) ) import Headroom.Data.EnumExtra ( EnumExtra(..) ) -import Headroom.Data.Lens ( suffixLenses ) import Headroom.Data.Regex ( Regex(..) ) import Headroom.FileType.Types ( FileType ) import Headroom.Serialization ( aesonOptions ) @@ -125,17 +112,17 @@ -- | Syntax of the license header comment. data HeaderSyntax - = BlockComment !Text !Text + = BlockComment Text Text -- ^ block (multi-line) comment syntax (e.g. @/* */@) - | LineComment !Text + | LineComment Text -- ^ single line comment syntax (e.g. @//@) deriving (Eq, Show) -- | Internal representation of the block style of 'HeaderSyntax'. data BlockComment' = BlockComment' - { bcStartsWith :: !Text + { bcStartsWith :: Text -- ^ starting pattern (e.g. @/*@) - , bcEndsWith :: !Text + , bcEndsWith :: Text -- ^ ending pattern (e.g. @*/@) } deriving (Eq, Generic, Show) @@ -203,7 +190,7 @@ data GenMode = GenConfigFile -- ^ generate /YAML/ config file stub - | GenLicense !(LicenseType, FileType) + | GenLicense (LicenseType, FileType) -- ^ generate license header template deriving (Eq, Show) @@ -224,7 +211,7 @@ -- | Main configuration for the "Headroom.HeaderFn.UpdateCopyright" -- /license header function/. data UpdateCopyrightConfig (p :: Phase) = UpdateCopyrightConfig - { uccSelectedAuthors :: !(p ::: Maybe (NonEmpty Text)) + { uccSelectedAuthors :: p ::: Maybe (NonEmpty Text) -- ^ if specified, years will be updated only in copyright statements of -- given authors } @@ -258,9 +245,9 @@ -- | Configuration for selected /license header function/. data HeaderFnConfig (p :: Phase) c = HeaderFnConfig - { hfcEnabled :: !(p ::: Bool) + { hfcEnabled :: p ::: Bool -- ^ whether this function is enabled or not - , hfcConfig :: !(c p) + , hfcConfig :: c p -- ^ custom configuration of the /license header function/ } @@ -295,7 +282,7 @@ -- | Configuration of all known /license header functions/. data HeaderFnConfigs (p :: Phase) = HeaderFnConfigs - { hfcsUpdateCopyright :: !(HeaderFnConfig p UpdateCopyrightConfig) + { hfcsUpdateCopyright :: HeaderFnConfig p UpdateCopyrightConfig -- ^ configuration for the "Headroom.HeaderFn.UpdateCopyright" -- /license header function/ } @@ -329,19 +316,19 @@ -- | Application configuration. data Configuration (p :: Phase) = Configuration - { cRunMode :: !(p ::: RunMode) + { cRunMode :: p ::: RunMode -- ^ mode of the @run@ command - , cSourcePaths :: !(p ::: [FilePath]) + , cSourcePaths :: p ::: [FilePath] -- ^ paths to source code files - , cExcludedPaths :: !(p ::: [Regex]) + , cExcludedPaths :: p ::: [Regex] -- ^ excluded source paths - , cTemplateSource :: !(p ::: TemplateSource) + , cTemplateSource :: p ::: TemplateSource -- ^ source of license templates - , cVariables :: !Variables + , cVariables :: Variables -- ^ variable values for templates - , cLicenseHeaders :: !(HeadersConfig p) + , cLicenseHeaders :: HeadersConfig p -- ^ configuration of license headers - , cHeaderFnConfigs :: !(HeaderFnConfigs p) + , cHeaderFnConfigs :: HeaderFnConfigs p -- ^ configuration of license header functions } @@ -387,17 +374,17 @@ -- | Configuration for specific license header. data HeaderConfig (p :: Phase) = HeaderConfig - { hcFileExtensions :: !(p ::: [Text]) + { hcFileExtensions :: p ::: [Text] -- ^ list of file extensions (without dot) - , hcMarginAfter :: !(p ::: Int) + , hcMarginAfter :: p ::: Int -- ^ number of empty lines to put after header - , hcMarginBefore :: !(p ::: Int) + , hcMarginBefore :: p ::: Int -- ^ number of empty lines to put before header - , hcPutAfter :: !(p ::: [Regex]) + , hcPutAfter :: p ::: [Regex] -- ^ /regexp/ patterns after which to put the header - , hcPutBefore :: !(p ::: [Regex]) + , hcPutBefore :: p ::: [Regex] -- ^ /regexp/ patterns before which to put the header - , hcHeaderSyntax :: !(p ::: HeaderSyntax) + , hcHeaderSyntax :: p ::: HeaderSyntax -- ^ syntax of the license header comment } @@ -447,25 +434,27 @@ -- | Group of 'HeaderConfig' configurations for supported file types. data HeadersConfig (p :: Phase) = HeadersConfig - { hscC :: !(HeaderConfig p) + { hscC :: HeaderConfig p -- ^ configuration for /C/ programming language - , hscCpp :: !(HeaderConfig p) + , hscCpp :: HeaderConfig p -- ^ configuration for /C++/ programming language - , hscCss :: !(HeaderConfig p) + , hscCss :: HeaderConfig p -- ^ configuration for /CSS/ - , hscHaskell :: !(HeaderConfig p) + , hscHaskell :: HeaderConfig p -- ^ configuration for /Haskell/ programming language - , hscHtml :: !(HeaderConfig p) + , hscHtml :: HeaderConfig p -- ^ configuration for /HTML/ - , hscJava :: !(HeaderConfig p) + , hscJava :: HeaderConfig p -- ^ configuration for /Java/ programming language - , hscJs :: !(HeaderConfig p) + , hscJs :: HeaderConfig p -- ^ configuration for /JavaScript/ programming language - , hscRust :: !(HeaderConfig p) + , hscPureScript :: HeaderConfig p + -- ^ configuration for /PureScript/ programming language + , hscRust :: HeaderConfig p -- ^ configuration for /Rust/ programming language - , hscScala :: !(HeaderConfig p) + , hscScala :: HeaderConfig p -- ^ configuration for /Scala/ programming language - , hscShell :: !(HeaderConfig p) + , hscShell :: HeaderConfig p -- ^ configuration for /Shell/ } @@ -482,30 +471,32 @@ instance FromJSON PtHeadersConfig where parseJSON = withObject "PartialHeadersConfig" $ \obj -> do - hscC <- obj .:? "c" .!= mempty - hscCpp <- obj .:? "cpp" .!= mempty - hscCss <- obj .:? "css" .!= mempty - hscHaskell <- obj .:? "haskell" .!= mempty - hscHtml <- obj .:? "html" .!= mempty - hscJava <- obj .:? "java" .!= mempty - hscJs <- obj .:? "js" .!= mempty - hscRust <- obj .:? "rust" .!= mempty - hscScala <- obj .:? "scala" .!= mempty - hscShell <- obj .:? "shell" .!= mempty + hscC <- obj .:? "c" .!= mempty + hscCpp <- obj .:? "cpp" .!= mempty + hscCss <- obj .:? "css" .!= mempty + hscHaskell <- obj .:? "haskell" .!= mempty + hscHtml <- obj .:? "html" .!= mempty + hscJava <- obj .:? "java" .!= mempty + hscJs <- obj .:? "js" .!= mempty + hscPureScript <- obj .:? "purescript" .!= mempty + hscRust <- obj .:? "rust" .!= mempty + hscScala <- obj .:? "scala" .!= mempty + hscShell <- obj .:? "shell" .!= mempty pure HeadersConfig { .. } instance Semigroup PtHeadersConfig where - x <> y = HeadersConfig { hscC = hscC x <> hscC y - , hscCpp = hscCpp x <> hscCpp y - , hscCss = hscCss x <> hscCss y - , hscHaskell = hscHaskell x <> hscHaskell y - , hscHtml = hscHtml x <> hscHtml y - , hscJava = hscJava x <> hscJava y - , hscJs = hscJs x <> hscJs y - , hscRust = hscRust x <> hscRust y - , hscScala = hscScala x <> hscScala y - , hscShell = hscShell x <> hscShell y + x <> y = HeadersConfig { hscC = hscC x <> hscC y + , hscCpp = hscCpp x <> hscCpp y + , hscCss = hscCss x <> hscCss y + , hscHaskell = hscHaskell x <> hscHaskell y + , hscHtml = hscHtml x <> hscHtml y + , hscJava = hscJava x <> hscJava y + , hscJs = hscJs x <> hscJs y + , hscPureScript = hscPureScript x <> hscPureScript y + , hscRust = hscRust x <> hscRust y + , hscScala = hscScala x <> hscScala y + , hscShell = hscShell x <> hscShell y } @@ -520,23 +511,24 @@ mempty mempty mempty + mempty --------------------------------- Error Types -------------------------------- -- | Represents single key in the configuration. data ConfigurationKey - = CkFileExtensions !FileType + = CkFileExtensions FileType -- ^ no configuration for @file-extensions@ - | CkHeaderSyntax !FileType + | CkHeaderSyntax FileType -- ^ no configuration for header syntax - | CkMarginAfter !FileType + | CkMarginAfter FileType -- ^ no configuration for @margin-after@ - | CkMarginBefore !FileType + | CkMarginBefore FileType -- ^ no configuration for @margin-before@ - | CkPutAfter !FileType + | CkPutAfter FileType -- ^ no configuration for @put-after@ - | CkPutBefore !FileType + | CkPutBefore FileType -- ^ no configuration for @put-before@ | CkRunMode -- ^ no configuration for @run-mode@ @@ -555,7 +547,7 @@ -- | Exception specific to the "Headroom.Configuration" module. data ConfigurationError - = MissingConfiguration !ConfigurationKey + = MissingConfiguration ConfigurationKey -- ^ some of the required configuration keys has not been specified | MixedHeaderSyntax -- ^ illegal configuration for 'HeaderSyntax' @@ -631,11 +623,3 @@ cliText = fmap (\c -> "command line option '" <> c <> "'") cli yamlText = fmap (\y -> "YAML option '" <> y <> "'") yaml options = T.intercalate " or " . catMaybes $ [cliText, yamlText] - - ------------------------------------ LENSES ----------------------------------- - -suffixLenses ''Configuration -suffixLenses ''UpdateCopyrightConfig -suffixLenses ''HeaderFnConfig -suffixLenses ''HeaderFnConfigs diff --git a/src/Headroom/Data/Regex.hs b/src/Headroom/Data/Regex.hs --- a/src/Headroom/Data/Regex.hs +++ b/src/Headroom/Data/Regex.hs @@ -28,6 +28,8 @@ , re , replace , scan + -- * Unsafe Functions + , compileUnsafe ) where @@ -111,14 +113,19 @@ scan (Regex regex) = PH.scan regex ------------------------------- PRIVATE FUNCTIONS ----------------------------- - - -compileUnsafe :: Text -> Regex +-- | Compiles the given text into /regex/ in runtime. Note that if the /regex/ +-- cannot be compiled, it will throw runtime error. Do not use this function +-- unless you know what you're doing. +compileUnsafe :: Text + -- ^ /regex/ to compile + -> Regex + -- ^ compiled /regex/ or runtime exception compileUnsafe raw = case compile raw of Left err -> error . displayException $ err Right res -> res + +------------------------------ PRIVATE FUNCTIONS ----------------------------- quoteExpRegex :: String -> ExpQ quoteExpRegex txt = [| compileUnsafe . T.pack $ txt |] diff --git a/src/Headroom/Embedded.hs b/src/Headroom/Embedded.hs --- a/src/Headroom/Embedded.hs +++ b/src/Headroom/Embedded.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TemplateHaskell #-} @@ -20,21 +21,23 @@ ) where -import Data.FileEmbed ( embedStringFile ) import Headroom.Configuration.Types ( LicenseType(..) ) +import Headroom.Embedded.TH ( embedConfigFile + , embedDefaultConfig + , embedTemplate + ) import Headroom.FileType.Types ( FileType(..) ) import RIO - -- | Content of dummy /YAML/ configuration file for the application. configFileStub :: IsString a => a -configFileStub = $(embedStringFile "embedded/config-file.yaml") +configFileStub = $(embedConfigFile) -- | Default /YAML/ configuration. defaultConfig :: IsString a => a -defaultConfig = $(embedStringFile "embedded/default-config.yaml") +defaultConfig = $(embedDefaultConfig) -- | License template for given license. @@ -47,68 +50,74 @@ -- ^ 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") + C -> $(embedTemplate Apache2 C) + CPP -> $(embedTemplate Apache2 CPP) + CSS -> $(embedTemplate Apache2 CSS) + Haskell -> $(embedTemplate Apache2 Haskell) + HTML -> $(embedTemplate Apache2 HTML) + Java -> $(embedTemplate Apache2 Java) + JS -> $(embedTemplate Apache2 JS) + PureScript -> $(embedTemplate Apache2 PureScript) + Rust -> $(embedTemplate Apache2 Rust) + Scala -> $(embedTemplate Apache2 Scala) + Shell -> $(embedTemplate Apache2 Shell) 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") + C -> $(embedTemplate BSD3 C) + CPP -> $(embedTemplate BSD3 CPP) + CSS -> $(embedTemplate BSD3 CSS) + Haskell -> $(embedTemplate BSD3 Haskell) + HTML -> $(embedTemplate BSD3 HTML) + Java -> $(embedTemplate BSD3 Java) + JS -> $(embedTemplate BSD3 JS) + PureScript -> $(embedTemplate BSD3 PureScript) + Rust -> $(embedTemplate BSD3 Rust) + Scala -> $(embedTemplate BSD3 Scala) + Shell -> $(embedTemplate BSD3 Shell) 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") + C -> $(embedTemplate GPL2 C) + CPP -> $(embedTemplate GPL2 CPP) + CSS -> $(embedTemplate GPL2 CSS) + Haskell -> $(embedTemplate GPL2 Haskell) + HTML -> $(embedTemplate GPL2 HTML) + Java -> $(embedTemplate GPL2 Java) + JS -> $(embedTemplate GPL2 JS) + PureScript -> $(embedTemplate GPL2 PureScript) + Rust -> $(embedTemplate GPL2 Rust) + Scala -> $(embedTemplate GPL2 Scala) + Shell -> $(embedTemplate GPL2 Shell) 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") + C -> $(embedTemplate GPL3 C) + CPP -> $(embedTemplate GPL3 CPP) + CSS -> $(embedTemplate GPL3 CSS) + Haskell -> $(embedTemplate GPL3 Haskell) + HTML -> $(embedTemplate GPL3 HTML) + Java -> $(embedTemplate GPL3 Java) + JS -> $(embedTemplate GPL3 JS) + PureScript -> $(embedTemplate GPL3 PureScript) + Rust -> $(embedTemplate GPL3 Rust) + Scala -> $(embedTemplate GPL3 Scala) + Shell -> $(embedTemplate GPL3 Shell) 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") + C -> $(embedTemplate MIT C) + CPP -> $(embedTemplate MIT CPP) + CSS -> $(embedTemplate MIT CSS) + Haskell -> $(embedTemplate MIT Haskell) + HTML -> $(embedTemplate MIT HTML) + Java -> $(embedTemplate MIT Java) + JS -> $(embedTemplate MIT JS) + PureScript -> $(embedTemplate MIT PureScript) + Rust -> $(embedTemplate MIT Rust) + Scala -> $(embedTemplate MIT Scala) + Shell -> $(embedTemplate MIT Shell) 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") + C -> $(embedTemplate MPL2 C) + CPP -> $(embedTemplate MPL2 CPP) + CSS -> $(embedTemplate MPL2 CSS) + Haskell -> $(embedTemplate MPL2 Haskell) + HTML -> $(embedTemplate MPL2 HTML) + Java -> $(embedTemplate MPL2 Java) + JS -> $(embedTemplate MPL2 JS) + PureScript -> $(embedTemplate MPL2 PureScript) + Rust -> $(embedTemplate MPL2 Rust) + Scala -> $(embedTemplate MPL2 Scala) + Shell -> $(embedTemplate MPL2 Shell) diff --git a/src/Headroom/Embedded/TH.hs b/src/Headroom/Embedded/TH.hs new file mode 100644 --- /dev/null +++ b/src/Headroom/Embedded/TH.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeApplications #-} + +{-| +Module : Headroom.Embedded.TH +Description : /Template Haskell/ functions for "Headroom.Embedded" +Copyright : (c) 2019-2020 Vaclav Svejcar +License : BSD-3-Clause +Maintainer : vaclav.svejcar@gmail.com +Stability : experimental +Portability : POSIX + +This module contains some /Template Haskell/ powered functions, used by +"Headroom.Embedded" module, that needs to be placed in separated module, due to +/GHC/ stage restriction. +-} + +module Headroom.Embedded.TH + ( embedConfigFile + , embedDefaultConfig + , embedTemplate + ) +where + +import Data.FileEmbed ( embedStringFile ) +import Headroom.Configuration.Types ( LicenseType(..) ) +import Headroom.Data.EnumExtra ( EnumExtra(..) ) +import Headroom.FileType.Types ( FileType(..) ) +import Headroom.Meta ( TemplateType ) +import Headroom.Template ( Template(..) ) +import Language.Haskell.TH.Syntax ( Exp + , Q + ) +import RIO +import qualified RIO.NonEmpty as NE +import qualified RIO.Text as T + + +-- | Embeds stub configuration file to source code. +embedConfigFile :: Q Exp +embedConfigFile = embedStringFile "embedded/config-file.yaml" + + +-- | Embeds default configuration file to source code. +embedDefaultConfig :: Q Exp +embedDefaultConfig = embedStringFile "embedded/default-config.yaml" + + +-- | Embeds /template file/ to the source code. +embedTemplate :: LicenseType + -- ^ type of the /license/ + -> FileType + -- ^ type of the source code file + -> Q Exp + -- ^ content of the appropriate /template/ file +embedTemplate lt ft = (embedStringFile . mconcat) + ["embedded/license/", toStringLC lt, "/", toStringLC ft, ".", ext] + where ext = T.unpack . NE.head $ templateExtensions @TemplateType + + +------------------------------ PRIVATE FUNCTIONS ----------------------------- + +toStringLC :: EnumExtra a => a -> String +toStringLC = T.unpack . T.toLower . enumToText diff --git a/src/Headroom/Ext.hs b/src/Headroom/Ext.hs --- a/src/Headroom/Ext.hs +++ b/src/Headroom/Ext.hs @@ -25,6 +25,8 @@ import Headroom.Configuration.Types ( CtHeaderConfig ) import qualified Headroom.Ext.Haskell as Haskell +import qualified Headroom.Ext.Java as Java +import qualified Headroom.Ext.PureScript as PureScript import Headroom.FileType.Types ( FileType(..) ) import Headroom.Template ( Template(..) ) import Headroom.Types ( TemplateMeta(..) ) @@ -35,7 +37,9 @@ -- | Extracts variables specific to the file type (if supported), e.g. module -- name for /Haskell/ source code. Currently supported file types are: -- --- * /Haskell/ - implemented in "Headroom.FileSupport.Haskell" +-- * /Haskell/ - implemented in "Headroom.Ext.Haskell" +-- * /Java/ - implemented in "Headroom.Ext.Java" +-- * /PureScript/ - implemented in "Headroom.Ext.PureScript" extractVariables :: FileType -- ^ type of the file -> CtHeaderConfig @@ -48,9 +52,11 @@ -- ^ text of the source code file -> Variables -- ^ extracted variables -extractVariables fileType config meta headerPos text = case fileType of - Haskell -> Haskell.extractVariables config meta headerPos text - _ -> mempty +extractVariables fileType = case fileType of + Haskell -> Haskell.extractVariables + Java -> Java.extractVariables + PureScript -> PureScript.extractVariables + _ -> mempty -- | Extracts medatata from given /template/ for selected /file type/, which diff --git a/src/Headroom/Ext/Haskell.hs b/src/Headroom/Ext/Haskell.hs --- a/src/Headroom/Ext/Haskell.hs +++ b/src/Headroom/Ext/Haskell.hs @@ -7,7 +7,7 @@ {-| Module : Headroom.Ext.Haskell -Description : Extraction of /Haskell/-specific template variables +Description : Extended support for /Haskell/ source code files Copyright : (c) 2019-2020 Vaclav Svejcar License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com diff --git a/src/Headroom/Ext/Java.hs b/src/Headroom/Ext/Java.hs new file mode 100644 --- /dev/null +++ b/src/Headroom/Ext/Java.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TupleSections #-} + +{-| +Module : Headroom.Ext.Java +Description : Extended support for /Java/ source code files +Copyright : (c) 2019-2020 Vaclav Svejcar +License : BSD-3-Clause +Maintainer : vaclav.svejcar@gmail.com +Stability : experimental +Portability : POSIX + +This module provides /extended support/ for /Java/ source code files. Current +implementation includes extracting of /package name/ from currently processed +/Java/ source code file. +-} + +module Headroom.Ext.Java + ( extractVariables + , extractPackageName + ) +where + +import Headroom.Configuration.Types ( CtHeaderConfig ) +import Headroom.Data.Regex ( match + , re + ) +import Headroom.Data.TextExtra ( toLines ) +import Headroom.Types ( TemplateMeta(..) ) +import Headroom.Variables ( mkVariables ) +import Headroom.Variables.Types ( Variables(..) ) +import RIO +import RIO.Lens ( ix ) + + +-- | Extracts name of /Java/ package from given source code file content. +-- +-- >>> extractPackageName "package mypackage;\nclass Foo {}" +-- Just "mypackage" +extractPackageName :: Text + -- ^ input text + -> Maybe Text + -- ^ extracted package name +extractPackageName = go . toLines + where + go [] = Nothing + go (x : xs) = maybe (go xs) (^? ix 1) (match [re|^package (.*);$|] x) + + +-- | Extracts variables from /Java/ source code. +-- +-- __List of Extracted Variables:__ +-- +-- * @___java_package_name__@ - name of the /Java/ package +extractVariables :: CtHeaderConfig + -- ^ license header configuration + -> Maybe TemplateMeta + -- ^ extracted metadata from corresponding /template/ + -> Maybe (Int, Int) + -- ^ license header position @(startLine, endLine)@ + -> Text + -- ^ input text + -> Variables + -- ^ extracted variables +extractVariables _ _ _ text = (mkVariables . catMaybes) + [("_java_package_name", ) <$> extractPackageName text] diff --git a/src/Headroom/Ext/PureScript.hs b/src/Headroom/Ext/PureScript.hs new file mode 100644 --- /dev/null +++ b/src/Headroom/Ext/PureScript.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} + +{-| +Module : Headroom.Ext.PureScript +Description : Extended support for /PureScript/ source code files +Copyright : (c) 2019-2020 Vaclav Svejcar +License : BSD-3-Clause +Maintainer : vaclav.svejcar@gmail.com +Stability : experimental +Portability : POSIX + +This module provides /extended support/ for /PureScript/ source code files. +Current implementation includes extracting of /module name/ from currently +processed /PureScript/ source code file. +-} + +module Headroom.Ext.PureScript where + +import Headroom.Configuration.Types ( CtHeaderConfig ) +import Headroom.Ext.Haskell ( extractModuleName ) +import Headroom.Types ( TemplateMeta(..) ) +import Headroom.Variables ( mkVariables ) +import Headroom.Variables.Types ( Variables(..) ) +import RIO + + +-- | Extracts variables from /PureScript/ source code. +-- +-- __List of Extracted Variables:__ +-- +-- * @___purescript_module_name__@ - name of the /PureScript/ module +extractVariables :: CtHeaderConfig + -- ^ license header configuration + -> Maybe TemplateMeta + -- ^ extracted metadata from corresponding /template/ + -> Maybe (Int, Int) + -- ^ license header position @(startLine, endLine)@ + -> Text + -- ^ input text + -> Variables + -- ^ extracted variables +extractVariables _ _ _ text = (mkVariables . catMaybes) + [("_purescript_module_name", ) <$> extractModuleName text] + + diff --git a/src/Headroom/FileSupport.hs b/src/Headroom/FileSupport.hs --- a/src/Headroom/FileSupport.hs +++ b/src/Headroom/FileSupport.hs @@ -1,6 +1,7 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} {-| Module : Headroom.FileSupport @@ -36,6 +37,7 @@ , HeaderConfig(..) , HeaderSyntax(..) ) +import Headroom.Data.Lens ( suffixLensesFor ) import Headroom.Data.Regex ( Regex , match ) @@ -43,9 +45,7 @@ , toLines ) import Headroom.Ext ( extractVariables ) -import Headroom.FileSupport.Types ( FileInfo(..) - , fiHeaderPosL - ) +import Headroom.FileSupport.Types ( FileInfo(..) ) import Headroom.FileType.Types ( FileType(..) ) import Headroom.Types ( TemplateMeta(..) ) import RIO @@ -53,6 +53,9 @@ import qualified RIO.Text as T +suffixLensesFor ["fiHeaderPos"] ''FileInfo + + -- | Extracts info about the processed file to be later used by the header -- detection/manipulation functions. extractFileInfo :: FileType @@ -68,7 +71,7 @@ extractFileInfo fiFileType fiHeaderConfig meta text = let fiHeaderPos = findHeader fiHeaderConfig text fiVariables = - extractVariables fiFileType fiHeaderConfig meta fiHeaderPos text + extractVariables fiFileType fiHeaderConfig meta fiHeaderPos text in FileInfo { .. } diff --git a/src/Headroom/FileSupport/Types.hs b/src/Headroom/FileSupport/Types.hs --- a/src/Headroom/FileSupport/Types.hs +++ b/src/Headroom/FileSupport/Types.hs @@ -1,5 +1,4 @@ {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE TemplateHaskell #-} {-| Module : Headroom.FileSupport.Types @@ -16,16 +15,10 @@ module Headroom.FileSupport.Types ( -- * Data Types FileInfo(..) - -- * Lenses - , fiFileTypeL - , fiHeaderConfigL - , fiHeaderPosL - , fiVariablesL ) where import Headroom.Configuration.Types ( CtHeaderConfig ) -import Headroom.Data.Lens ( suffixLenses ) import Headroom.FileType.Types ( FileType ) import Headroom.Variables.Types ( Variables ) import RIO @@ -43,5 +36,3 @@ -- ^ additional extracted variables } deriving (Eq, Show) - -suffixLenses ''FileInfo diff --git a/src/Headroom/FileSystem.hs b/src/Headroom/FileSystem.hs --- a/src/Headroom/FileSystem.hs +++ b/src/Headroom/FileSystem.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ViewPatterns #-} {-| Module : Headroom.FileSystem @@ -14,16 +15,24 @@ -} module Headroom.FileSystem - ( -- * Traversing the File System - findFiles + ( -- * Type Aliases + CreateDirectoryFn + , DoesFileExistFn + , FindFilesFn + , FindFilesByExtsFn + , FindFilesByTypesFn + , GetCurrentDirectoryFn + , ListFilesFn + , LoadFileFn + -- * Polymorphic Record + , FileSystem(..) + , mkFileSystem + -- * Traversing the File System + , findFiles , findFilesByExts , findFilesByTypes , listFiles , loadFile - -- * Working with Files/Directories - , doesFileExist - , getCurrentDirectory - , createDirectory -- * Working with Files Metadata , fileExtension -- * Other @@ -52,51 +61,146 @@ import qualified RIO.Text as T +-------------------------------- TYPE ALIASES -------------------------------- +-- | Type of a function that creates new empty directory on the given path. +type CreateDirectoryFn m + = FilePath + -- ^ path of new directory + -> m () + -- ^ /IO/ action result + + +-- | Type of a function that returns 'True' if the argument file exists and is +-- not a directory, and 'False' otherwise. +type DoesFileExistFn m + = FilePath + -- ^ path to check + -> m Bool + -- ^ whether the given path is existing file + + +-- | Type of a function that recursively finds files on given path whose +-- filename matches the predicate. +type FindFilesFn m + = FilePath + -- ^ path to search + -> (FilePath -> Bool) + -- ^ predicate to match filename + -> m [FilePath] + -- ^ found files + + +-- | Type of a function that recursively finds files on given path by file +-- extensions. +type FindFilesByExtsFn m + = FilePath + -- ^ path to search + -> [Text] + -- ^ list of file extensions (without dot) + -> m [FilePath] + -- ^ list of found files + + +-- | Type of a function that recursively find files on given path by their +-- file types. +type FindFilesByTypesFn m + = CtHeadersConfig + -- ^ configuration of license headers + -> [FileType] + -- ^ list of file types + -> FilePath + -- ^ path to search + -> m [FilePath] + -- ^ list of found files + + +-- | Type of a function that obtains the current working directory as an +-- absolute path. +type GetCurrentDirectoryFn m = m FilePath + + +-- | Type of a function that recursively find all files on given path. If file +-- reference is passed instead of directory, such file path is returned. +type ListFilesFn m + = FilePath + -- ^ path to search + -> m [FilePath] + -- ^ list of found files + +-- | Type of a function that loads file content in UTF8 encoding. +type LoadFileFn m + = FilePath + -- ^ file path + -> m Text + -- ^ file content + +----------------------------- POLYMORPHIC RECORD ----------------------------- + +-- | /Polymorphic record/ composed of file system /IO/ function types, allowing +-- to abstract over concrete implementation. Whenever you need to use effectful +-- functions from this module, consider using this record instead of using them +-- directly, as it allows you to use different records for production code and +-- for testing, which is not as easy if you wire some of the provided functions +-- directly. +data FileSystem m = FileSystem + { fsCreateDirectory :: CreateDirectoryFn m + -- ^ Function that creates new empty directory on the given path. + , fsDoesFileExist :: DoesFileExistFn m + -- ^ Function that returns 'True' if the argument file exists and is not + -- a directory, and 'False' otherwise. + , fsFindFiles :: FindFilesFn m + -- ^ Function that recursively finds files on given path whose filename + -- matches the predicate. + , fsFindFilesByExts :: FindFilesByExtsFn m + -- ^ Function that recursively finds files on given path by file extensions. + , fsFindFilesByTypes :: FindFilesByTypesFn m + -- ^ Function that recursively find files on given path by their file types. + , fsGetCurrentDirectory :: GetCurrentDirectoryFn m + -- ^ Function that obtains the current working directory as an absolute path. + , fsListFiles :: ListFilesFn m + -- ^ Function that recursively find all files on given path. If file reference + -- is passed instead of directory, such file path is returned. + , fsLoadFile :: LoadFileFn m + -- ^ Function that loads file content in UTF8 encoding. + } + + +-- | Creates new 'FileSystem' that performs actual disk /IO/ operations. +mkFileSystem :: MonadIO m => FileSystem m +mkFileSystem = FileSystem { fsCreateDirectory = createDirectory + , fsDoesFileExist = doesFileExist + , fsFindFiles = findFiles + , fsFindFilesByExts = findFilesByExts + , fsFindFilesByTypes = findFilesByTypes + , fsGetCurrentDirectory = getCurrentDirectory + , fsListFiles = listFiles + , fsLoadFile = loadFile + } + + +------------------------------ PUBLIC FUNCTIONS ------------------------------ + -- | 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 :: MonadIO m => FindFilesFn m 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 :: MonadIO m => FindFilesByExtsFn m 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 - => CtHeadersConfig - -- ^ configuration of license headers - -> [FileType] - -- ^ list of file types - -> FilePath - -- ^ path to search - -> m [FilePath] - -- ^ list of found files +findFilesByTypes :: MonadIO m => FindFilesByTypesFn m 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 - => FilePath - -- ^ path to search - -> m [FilePath] - -- ^ list of found files +listFiles :: MonadIO m => ListFilesFn m listFiles fileOrDir = do isDir <- doesDirectoryExist fileOrDir if isDir then listDirectory fileOrDir else pure [fileOrDir] @@ -115,18 +219,16 @@ -- -- >>> fileExtension "path/to/some/file.txt" -- Just "txt" -fileExtension :: FilePath -> Maybe Text -fileExtension path = case takeExtension path of - '.' : xs -> Just $ T.pack xs - _ -> Nothing +fileExtension :: FilePath + -- ^ path from which to extract file extension + -> Maybe Text + -- ^ extracted file extension +fileExtension (takeExtension -> '.' : xs) = Just $ T.pack xs +fileExtension _ = Nothing -- | Loads file content in UTF8 encoding. -loadFile :: MonadIO m - => FilePath - -- ^ file path - -> m Text - -- ^ file content +loadFile :: MonadIO m => LoadFileFn m loadFile = readFileUtf8 diff --git a/src/Headroom/FileType.hs b/src/Headroom/FileType.hs --- a/src/Headroom/FileType.hs +++ b/src/Headroom/FileType.hs @@ -67,13 +67,14 @@ -> CtHeaderConfig -- ^ 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 + C -> hscC + CPP -> hscCpp + CSS -> hscCss + Haskell -> hscHaskell + HTML -> hscHtml + Java -> hscJava + JS -> hscJs + PureScript -> hscPureScript + Rust -> hscRust + Scala -> hscScala + Shell -> hscShell diff --git a/src/Headroom/FileType/Types.hs b/src/Headroom/FileType/Types.hs --- a/src/Headroom/FileType/Types.hs +++ b/src/Headroom/FileType/Types.hs @@ -34,6 +34,8 @@ -- ^ support for /Java/ programming language | JS -- ^ support for /JavaScript/ programming language + | PureScript + -- ^ support for /PureScript/ programming language | Rust -- ^ support for /Rust/ programming language | Scala diff --git a/src/Headroom/HeaderFn.hs b/src/Headroom/HeaderFn.hs --- a/src/Headroom/HeaderFn.hs +++ b/src/Headroom/HeaderFn.hs @@ -31,22 +31,18 @@ -- * Environment Data Types , ConfiguredEnv(..) , mkConfiguredEnv - -- * Lenses - , ceCurrentYearL - , ceHeaderFnConfigsL - , ceUpdateCopyrightModeL ) where import Headroom.Configuration.Types ( CtHeaderFnConfigs , HeaderFnConfig(..) , HeaderFnConfigs(..) - , hfcConfigL - , hfcsUpdateCopyrightL - , uccSelectedAuthorsL + , UpdateCopyrightConfig(..) ) import Headroom.Data.Has ( Has(..) ) -import Headroom.Data.Lens ( suffixLenses ) +import Headroom.Data.Lens ( suffixLenses + , suffixLensesFor + ) import Headroom.HeaderFn.Types ( HeaderFn(..) ) import Headroom.HeaderFn.UpdateCopyright ( SelectedAuthors(..) @@ -61,6 +57,11 @@ import RIO +suffixLenses ''HeaderFnConfigs +suffixLenses ''UpdateCopyrightConfig +suffixLensesFor ["hfcConfig"] ''HeaderFnConfig + + -- | Runs the /license header function/ using the given /environment/ and text -- of rendered /license header/ as input. runHeaderFn :: HeaderFn env @@ -113,7 +114,7 @@ } deriving (Eq, Show) -suffixLenses ''ConfiguredEnv +suffixLensesFor ["ceCurrentYear", "ceUpdateCopyrightMode"] ''ConfiguredEnv instance Has CurrentYear ConfiguredEnv where hasLens = ceCurrentYearL diff --git a/src/Headroom/Meta.hs b/src/Headroom/Meta.hs --- a/src/Headroom/Meta.hs +++ b/src/Headroom/Meta.hs @@ -31,7 +31,6 @@ import qualified RIO.Text as T - -- | Type of the template format used for license headers. type TemplateType = Mustache diff --git a/test-data/code-samples/purescript/full.purs b/test-data/code-samples/purescript/full.purs new file mode 100644 --- /dev/null +++ b/test-data/code-samples/purescript/full.purs @@ -0,0 +1,9 @@ + +-- Some module header here + +-- Some comment here + +module Test where + +foo :: String +foo = "Hello, world!" 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 @@ -1,4 +1,10 @@ -{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} + module Headroom.Command.InitSpec ( spec ) @@ -7,6 +13,11 @@ import Headroom.Command.Init import Headroom.Command.Types ( CommandInitOptions(..) ) import Headroom.Configuration.Types ( LicenseType(..) ) +import Headroom.Data.Has ( Has(..) ) +import Headroom.Data.Lens ( suffixLenses + , suffixLensesFor + ) +import Headroom.FileSystem ( FileSystem(..) ) import Headroom.FileType.Types ( FileType(..) ) import RIO import RIO.FilePath ( () ) @@ -14,27 +25,62 @@ import Test.Hspec +data TestEnv = TestEnv + { envLogFunc :: LogFunc + , envFileSystem :: FileSystem (RIO TestEnv) + , envInitOptions :: CommandInitOptions + , envPaths :: Paths + } + +suffixLenses ''TestEnv +suffixLensesFor ["fsDoesFileExist"] ''FileSystem +suffixLensesFor ["pConfigFile"] ''Paths + +instance HasLogFunc TestEnv where + logFuncL = envLogFuncL + +instance Has CommandInitOptions TestEnv where + hasLens = envInitOptionsL + +instance Has (FileSystem (RIO TestEnv)) TestEnv where + hasLens = envFileSystemL + +instance Has Paths TestEnv where + hasLens = envPathsL + + spec :: Spec spec = do describe "doesAppConfigExist" $ do - it "checks that '.headroom.yaml' exists in selected directory" $ do - result <- runRIO env doesAppConfigExist + it "checks that configuration file exists in selected directory" $ do + let env' = env & envFileSystemL . fsDoesFileExistL .~ check + check path = pure $ env' ^. envPathsL . pConfigFileL == path + result <- runRIO env' doesAppConfigExist result `shouldBe` True describe "findSupportedFileTypes" $ do it "recursively finds all known file types present in given path" $ do result <- runRIO env findSupportedFileTypes - let expected = [HTML] - L.sort result `shouldBe` L.sort expected + L.sort result `shouldBe` L.sort [HTML] -env :: Env -env = Env { envLogFunc = logFunc, envInitOptions = opts, envPaths = paths } +env :: TestEnv +env = TestEnv { .. } where - logFunc = mkLogFunc (\_ _ _ _ -> pure ()) - opts = CommandInitOptions + envLogFunc = mkLogFunc (\_ _ _ _ -> pure ()) + envInitOptions = CommandInitOptions { cioSourcePaths = ["test-data" "test-traverse"] , cioLicenseType = BSD3 } - paths = Paths { pConfigFile = "test-data" "configs" "full.yaml" - , pTemplatesDir = "headroom-templates" - } + envPaths = Paths { pConfigFile = "test-data" "configs" "full.yaml" + , pTemplatesDir = "headroom-templates" + } + envFileSystem = FileSystem { fsCreateDirectory = undefined + , fsDoesFileExist = undefined + , fsFindFiles = undefined + , fsFindFilesByExts = undefined + , fsFindFilesByTypes = undefined + , fsGetCurrentDirectory = undefined + , fsListFiles = undefined + , fsLoadFile = undefined + } + diff --git a/test/Headroom/Command/RunSpec.hs b/test/Headroom/Command/RunSpec.hs --- a/test/Headroom/Command/RunSpec.hs +++ b/test/Headroom/Command/RunSpec.hs @@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} @@ -22,15 +23,17 @@ ) import Headroom.Data.EnumExtra ( EnumExtra(..) ) import Headroom.Data.Has ( Has(..) ) -import Headroom.Data.Lens ( suffixLenses ) +import Headroom.Data.Lens ( suffixLenses + , suffixLensesFor + ) import Headroom.Data.TextExtra ( fromLines ) +import Headroom.FileSystem ( FileSystem(..) ) import Headroom.FileType.Types ( FileType(..) ) import Headroom.Meta ( TemplateType ) import Headroom.Template ( Template(..) ) import Headroom.Types ( CurrentYear(..) ) import Headroom.Variables ( mkVariables ) import RIO hiding ( assert ) -import RIO.FilePath ( () ) import qualified RIO.Map as M import qualified RIO.NonEmpty as NE import qualified RIO.Text as T @@ -40,17 +43,48 @@ import Test.QuickCheck.Monadic +data TestEnv = TestEnv + { envLogFunc :: LogFunc + , envCurrentYear :: CurrentYear + , envFileSystem :: FileSystem (RIO TestEnv) + , envHeaderFnConfigs :: CtHeaderFnConfigs + } + +suffixLenses ''TestEnv +suffixLensesFor ["fsFindFilesByExts", "fsLoadFile"] ''FileSystem + +instance HasLogFunc TestEnv where + logFuncL = envLogFuncL + +instance Has CtHeaderFnConfigs TestEnv where + hasLens = envHeaderFnConfigsL + +instance Has CurrentYear TestEnv where + hasLens = envCurrentYearL + +instance Has (FileSystem (RIO TestEnv)) TestEnv where + hasLens = envFileSystemL + + spec :: Spec spec = do describe "loadBuiltInTemplates" $ do it "should load correct number of built-in templates" $ do templates <- runRIO env $ loadBuiltInTemplates BSD3 - M.size templates `shouldBe` 10 + M.size templates `shouldBe` 11 describe "loadTemplateFiles" $ do it "should load templates from given paths" $ do - templates <- runRIO env $ loadTemplateFiles ["test-data" "templates"] + let env' = + env + & (envFileSystemL . fsFindFilesByExtsL .~ fsFindFilesByExts') + & (envFileSystemL . fsLoadFileL .~ fsLoadFile') + fsFindFilesByExts' "test-dir" _ = pure ["haskell.mustache"] + fsFindFilesByExts' _ _ = throwString "INVALID CONDITION" + fsLoadFile' "haskell.mustache" = pure "template content" + fsLoadFile' _ = throwString "INVALID CONDITION" + templates <- runRIO env' $ loadTemplateFiles ["test-dir"] M.size templates `shouldBe` 1 M.member Haskell templates `shouldBe` True @@ -98,8 +132,17 @@ env :: TestEnv env = TestEnv { .. } where - envLogFunc = mkLogFunc (\_ _ _ _ -> pure ()) - envCurrentYear = CurrentYear 2020 + envLogFunc = mkLogFunc (\_ _ _ _ -> pure ()) + envCurrentYear = CurrentYear 2020 + envFileSystem = FileSystem { fsCreateDirectory = undefined + , fsDoesFileExist = undefined + , fsFindFiles = undefined + , fsFindFilesByExts = undefined + , fsFindFilesByTypes = undefined + , fsGetCurrentDirectory = undefined + , fsListFiles = undefined + , fsLoadFile = undefined + } envHeaderFnConfigs = HeaderFnConfigs { hfcsUpdateCopyright = HeaderFnConfig { hfcEnabled = True @@ -109,19 +152,3 @@ } } } - -data TestEnv = TestEnv - { envLogFunc :: !LogFunc - , envHeaderFnConfigs :: !CtHeaderFnConfigs - , envCurrentYear :: !CurrentYear - } -suffixLenses ''TestEnv - -instance HasLogFunc TestEnv where - logFuncL = envLogFuncL - -instance Has CtHeaderFnConfigs TestEnv where - hasLens = envHeaderFnConfigsL - -instance Has CurrentYear TestEnv where - hasLens = envCurrentYearL diff --git a/test/Headroom/Ext/JavaSpec.hs b/test/Headroom/Ext/JavaSpec.hs new file mode 100644 --- /dev/null +++ b/test/Headroom/Ext/JavaSpec.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Headroom.Ext.JavaSpec + ( spec + ) +where + +import Headroom.Configuration.Types ( HeaderConfig(..) + , HeaderSyntax(..) + ) +import Headroom.Ext.Java +import Headroom.FileSystem ( loadFile ) +import Headroom.Variables ( mkVariables ) +import RIO +import RIO.FilePath ( () ) +import Test.Hspec + + +spec :: Spec +spec = do + let codeSamples = "test-data" "code-samples" + + describe "extractPackageName" $ do + it "extracts package name from Java source code" $ do + sample <- loadFile $ codeSamples "java" "sample1.java" + extractPackageName sample `shouldBe` Just "foo" + + + describe "extractVariables" $ do + it "extracts variables from Java source code" $ do + let config = HeaderConfig ["java"] 0 0 [] [] (BlockComment "/*" "*/") + meta = Nothing + headerPos = Just (0, 2) + expected = mkVariables [("_java_package_name", "foo")] + sample <- loadFile $ codeSamples "java" "sample1.java" + extractVariables config meta headerPos sample `shouldBe` expected diff --git a/test/Headroom/Ext/PureScriptSpec.hs b/test/Headroom/Ext/PureScriptSpec.hs new file mode 100644 --- /dev/null +++ b/test/Headroom/Ext/PureScriptSpec.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Headroom.Ext.PureScriptSpec + ( spec + ) +where + +import Headroom.Configuration.Types ( HeaderConfig(..) + , HeaderSyntax(..) + ) +import Headroom.Ext.PureScript +import Headroom.FileSystem ( loadFile ) +import Headroom.Variables ( mkVariables ) +import RIO +import RIO.FilePath ( () ) +import Test.Hspec + + +spec :: Spec +spec = do + let codeSamples = "test-data" "code-samples" + + describe "extractVariables" $ do + it "extracts variables from PureScript source code" $ do + let config = HeaderConfig ["purs"] 0 0 [] [] (LineComment "--") + meta = Nothing + headerPos = Just (1, 13) + expected = mkVariables [("_purescript_module_name", "Test")] + sample <- loadFile $ codeSamples "purescript" "full.purs" + extractVariables config meta headerPos sample `shouldBe` expected diff --git a/test/Headroom/ExtSpec.hs b/test/Headroom/ExtSpec.hs --- a/test/Headroom/ExtSpec.hs +++ b/test/Headroom/ExtSpec.hs @@ -38,3 +38,21 @@ sample <- readFileUtf8 $ samplesDir "haskell" "full.hs" extractVariables Haskell config meta (Just (1, 13)) sample `shouldBe` expected + + it "extracts variables specific for Java file type" $ do + let samplesDir = "test-data" "code-samples" + config = HeaderConfig ["java"] 0 0 [] [] (BlockComment "/*" "*/") + meta = Nothing + expected = mkVariables [("_java_package_name", "foo")] + sample <- readFileUtf8 $ samplesDir "java" "sample1.java" + extractVariables Java config meta (Just (0, 2)) sample `shouldBe` expected + + it "extracts variables specific for PureScript file type" $ do + let samplesDir = "test-data" "code-samples" + config = HeaderConfig ["purs"] 0 0 [] [] (LineComment "--") + meta = Nothing + expected = mkVariables [("_purescript_module_name", "Test")] + sample <- readFileUtf8 $ samplesDir "purescript" "full.purs" + extractVariables PureScript config meta (Just (1, 1)) sample + `shouldBe` expected +