packages feed

headroom 0.2.1.1 → 0.2.2.0

raw patch · 30 files changed

+410/−294 lines, 30 filesdep ~rioPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: rio

API changes (from Hackage documentation)

- Headroom.Command.Init: class HasInitOptions env
- Headroom.Command.Init: class HasPaths env
- Headroom.Command.Init: initOptionsL :: HasInitOptions env => Lens' env CommandInitOptions
- Headroom.Command.Init: instance Headroom.Command.Init.HasInitOptions Headroom.Command.Init.Env
- Headroom.Command.Init: instance Headroom.Command.Init.HasPaths Headroom.Command.Init.Env
- Headroom.Command.Init: pathsL :: HasPaths env => Lens' env Paths
- Headroom.Command.Run: instance Headroom.Command.Run.HasConfiguration Headroom.Command.Run.Env
- Headroom.Command.Run: instance Headroom.Command.Run.HasEnv Headroom.Command.Run.Env
- Headroom.Command.Run: instance Headroom.Command.Run.HasEnv Headroom.Command.Run.StartupEnv
- Headroom.Command.Run: instance Headroom.Command.Run.HasRunOptions Headroom.Command.Run.Env
- Headroom.Command.Run: instance Headroom.Command.Run.HasRunOptions Headroom.Command.Run.StartupEnv
- Headroom.Types: instance Headroom.Types.EnumExtra.EnumExtra Headroom.Types.FileType
- Headroom.Types: instance Headroom.Types.EnumExtra.EnumExtra Headroom.Types.LicenseType
- Headroom.Types.EnumExtra: allValues :: EnumExtra a => [a]
- Headroom.Types.EnumExtra: allValuesToText :: EnumExtra a => Text
- Headroom.Types.EnumExtra: class (Bounded a, Enum a, Eq a, Ord a, Show a) => EnumExtra a
- Headroom.Types.EnumExtra: enumToText :: EnumExtra a => a -> Text
- Headroom.Types.EnumExtra: textToEnum :: EnumExtra a => Text -> Maybe a
+ Headroom.Command.Init: instance Headroom.Data.Has.Has Headroom.Command.Init.Paths Headroom.Command.Init.Env
+ Headroom.Command.Init: instance Headroom.Data.Has.Has Headroom.Types.CommandInitOptions Headroom.Command.Init.Env
+ Headroom.Command.Run: instance Headroom.Data.Has.Has Headroom.Command.Run.StartupEnv Headroom.Command.Run.Env
+ Headroom.Command.Run: instance Headroom.Data.Has.Has Headroom.Command.Run.StartupEnv Headroom.Command.Run.StartupEnv
+ Headroom.Command.Run: instance Headroom.Data.Has.Has Headroom.Types.CommandRunOptions Headroom.Command.Run.Env
+ Headroom.Command.Run: instance Headroom.Data.Has.Has Headroom.Types.CommandRunOptions Headroom.Command.Run.StartupEnv
+ Headroom.Command.Run: instance Headroom.Data.Has.Has Headroom.Types.Configuration Headroom.Command.Run.Env
+ Headroom.Data.EnumExtra: allValues :: EnumExtra a => [a]
+ Headroom.Data.EnumExtra: allValuesToText :: EnumExtra a => Text
+ Headroom.Data.EnumExtra: class (Bounded a, Enum a, Eq a, Ord a, Show a) => EnumExtra a
+ Headroom.Data.EnumExtra: enumToText :: EnumExtra a => a -> Text
+ Headroom.Data.EnumExtra: textToEnum :: EnumExtra a => Text -> Maybe a
+ Headroom.Data.Has: class Has a t
+ Headroom.Data.Has: getter :: Has a t => t -> a
+ Headroom.Data.Has: hasLens :: Has a t => Lens' t a
+ Headroom.Data.Has: modifier :: Has a t => (a -> a) -> t -> t
+ Headroom.Data.Has: viewL :: (Has a t, MonadReader t m) => m a
+ Headroom.Types: Check :: RunMode
+ Headroom.Types: RunAction :: !Bool -> !Text -> Text -> !Text -> !Text -> RunAction
+ Headroom.Types: [raFunc] :: RunAction -> !Text -> Text
+ Headroom.Types: [raProcessedMsg] :: RunAction -> !Text
+ Headroom.Types: [raProcessed] :: RunAction -> !Bool
+ Headroom.Types: [raSkippedMsg] :: RunAction -> !Text
+ Headroom.Types: data RunAction
+ Headroom.Types: instance Headroom.Data.EnumExtra.EnumExtra Headroom.Types.FileType
+ Headroom.Types: instance Headroom.Data.EnumExtra.EnumExtra Headroom.Types.LicenseType
- Headroom.Command.Init: doesAppConfigExist :: (HasLogFunc env, HasPaths env) => RIO env Bool
+ Headroom.Command.Init: doesAppConfigExist :: (HasLogFunc env, Has Paths env) => RIO env Bool
- Headroom.Command.Init: findSupportedFileTypes :: (HasInitOptions env, HasLogFunc env) => RIO env [FileType]
+ Headroom.Command.Init: findSupportedFileTypes :: (Has CommandInitOptions env, HasLogFunc env) => RIO env [FileType]

Files

CHANGELOG.md view
@@ -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.
README.md view
@@ -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
app/Main.hs view
@@ -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 )
embedded/license/bsd3/haskell.mustache view
@@ -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
headroom.cabal view
@@ -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
src/Headroom/Command.hs view
@@ -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
src/Headroom/Command/Gen.hs view
@@ -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
src/Headroom/Command/Init.hs view
@@ -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
src/Headroom/Command/Readers.hs view
@@ -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
src/Headroom/Command/Run.hs view
@@ -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)
src/Headroom/Command/Utils.hs view
@@ -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   )
src/Headroom/Configuration.hs view
@@ -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
+ src/Headroom/Data/EnumExtra.hs view
@@ -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
+ src/Headroom/Data/Has.hs view
@@ -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
src/Headroom/Embedded.hs view
@@ -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
src/Headroom/FileSupport.hs view
@@ -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
src/Headroom/FileSystem.hs view
@@ -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
src/Headroom/FileType.hs view
@@ -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 
src/Headroom/Meta.hs view
@@ -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
src/Headroom/Regex.hs view
@@ -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
src/Headroom/Serialization.hs view
@@ -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
src/Headroom/Template.hs view
@@ -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
src/Headroom/Template/Mustache.hs view
@@ -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 <https://mustache.github.io Mustache> templates. -}-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE MultiWayIf        #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}+ module Headroom.Template.Mustache   ( Mustache(..)   )
src/Headroom/Types.hs view
@@ -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
− src/Headroom/Types/EnumExtra.hs
@@ -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
src/Headroom/UI.hs view
@@ -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   )
src/Headroom/UI/Progress.hs view
@@ -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
test/Headroom/Command/ReadersSpec.hs view
@@ -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
+ test/Headroom/Data/EnumExtraSpec.hs view
@@ -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+
− test/Headroom/Types/EnumExtraSpec.hs
@@ -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-