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 +4/−0
- README.md +0/−8
- app/Main.hs +7/−5
- embedded/license/bsd3/haskell.mustache +1/−1
- headroom.cabal +12/−9
- src/Headroom/Command.hs +13/−6
- src/Headroom/Command/Gen.hs +6/−3
- src/Headroom/Command/Init.hs +28/−33
- src/Headroom/Command/Readers.hs +7/−5
- src/Headroom/Command/Run.hs +94/−62
- src/Headroom/Command/Utils.hs +4/−2
- src/Headroom/Configuration.hs +6/−4
- src/Headroom/Data/EnumExtra.hs +72/−0
- src/Headroom/Data/Has.hs +37/−0
- src/Headroom/Embedded.hs +5/−3
- src/Headroom/FileSupport.hs +7/−5
- src/Headroom/FileSystem.hs +4/−2
- src/Headroom/FileType.hs +7/−5
- src/Headroom/Meta.hs +5/−3
- src/Headroom/Regex.hs +5/−3
- src/Headroom/Serialization.hs +6/−4
- src/Headroom/Template.hs +5/−3
- src/Headroom/Template/Mustache.hs +6/−5
- src/Headroom/Types.hs +24/−11
- src/Headroom/Types/EnumExtra.hs +0/−71
- src/Headroom/UI.hs +4/−2
- src/Headroom/UI/Progress.hs +4/−2
- test/Headroom/Command/ReadersSpec.hs +1/−1
- test/Headroom/Data/EnumExtraSpec.hs +36/−0
- test/Headroom/Types/EnumExtraSpec.hs +0/−36
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-