diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,10 @@ # Changelog All notable changes to this project will be documented in this file. +## 0.2.2.0 (released 2020-05-04) +- [#45] Add `-c|--check-headers` command line option +- Bump _LTS Haskell_ to `15.11` + ## 0.2.1.1 (released 2020-04-30) - [#47] Make possible to build Headroom with GHC 8.10 - Remove unused dependency on `text` package. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,12 +4,4 @@ See the [GitHub project page](https://github.com/vaclavsvejcar/headroom/) for more details. -[i25]: https://github.com/vaclavsvejcar/headroom/issues/25 -[file:embedded/default-config.yaml]: https://github.com/vaclavsvejcar/headroom/blob/master/embedded/default-config.yaml -[meta:new-issue]: https://github.com/vaclavsvejcar/headroom/issues/new -[web:bsd-3]: https://opensource.org/licenses/BSD-3-Clause -[web:cabal]: https://www.haskell.org/cabal/ -[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 diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,8 +1,13 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + {-| Module : Main Description : Main application launcher Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX @@ -10,10 +15,7 @@ Code responsible for booting up the application and parsing command line arguments. -} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} + module Main where import Headroom.Command ( commandParser ) diff --git a/embedded/license/bsd3/haskell.mustache b/embedded/license/bsd3/haskell.mustache --- a/embedded/license/bsd3/haskell.mustache +++ b/embedded/license/bsd3/haskell.mustache @@ -2,7 +2,7 @@ Module : MODULE_NAME Description : SHORT_DESC Copyright : (c) {{ year }} {{ author }} -License : BSD-3 +License : BSD-3-Clause Maintainer : {{ email }} Stability : experimental Portability : POSIX diff --git a/headroom.cabal b/headroom.cabal --- a/headroom.cabal +++ b/headroom.cabal @@ -1,7 +1,7 @@ -cabal-version: 1.12 +cabal-version: 2.2 name: headroom -version: 0.2.1.1 -license: BSD3 +version: 0.2.2.0 +license: BSD-3-Clause license-file: LICENSE copyright: Copyright (c) 2019-2020 Vaclav Svejcar maintainer: vaclav.svejcar@gmail.com @@ -118,6 +118,8 @@ Headroom.Command.Run Headroom.Command.Utils Headroom.Configuration + Headroom.Data.EnumExtra + Headroom.Data.Has Headroom.Embedded Headroom.FileSupport Headroom.FileSystem @@ -128,12 +130,13 @@ Headroom.Template Headroom.Template.Mustache Headroom.Types - Headroom.Types.EnumExtra Headroom.UI Headroom.UI.Progress 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 @@ -147,7 +150,7 @@ mustache >=2.3.1, optparse-applicative >=0.15.1.0, pcre-light >=0.4.1.0, - rio >=0.1.15.0, + rio >=0.1.15.1, template-haskell >=2.15.0.0, time >=1.9.3, yaml >=0.11.3.0 @@ -166,7 +169,7 @@ base >=4.7 && <5, headroom -any, optparse-applicative >=0.15.1.0, - rio >=0.1.15.0 + rio >=0.1.15.1 test-suite doctest type: exitcode-stdio-1.0 @@ -183,7 +186,7 @@ base >=4.7 && <5, doctest >=0.16.3, optparse-applicative >=0.15.1.0, - rio >=0.1.15.0 + rio >=0.1.15.1 test-suite spec type: exitcode-stdio-1.0 @@ -193,13 +196,13 @@ Headroom.Command.InitSpec Headroom.Command.ReadersSpec Headroom.ConfigurationSpec + Headroom.Data.EnumExtraSpec Headroom.FileSupportSpec Headroom.FileSystemSpec Headroom.FileTypeSpec Headroom.RegexSpec Headroom.SerializationSpec Headroom.Template.MustacheSpec - Headroom.Types.EnumExtraSpec Headroom.UI.ProgressSpec Test.Utils Paths_headroom @@ -216,4 +219,4 @@ hspec >=2.7.1, optparse-applicative >=0.15.1.0, pcre-light >=0.4.1.0, - rio >=0.1.15.0 + rio >=0.1.15.1 diff --git a/src/Headroom/Command.hs b/src/Headroom/Command.hs --- a/src/Headroom/Command.hs +++ b/src/Headroom/Command.hs @@ -1,8 +1,12 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + {-| Module : Headroom.Command Description : Support for parsing command line arguments Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX @@ -10,9 +14,7 @@ This module contains code responsible for parsing command line arguments, using the /optparse-applicative/ library. -} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} + module Headroom.Command ( commandParser ) @@ -21,6 +23,7 @@ import Headroom.Command.Readers ( licenseReader , licenseTypeReader ) +import Headroom.Data.EnumExtra ( EnumExtra(..) ) import Headroom.Meta ( productDesc , productInfo ) @@ -28,7 +31,6 @@ , LicenseType , RunMode(..) ) -import Headroom.Types.EnumExtra ( EnumExtra(..) ) import Options.Applicative import RIO import qualified RIO.Text as T @@ -44,7 +46,7 @@ runCommand = command "run" (info (runOptions <**> helper) - (progDesc "add or replace source code headers") + (progDesc "add, replace, drop or check source code headers") ) genCommand = command "gen" @@ -90,6 +92,11 @@ (long "add-headers" <> short 'a' <> help "only adds missing license headers" ) + <|> flag' + Check + (long "check-headers" <> short 'c' <> help + "check whether existing headers are up-to-date" + ) <|> flag' Replace (long "replace-headers" <> short 'r' <> help diff --git a/src/Headroom/Command/Gen.hs b/src/Headroom/Command/Gen.hs --- a/src/Headroom/Command/Gen.hs +++ b/src/Headroom/Command/Gen.hs @@ -1,8 +1,12 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} + {-| Module : Headroom.Command.Gen Description : Handler for the @gen@ command. Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX @@ -11,8 +15,7 @@ /Headroom/, such as /YAML/ configuration stubs or /Mustache/ license templates. Run /Headroom/ using the @headroom gen --help@ to see available options. -} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NoImplicitPrelude #-} + module Headroom.Command.Gen ( commandGen , parseGenMode 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,8 +1,16 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} + {-| Module : Headroom.Command.Init Description : Handler for the @init@ command Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX @@ -11,16 +19,10 @@ required files (configuration, templates) for the given project, which are then required by the @run@ or @gen@ commands. -} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} + module Headroom.Command.Init ( Env(..) , Paths(..) - , HasPaths(..) - , HasInitOptions(..) , commandInit , doesAppConfigExist , findSupportedFileTypes @@ -31,6 +33,7 @@ import Headroom.Configuration ( makeHeadersConfig , parseConfiguration ) +import Headroom.Data.Has ( Has(..) ) import Headroom.Embedded ( configFileStub , defaultConfig , licenseTemplate @@ -81,19 +84,11 @@ instance HasLogFunc Env where logFuncL = lens envLogFunc (\x y -> x { envLogFunc = y }) --- | Environment value with @init@ command options. -class HasInitOptions env where - initOptionsL :: Lens' env CommandInitOptions - --- | Environment value with 'Paths'. -class HasPaths env where - pathsL :: Lens' env Paths - -instance HasInitOptions Env where - initOptionsL = lens envInitOptions (\x y -> x { envInitOptions = y }) +instance Has CommandInitOptions Env where + hasLens = lens envInitOptions (\x y -> x { envInitOptions = y }) -instance HasPaths Env where - pathsL = lens envPaths (\x y -> x { envPaths = y }) +instance Has Paths Env where + hasLens = lens envPaths (\x y -> x { envPaths = y }) -------------------------------------------------------------------------------- @@ -116,15 +111,15 @@ createTemplates fileTypes createConfigFile True -> do - paths <- view pathsL + paths <- viewL throwM $ CommandInitError (AppConfigAlreadyExists $ pConfigFile paths) -- | Recursively scans provided source paths for known file types for which -- templates can be generated. -findSupportedFileTypes :: (HasInitOptions env, HasLogFunc env) +findSupportedFileTypes :: (Has CommandInitOptions env, HasLogFunc env) => RIO env [FileType] findSupportedFileTypes = do - opts <- view initOptionsL + opts <- viewL pHeadersConfig <- pcLicenseHeaders <$> parseConfiguration defaultConfig headersConfig <- makeHeadersConfig pHeadersConfig fileTypes <- do @@ -139,12 +134,12 @@ logInfo $ "Found supported file types: " <> displayShow fileTypes pure fileTypes -createTemplates :: (HasInitOptions env, HasLogFunc env, HasPaths env) +createTemplates :: (Has CommandInitOptions env, HasLogFunc env, Has Paths env) => [FileType] -> RIO env () createTemplates fileTypes = do - opts <- view initOptionsL - paths <- view pathsL + opts <- viewL + paths <- viewL let templatesDir = pCurrentDir paths pTemplatesDir paths mapM_ (\(p, lf) -> createTemplate templatesDir lf p) (zipWithProgress $ fmap (cioLicenseType opts, ) fileTypes) @@ -163,11 +158,11 @@ [display progress, " Creating template file in ", fromString filePath] writeFileUtf8 filePath template -createConfigFile :: (HasInitOptions env, HasLogFunc env, HasPaths env) +createConfigFile :: (Has CommandInitOptions env, HasLogFunc env, Has Paths env) => RIO env () createConfigFile = do - opts <- view initOptionsL - paths <- view pathsL + opts <- viewL + paths <- viewL let filePath = pCurrentDir paths pConfigFile paths logInfo $ "Creating YAML config file in " <> fromString filePath writeFileUtf8 filePath (configuration opts paths) @@ -186,16 +181,16 @@ ["[ ", T.intercalate ", " (fmap (\i -> "\"" <> i <> "\"") items), " ]"] -- | Checks whether application config file already exists. -doesAppConfigExist :: (HasLogFunc env, HasPaths env) => RIO env Bool +doesAppConfigExist :: (HasLogFunc env, Has Paths env) => RIO env Bool doesAppConfigExist = do - paths <- view pathsL + paths <- viewL logInfo "Verifying that there's no existing Headroom configuration..." doesFileExist $ pCurrentDir paths pConfigFile paths -- | Creates directory for template files. -makeTemplatesDir :: (HasLogFunc env, HasPaths env) => RIO env () +makeTemplatesDir :: (HasLogFunc env, Has Paths env) => RIO env () makeTemplatesDir = do - paths <- view pathsL + paths <- viewL let templatesDir = pCurrentDir paths pTemplatesDir paths logInfo $ "Creating directory for templates in " <> fromString templatesDir createDirectory templatesDir diff --git a/src/Headroom/Command/Readers.hs b/src/Headroom/Command/Readers.hs --- a/src/Headroom/Command/Readers.hs +++ b/src/Headroom/Command/Readers.hs @@ -1,8 +1,12 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + {-| Module : Headroom.Command.Readers Description : Custom readers for /optparse-applicative/ library Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX @@ -10,9 +14,7 @@ This module contains custom readers required by the /optparse-applicative/ library to parse data types such as 'LicenseType' or 'FileType'. -} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} + module Headroom.Command.Readers ( licenseReader , licenseTypeReader @@ -21,10 +23,10 @@ where import Data.Either.Combinators ( maybeToRight ) +import Headroom.Data.EnumExtra ( EnumExtra(..) ) import Headroom.Types ( FileType , LicenseType ) -import Headroom.Types.EnumExtra ( EnumExtra(..) ) import Options.Applicative import RIO import qualified RIO.Text as T diff --git a/src/Headroom/Command/Run.hs b/src/Headroom/Command/Run.hs --- a/src/Headroom/Command/Run.hs +++ b/src/Headroom/Command/Run.hs @@ -1,8 +1,16 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} + {-| Module : Headroom.Command.Run Description : Handler for the @run@ command. Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX @@ -10,11 +18,7 @@ Module representing the @run@ command, the core command of /Headroom/, which is responsible for license header management. -} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} + module Headroom.Command.Run ( commandRun ) @@ -27,6 +31,8 @@ , parseConfiguration , parseVariables ) +import Headroom.Data.EnumExtra ( EnumExtra(..) ) +import Headroom.Data.Has ( Has(..) ) import Headroom.Embedded ( defaultConfig ) import Headroom.FileSupport ( addHeader , dropHeader @@ -51,9 +57,9 @@ , FileInfo(..) , FileType(..) , PartialConfiguration(..) + , RunAction(..) , RunMode(..) ) -import Headroom.Types.EnumExtra ( EnumExtra(..) ) import Headroom.UI ( Progress(..) , zipWithProgress ) @@ -64,6 +70,7 @@ import qualified RIO.Text as T + -- | Initial /RIO/ startup environment for the /Run/ command. data StartupEnv = StartupEnv { envLogFunc :: !LogFunc -- ^ logging function @@ -76,36 +83,26 @@ , envConfiguration :: !Configuration -- ^ application configuration } -class HasConfiguration env where - configurationL :: Lens' env Configuration - --- | Environment value with /Init/ command options. -class HasRunOptions env where - runOptionsL :: Lens' env CommandRunOptions - -class (HasLogFunc env, HasRunOptions env) => HasEnv env where - envL :: Lens' env StartupEnv - -instance HasConfiguration Env where - configurationL = lens envConfiguration (\x y -> x { envConfiguration = y }) +instance Has Configuration Env where + hasLens = lens envConfiguration (\x y -> x { envConfiguration = y }) -instance HasEnv StartupEnv where - envL = id +instance Has StartupEnv StartupEnv where + hasLens = id -instance HasEnv Env where - envL = lens envEnv (\x y -> x { envEnv = y }) +instance Has StartupEnv Env where + hasLens = 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 + logFuncL = hasLens @StartupEnv . logFuncL -instance HasRunOptions StartupEnv where - runOptionsL = lens envRunOptions (\x y -> x { envRunOptions = y }) +instance Has CommandRunOptions StartupEnv where + hasLens = lens envRunOptions (\x y -> x { envRunOptions = y }) -instance HasRunOptions Env where - runOptionsL = envL . runOptionsL +instance Has CommandRunOptions Env where + hasLens = hasLens @StartupEnv . hasLens env' :: CommandRunOptions -> LogFunc -> IO Env @@ -119,7 +116,10 @@ commandRun :: CommandRunOptions -- ^ /Run/ command options -> IO () -- ^ execution result commandRun opts = bootstrap (env' opts) (croDebug opts) $ do + CommandRunOptions {..} <- viewL + Configuration {..} <- viewL logInfo $ display productInfo + let isCheck = cRunMode == Check warnOnDryRun startTS <- liftIO getPOSIXTime templates <- loadTemplates @@ -128,41 +128,53 @@ endTS <- liftIO getPOSIXTime logInfo "-----" logInfo $ mconcat - [ "Done: modified " + [ "Done: " + , if isCheck then "outdated " else "modified " , display processed - , ", skipped " + , if isCheck then ", up-to-date " else ", skipped " , display (total - processed) , " file(s) in " , displayShow (endTS - startTS) , " second(s)." ] warnOnDryRun + when (not croDryRun && isCheck && processed > 0) (exitWith $ ExitFailure 1) -warnOnDryRun :: (HasLogFunc env, HasRunOptions env) => RIO env () + +warnOnDryRun :: (HasLogFunc env, Has CommandRunOptions env) => RIO env () warnOnDryRun = do - CommandRunOptions {..} <- view runOptionsL + CommandRunOptions {..} <- viewL when croDryRun $ logWarn "[!] Running with '--dry-run', no files are changed!" -findSourceFiles :: (HasConfiguration env, HasLogFunc env) +findSourceFiles :: (Has Configuration env, HasLogFunc env) => [FileType] -> RIO env [FilePath] findSourceFiles fileTypes = do - Configuration {..} <- view configurationL + Configuration {..} <- viewL logDebug $ "Using source paths: " <> displayShow cSourcePaths files <- mconcat <$> mapM (findFiles' cLicenseHeaders) cSourcePaths let files' = excludePaths cExcludedPaths files - logInfo $ mconcat ["Found ", display $ L.length files', " source file(s)"] + logInfo $ mconcat + [ "Found " + , display $ L.length files' + , " source file(s) (excluded " + , display $ L.length files - L.length files' + , " file(s))" + ] pure files' where findFiles' licenseHeaders = findFilesByTypes licenseHeaders fileTypes -processSourceFiles :: (HasConfiguration env, HasLogFunc env, HasRunOptions env) +processSourceFiles :: ( Has Configuration env + , HasLogFunc env + , Has CommandRunOptions env + ) => Map FileType TemplateType -> [FilePath] -> RIO env (Int, Int) processSourceFiles templates paths = do - Configuration {..} <- view configurationL + Configuration {..} <- viewL let withFileType = mapMaybe (findFileType cLicenseHeaders) paths withTemplate = mapMaybe (uncurry findTemplate) withFileType processed <- mapM process (zipWithProgress withTemplate) @@ -175,57 +187,76 @@ process (pr, (tt, ft, p)) = processSourceFile pr tt ft p -processSourceFile :: (HasConfiguration env, HasLogFunc env, HasRunOptions env) +processSourceFile :: ( Has Configuration env + , HasLogFunc env + , Has CommandRunOptions env + ) => Progress -> TemplateType -> FileType -> FilePath -> RIO env Bool processSourceFile progress template fileType path = do - Configuration {..} <- view configurationL - CommandRunOptions {..} <- view runOptionsL + Configuration {..} <- viewL + CommandRunOptions {..} <- viewL fileContent <- readFileUtf8 path let fileInfo = extractFileInfo fileType (configByFileType cLicenseHeaders fileType) fileContent variables = cVariables <> fiVariables fileInfo - header <- renderTemplate variables template - (processed, action, message') <- chooseAction fileInfo header - let result = action fileContent - changed = processed && (fileContent /= result) - message = if changed then message' else "Skipping file: " + header <- renderTemplate variables template + RunAction {..} <- chooseAction fileInfo header + let result = raFunc fileContent + changed = raProcessed && (fileContent /= result) + message = if changed then raProcessedMsg else raSkippedMsg + isCheck = cRunMode == Check logDebug $ "File info: " <> displayShow fileInfo logInfo $ mconcat [display progress, " ", display message, fromString path] - when (not croDryRun && changed) (writeFileUtf8 path result) + when (not croDryRun && not isCheck && changed) (writeFileUtf8 path result) pure changed -chooseAction :: (HasConfiguration env) - => FileInfo - -> Text - -> RIO env (Bool, Text -> Text, Text) +chooseAction :: (Has Configuration env) => FileInfo -> Text -> RIO env RunAction chooseAction info header = do - Configuration {..} <- view configurationL + Configuration {..} <- viewL let hasHeader = isJust $ fiHeaderPos info pure $ go cRunMode hasHeader where go runMode hasHeader = case runMode of - Add -> (not hasHeader, addHeader info header, "Adding header to: ") - Drop -> (hasHeader, dropHeader info, "Dropping header from: ") - Replace -> if hasHeader - then (True, replaceHeader info header, "Replacing header in: ") - else go Add hasHeader + Add -> aAction hasHeader + Check -> cAction hasHeader + Drop -> dAction hasHeader + Replace -> rAction hasHeader + aAction hasHeader = RunAction (not hasHeader) + (addHeader info header) + (justify "Adding header to:") + (justify "Header already exists in:") + cAction hasHeader = (rAction hasHeader) + { raProcessedMsg = justify "Outdated header found in:" + , raSkippedMsg = justify "Header up-to-date in:" + } + dAction hasHeader = RunAction hasHeader + (dropHeader info) + (justify "Dropping header from:") + (justify "No header exists in:") + rAction hasHeader = if hasHeader then rAction' else go Add hasHeader + rAction' = RunAction True + (replaceHeader info header) + (justify "Replacing header in:") + (justify "Header up-to-date in:") + justify = T.justifyLeft 30 ' ' -loadTemplates :: (HasConfiguration env, HasLogFunc env) +loadTemplates :: (Has Configuration env, HasLogFunc env) => RIO env (Map FileType TemplateType) loadTemplates = do - Configuration {..} <- view configurationL + Configuration {..} <- viewL paths <- mconcat <$> mapM (`findFilesByExts` extensions) cTemplatePaths logDebug $ "Using template paths: " <> displayShow paths withTypes <- catMaybes <$> mapM (\p -> fmap (, p) <$> typeOfTemplate p) paths parsed <- mapM (\(t, p) -> (t, ) <$> load p) withTypes - logInfo $ mconcat ["Found ", display $ L.length parsed, " template(s)"] + logInfo + $ mconcat ["Found ", display $ L.length parsed, " license template(s)"] pure $ M.fromList parsed where extensions = toList $ templateExtensions @TemplateType @@ -241,7 +272,7 @@ pure fileType -finalConfiguration :: (HasLogFunc env, HasRunOptions env) +finalConfiguration :: (HasLogFunc env, Has CommandRunOptions env) => RIO env Configuration finalConfiguration = do defaultConfig' <- parseConfiguration defaultConfig @@ -257,9 +288,10 @@ pure config -optionsToConfiguration :: (HasRunOptions env) => RIO env PartialConfiguration +optionsToConfiguration :: (Has CommandRunOptions env) + => RIO env PartialConfiguration optionsToConfiguration = do - runOptions <- view runOptionsL + runOptions <- viewL variables <- parseVariables $ croVariables runOptions pure PartialConfiguration { pcRunMode = maybe mempty pure (croRunMode runOptions) diff --git a/src/Headroom/Command/Utils.hs b/src/Headroom/Command/Utils.hs --- a/src/Headroom/Command/Utils.hs +++ b/src/Headroom/Command/Utils.hs @@ -1,15 +1,17 @@ +{-# LANGUAGE NoImplicitPrelude #-} + {-| Module : Headroom.Command.Utils Description : Shared code for individual command handlers Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX Contains shared code common to all command handlers. -} -{-# LANGUAGE NoImplicitPrelude #-} + module Headroom.Command.Utils ( bootstrap ) diff --git a/src/Headroom/Configuration.hs b/src/Headroom/Configuration.hs --- a/src/Headroom/Configuration.hs +++ b/src/Headroom/Configuration.hs @@ -1,8 +1,12 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + {-| Module : Headroom.Configuration Description : Configuration handling (loading, parsing, validating) Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX @@ -13,9 +17,7 @@ pattern for the configuration, where the 'Configuration' is the data type for total configuration and 'PartialConfiguration' for the partial one. -} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} + module Headroom.Configuration ( -- * Loading & Parsing Configuration loadConfiguration diff --git a/src/Headroom/Data/EnumExtra.hs b/src/Headroom/Data/EnumExtra.hs new file mode 100644 --- /dev/null +++ b/src/Headroom/Data/EnumExtra.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{-| +Module : Headroom.Types.EnumExtra +Description : Extra functionality for enum types +Copyright : (c) 2019-2020 Vaclav Svejcar +License : BSD-3-Clause +Maintainer : vaclav.svejcar@gmail.com +Stability : experimental +Portability : POSIX + +Provides extended functionality for enum-like types, e.g. reading/writing +from/to textual representation, etc. +-} + +module Headroom.Data.EnumExtra where + +import RIO +import qualified RIO.List as L +import qualified RIO.Text as T + +-- | Enum data type, capable to (de)serialize itself from/to string +-- representation. Can be automatically derived by /GHC/ using the +-- @DeriveAnyClass@ extension. +class (Bounded a, Enum a, Eq a, Ord a, Show a) => EnumExtra a where + + + -- | Returns list of all enum values. + -- + -- >>> :set -XDeriveAnyClass -XTypeApplications + -- >>> data Test = Foo | Bar deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) + -- >>> allValues @Test + -- [Foo,Bar] + allValues :: [a] + allValues = [minBound ..] + + + -- | Returns all values of enum as single string, individual values separated + -- with comma. + -- + -- >>> :set -XDeriveAnyClass -XTypeApplications + -- >>> data Test = Foo | Bar deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) + -- >>> allValuesToText @Test + -- "Foo, Bar" + allValuesToText :: Text + allValuesToText = T.intercalate ", " (fmap enumToText (allValues :: [a])) + + + -- | Returns textual representation of enum value. Opposite to 'textToEnum'. + -- + -- >>> :set -XDeriveAnyClass + -- >>> data Test = Foo | Bar deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) + -- >>> enumToText Bar + -- "Bar" + enumToText :: a -> Text + enumToText = T.pack . show + + + -- | Returns enum value from its textual representation. + -- Opposite to 'enumToText'. + -- + -- >>> :set -XDeriveAnyClass + -- >>> data Test = Foo | Bar deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) + -- >>> (textToEnum "Foo") :: (Maybe Test) + -- Just Foo + textToEnum :: Text -> Maybe a + textToEnum text = + let enumValue v = (T.toLower . enumToText $ v) == T.toLower text + in L.find enumValue allValues diff --git a/src/Headroom/Data/Has.hs b/src/Headroom/Data/Has.hs new file mode 100644 --- /dev/null +++ b/src/Headroom/Data/Has.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} + +{-| +Module : Headroom.Data.Has +Description : Simplified variant of @Data.Has@ +Copyright : (c) 2019-2020 Vaclav Svejcar +License : BSD-3-Clause +Maintainer : vaclav.svejcar@gmail.com +Stability : experimental +Portability : POSIX + +This module provides 'Has' /type class/, adapted to the needs of this +application. +-} + +module Headroom.Data.Has + ( Has(..) + ) +where + +import RIO + +-- | Implementation of the /Has type class/ pattern. +class Has a t where + {-# MINIMAL getter, modifier | hasLens #-} + getter :: t -> a + getter = getConst . hasLens Const + + modifier :: (a -> a) -> t -> t + modifier f t = runIdentity (hasLens (Identity . f) t) + + hasLens :: Lens' t a + hasLens afa t = (\a -> modifier (const a) t) <$> afa (getter t) + + viewL :: MonadReader t m => m a + viewL = view hasLens diff --git a/src/Headroom/Embedded.hs b/src/Headroom/Embedded.hs --- a/src/Headroom/Embedded.hs +++ b/src/Headroom/Embedded.hs @@ -1,16 +1,18 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} + {-| Module : Headroom.Embedded Description : Embedded files Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX Contains contents of files embedded using the "Data.FileEmbed" module. -} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE TemplateHaskell #-} + module Headroom.Embedded ( configFileStub , defaultConfig diff --git a/src/Headroom/FileSupport.hs b/src/Headroom/FileSupport.hs --- a/src/Headroom/FileSupport.hs +++ b/src/Headroom/FileSupport.hs @@ -1,8 +1,12 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + {-| Module : Headroom.FileSupport Description : License header manipulation Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX @@ -10,9 +14,7 @@ This module is the heart of /Headroom/ as it contains functions for working with the /license headers/ and the /source code files/. -} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} + module Headroom.FileSupport ( -- * File info extraction extractFileInfo @@ -228,7 +230,7 @@ sndSplitAt = fromMaybe len (findSplit firstMatching sndSplit inLines) inLines = T.lines input len = L.length inLines - findSplit f ps i = compile' <$> joinPatterns ps >>= (`f` i) + findSplit f ps i = joinPatterns ps >>= (`f` i) . compile' -- TODO: https://github.com/vaclavsvejcar/headroom/issues/25 diff --git a/src/Headroom/FileSystem.hs b/src/Headroom/FileSystem.hs --- a/src/Headroom/FileSystem.hs +++ b/src/Headroom/FileSystem.hs @@ -1,8 +1,10 @@ +{-# LANGUAGE NoImplicitPrelude #-} + {-| Module : Headroom.FileSystem Description : Operations related to files and file system Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX @@ -10,7 +12,7 @@ Module providing functions for working with the local file system, its file and directories. -} -{-# LANGUAGE NoImplicitPrelude #-} + module Headroom.FileSystem ( -- * Traversing the File System findFiles diff --git a/src/Headroom/FileType.hs b/src/Headroom/FileType.hs --- a/src/Headroom/FileType.hs +++ b/src/Headroom/FileType.hs @@ -1,8 +1,12 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} + {-| Module : Headroom.FileType Description : Logic for handlig supported file types Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX @@ -10,9 +14,7 @@ Module providing functions for working with the 'FileType', such as performing detection based on the file extension, etc. -} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeApplications #-} + module Headroom.FileType ( configByFileType , fileTypeByExt @@ -20,11 +22,11 @@ ) where +import Headroom.Data.EnumExtra ( EnumExtra(..) ) import Headroom.Types ( FileType(..) , HeaderConfig(..) , HeadersConfig(..) ) -import Headroom.Types.EnumExtra ( EnumExtra(..) ) import RIO import qualified RIO.List as L diff --git a/src/Headroom/Meta.hs b/src/Headroom/Meta.hs --- a/src/Headroom/Meta.hs +++ b/src/Headroom/Meta.hs @@ -1,8 +1,11 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + {-| Module : Headroom.Meta Description : Application metadata (name, vendor, etc.) Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX @@ -10,8 +13,7 @@ Module providing application metadata, such as application name, vendor, version, etc. -} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} + module Headroom.Meta ( TemplateType , buildVersion diff --git a/src/Headroom/Regex.hs b/src/Headroom/Regex.hs --- a/src/Headroom/Regex.hs +++ b/src/Headroom/Regex.hs @@ -1,8 +1,11 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + {-| Module : Headroom.Regex Description : Helper functions for regular expressions Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX @@ -10,8 +13,7 @@ Provides wrappers mainly around functions from "Text.Regex.PCRE.Light" that more suits the needs of this application. -} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} + module Headroom.Regex ( compile' , joinPatterns diff --git a/src/Headroom/Serialization.hs b/src/Headroom/Serialization.hs --- a/src/Headroom/Serialization.hs +++ b/src/Headroom/Serialization.hs @@ -1,8 +1,11 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NoImplicitPrelude #-} + {-| Module : Headroom.Serialization Description : Various functions for data (de)serialization Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX @@ -10,14 +13,13 @@ Module providing support for data (de)serialization, mainly from/to /JSON/ and /YAML/. -} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NoImplicitPrelude #-} + module Headroom.Serialization ( -- * JSON/YAML Serialization aesonOptions , dropFieldPrefix , symbolCase - -- * Pretty Printing + -- * Pretty Printing , prettyPrintYAML ) where diff --git a/src/Headroom/Template.hs b/src/Headroom/Template.hs --- a/src/Headroom/Template.hs +++ b/src/Headroom/Template.hs @@ -1,8 +1,11 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE NoImplicitPrelude #-} + {-| Module : Headroom.Template Description : Generic representation of supported template type Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX @@ -10,8 +13,7 @@ Module providing generic representation of supported template type, using the 'Template' /type class/. -} -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE NoImplicitPrelude #-} + module Headroom.Template where import RIO diff --git a/src/Headroom/Template/Mustache.hs b/src/Headroom/Template/Mustache.hs --- a/src/Headroom/Template/Mustache.hs +++ b/src/Headroom/Template/Mustache.hs @@ -1,18 +1,19 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + {-| Module : Headroom.Template.Mustache Description : Implementation of /Mustache/ template support Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX This module provides support for templates. -} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} + module Headroom.Template.Mustache ( Mustache(..) ) diff --git a/src/Headroom/Types.hs b/src/Headroom/Types.hs --- a/src/Headroom/Types.hs +++ b/src/Headroom/Types.hs @@ -1,20 +1,22 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + {-| Module : Headroom.Types Description : Application data types Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX Module containing most of the data types used by the application. -} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} + module Headroom.Types ( -- * Configuration Data Types @@ -34,6 +36,7 @@ , CommandInitOptions(..) , CommandRunOptions(..) , ConfigurationError(..) + , RunAction(..) , RunMode(..) , GenMode(..) -- * Error Data Types @@ -57,23 +60,33 @@ , (.:?) ) import Data.Monoid ( Last(..) ) +import Headroom.Data.EnumExtra ( EnumExtra(..) ) import Headroom.Serialization ( aesonOptions ) -import Headroom.Types.EnumExtra ( EnumExtra(..) ) import RIO import qualified RIO.Text as T +-- | Action to be performed based on the selected 'RunMode'. +data RunAction = RunAction + { raProcessed :: !Bool -- ^ whether the given file was processed + , raFunc :: !(Text -> Text) -- ^ function to process the file + , raProcessedMsg :: !Text -- ^ message to show when file was processed + , raSkippedMsg :: !Text -- ^ message to show when file was skipped + } + -- | Represents what action should the @run@ command perform. data RunMode - = Add - | Drop - | Replace + = Add -- ^ /add mode/ for @run@ command + | Check -- ^ /check mode/ for @run@ command + | Drop -- ^ /drop mode/ for @run@ command + | Replace -- ^ /replace mode/ for @run@ command deriving (Eq, Show) instance FromJSON RunMode where parseJSON = \case String s -> case T.toLower s of "add" -> pure Add + "check" -> pure Check "drop" -> pure Drop "replace" -> pure Replace _ -> error $ "Unknown run mode: " <> T.unpack s diff --git a/src/Headroom/Types/EnumExtra.hs b/src/Headroom/Types/EnumExtra.hs deleted file mode 100644 --- a/src/Headroom/Types/EnumExtra.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-| -Module : Headroom.Types.EnumExtra -Description : Extra functionality for enum types -Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 -Maintainer : vaclav.svejcar@gmail.com -Stability : experimental -Portability : POSIX - -Provides extended functionality for enum-like types, e.g. reading/writing -from/to textual representation, etc. --} -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Headroom.Types.EnumExtra where - -import RIO -import qualified RIO.List as L -import qualified RIO.Text as T - --- | Enum data type, capable to (de)serialize itself from/to string --- representation. Can be automatically derived by /GHC/ using the --- @DeriveAnyClass@ extension. -class (Bounded a, Enum a, Eq a, Ord a, Show a) => EnumExtra a where - - - -- | Returns list of all enum values. - -- - -- >>> :set -XDeriveAnyClass -XTypeApplications - -- >>> data Test = Foo | Bar deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) - -- >>> allValues @Test - -- [Foo,Bar] - allValues :: [a] - allValues = [minBound ..] - - - -- | Returns all values of enum as single string, individual values separated - -- with comma. - -- - -- >>> :set -XDeriveAnyClass -XTypeApplications - -- >>> data Test = Foo | Bar deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) - -- >>> allValuesToText @Test - -- "Foo, Bar" - allValuesToText :: Text - allValuesToText = T.intercalate ", " (fmap enumToText (allValues :: [a])) - - - -- | Returns textual representation of enum value. Opposite to 'textToEnum'. - -- - -- >>> :set -XDeriveAnyClass - -- >>> data Test = Foo | Bar deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) - -- >>> enumToText Bar - -- "Bar" - enumToText :: a -> Text - enumToText = T.pack . show - - - -- | Returns enum value from its textual representation. - -- Opposite to 'enumToText'. - -- - -- >>> :set -XDeriveAnyClass - -- >>> data Test = Foo | Bar deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) - -- >>> (textToEnum "Foo") :: (Maybe Test) - -- Just Foo - textToEnum :: Text -> Maybe a - textToEnum text = - let enumValue v = (T.toLower . enumToText $ v) == T.toLower text - in L.find enumValue allValues diff --git a/src/Headroom/UI.hs b/src/Headroom/UI.hs --- a/src/Headroom/UI.hs +++ b/src/Headroom/UI.hs @@ -1,15 +1,17 @@ +{-# LANGUAGE NoImplicitPrelude #-} + {-| Module : Headroom.UI Description : UI Components Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX Various UI components. -} -{-# LANGUAGE NoImplicitPrelude #-} + module Headroom.UI ( module Headroom.UI.Progress ) diff --git a/src/Headroom/UI/Progress.hs b/src/Headroom/UI/Progress.hs --- a/src/Headroom/UI/Progress.hs +++ b/src/Headroom/UI/Progress.hs @@ -1,15 +1,17 @@ +{-# LANGUAGE NoImplicitPrelude #-} + {-| Module : Headroom.UI.Progress Description : UI component for displaying progress Copyright : (c) 2019-2020 Vaclav Svejcar -License : BSD-3 +License : BSD-3-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX This component displays progress in format @[CURR of TOTAL]@. -} -{-# LANGUAGE NoImplicitPrelude #-} + module Headroom.UI.Progress ( Progress(..) , zipWithProgress diff --git a/test/Headroom/Command/ReadersSpec.hs b/test/Headroom/Command/ReadersSpec.hs --- a/test/Headroom/Command/ReadersSpec.hs +++ b/test/Headroom/Command/ReadersSpec.hs @@ -8,10 +8,10 @@ where import Headroom.Command.Readers +import Headroom.Data.EnumExtra ( EnumExtra(..) ) import Headroom.Types ( FileType , LicenseType ) -import Headroom.Types.EnumExtra ( EnumExtra(..) ) import RIO import qualified RIO.Text as T import Test.Hspec diff --git a/test/Headroom/Data/EnumExtraSpec.hs b/test/Headroom/Data/EnumExtraSpec.hs new file mode 100644 --- /dev/null +++ b/test/Headroom/Data/EnumExtraSpec.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +module Headroom.Data.EnumExtraSpec + ( spec + ) +where + +import Headroom.Data.EnumExtra +import RIO +import Test.Hspec + +data TestEnum + = Foo + | Bar + deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) + +spec :: Spec +spec = do + describe "allValues" $ do + it "should return list of all enum values" $ do + allValues @TestEnum `shouldBe` [Foo, Bar] + + describe "allValuesToText" $ do + it "should pretty print all enum values" $ do + allValuesToText @TestEnum `shouldBe` "Foo, Bar" + + describe "enumToText" $ do + it "should show textual representation of enum value" $ do + enumToText Foo `shouldBe` "Foo" + + describe "textToEnum" $ do + it "should read enum value from textual representation" $ do + textToEnum "foo" `shouldBe` Just Foo + diff --git a/test/Headroom/Types/EnumExtraSpec.hs b/test/Headroom/Types/EnumExtraSpec.hs deleted file mode 100644 --- a/test/Headroom/Types/EnumExtraSpec.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} -module Headroom.Types.EnumExtraSpec - ( spec - ) -where - -import Headroom.Types.EnumExtra -import RIO -import Test.Hspec - -data TestEnum - = Foo - | Bar - deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) - -spec :: Spec -spec = do - describe "allValues" $ do - it "should return list of all enum values" $ do - allValues @TestEnum `shouldBe` [Foo, Bar] - - describe "allValuesToText" $ do - it "should pretty print all enum values" $ do - allValuesToText @TestEnum `shouldBe` "Foo, Bar" - - describe "enumToText" $ do - it "should show textual representation of enum value" $ do - enumToText Foo `shouldBe` "Foo" - - describe "textToEnum" $ do - it "should read enum value from textual representation" $ do - textToEnum "foo" `shouldBe` Just Foo -