{-# 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-Clause Maintainer : vaclav.svejcar@gmail.com Stability : experimental Portability : POSIX Module containing most of the data types used by the application. -} module Headroom.Types ( -- * Configuration Data Types -- ** Total Configuration Configuration(..) , HeaderConfig(..) , HeadersConfig(..) -- ** Partial Configuration , PartialConfiguration(..) , PartialHeaderConfig(..) , PartialHeadersConfig(..) -- ** Other Configuration Data Types , HeaderSyntax(..) -- * Command Data Types , Command(..) , CommandGenOptions(..) , CommandInitOptions(..) , CommandRunOptions(..) , ConfigurationError(..) , RunAction(..) , RunMode(..) , GenMode(..) -- * Error Data Types , ApplicationError(..) , CommandGenError(..) , CommandInitError(..) , TemplateError(..) -- * Other Data Types , LicenseType(..) , FileType(..) , FileInfo(..) ) where import Control.Exception ( throw ) import Data.Aeson ( FromJSON(..) , Value(String) , genericParseJSON , withObject , (.!=) , (.:?) ) import Data.Monoid ( Last(..) ) import Headroom.Data.EnumExtra ( EnumExtra(..) ) import Headroom.Serialization ( aesonOptions ) 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 -- ^ /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 other -> error $ "Invalid value for run mode: " <> show other -- | Represents what action should the @gen@ command perform. data GenMode = GenConfigFile -- ^ generate /YAML/ config file stub | GenLicense !(LicenseType, FileType) -- ^ generate license header template deriving (Eq, Show) -- | Represents error that can occur during the application execution. data ApplicationError = CommandGenError !CommandGenError -- ^ error specific for the @gen@ command | CommandInitError !CommandInitError -- ^ error specific for the @init@ command | ConfigurationError !ConfigurationError -- ^ error processing configuration | TemplateError !TemplateError -- ^ error processing template deriving (Eq, Show) instance Exception ApplicationError where displayException = T.unpack . \case CommandGenError error' -> commandGenError error' CommandInitError error' -> commandInitError error' ConfigurationError error' -> configurationError error' TemplateError error' -> templateError error' -- | Error specific for the @gen@ command. data CommandGenError = NoGenModeSelected -- ^ no mode of /Gen/ command selected deriving (Eq, Show) -- | Error specific for the @init@ command. data CommandInitError = AppConfigAlreadyExists !FilePath -- ^ application configuration file already exists | NoProvidedSourcePaths -- ^ no paths to source code files provided | NoSupportedFileType -- ^ no supported file types found on source paths deriving (Eq, Show) -- | Error during processing configuration. data ConfigurationError = InvalidVariable !Text -- ^ invalid variable input (as @key=value@) | MixedHeaderSyntax -- ^ illegal configuration for 'HeaderSyntax' | NoFileExtensions !FileType -- ^ no configuration for @file-extensions@ | NoHeaderSyntax !FileType -- ^ no configuration for header syntax | NoMarginAfter !FileType -- ^ no configuration for @margin-after@ | NoMarginBefore !FileType -- ^ no configuration for @margin-before@ | NoPutAfter !FileType -- ^ no configuration for @put-after@ | NoPutBefore !FileType -- ^ no configuration for @put-before@ | NoRunMode -- ^ no configuration for @run-mode@ | NoSourcePaths -- ^ no configuration for @source-paths@ | NoExcludedPaths -- ^ no configuration for @excluded-paths@ | NoTemplatePaths -- ^ no configuration for @template-paths@ | NoVariables -- ^ no configuration for @variables@ deriving (Eq, Show) -- | Error during processing template. data TemplateError = MissingVariables !Text ![Text] -- ^ missing variable values | ParseError !Text -- ^ error parsing raw template text deriving (Eq, Show) -------------------------------------------------------------------------------- -- | Application command. data Command = Run [FilePath] [Text] [FilePath] [Text] (Maybe RunMode) Bool Bool -- ^ @run@ command | Gen Bool (Maybe (LicenseType, FileType)) -- ^ @gen@ command | Init LicenseType [FilePath] -- ^ @init@ command deriving (Show) -------------------------------------------------------------------------------- -- | Options for the @gen@ command. newtype CommandGenOptions = CommandGenOptions { cgoGenMode :: GenMode -- ^ selected mode } deriving (Show) -- | Options for the @init@ command. data CommandInitOptions = CommandInitOptions { cioSourcePaths :: ![FilePath] -- ^ paths to source code files , cioLicenseType :: !LicenseType -- ^ license type } deriving Show -- | Options for the @run@ command. data CommandRunOptions = CommandRunOptions { croRunMode :: !(Maybe RunMode) -- ^ used /Run/ command mode , croSourcePaths :: ![FilePath] -- ^ source code file paths , croExcludedPaths :: ![Text] -- ^ source paths to exclude , croTemplatePaths :: ![FilePath] -- ^ template file paths , croVariables :: ![Text] -- ^ raw variables , croDebug :: !Bool -- ^ whether to run in debug mode , croDryRun :: !Bool -- ^ whether to perform dry run } deriving (Eq, Show) -------------------------------------------------------------------------------- -- | Supported type of source code file. data FileType = C -- ^ support for /C/ programming language | CPP -- ^ support for /C++/ programming language | CSS -- ^ support for /CSS/ | Haskell -- ^ support for /Haskell/ programming language | HTML -- ^ support for /HTML/ | Java -- ^ support for /Java/ programming language | JS -- ^ support for /JavaScript/ programming language | Rust -- ^ support for /Rust/ programming language | Scala -- ^ support for /Scala/ programming language | Shell -- ^ support for /Shell/ deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) -------------------------------------------------------------------------------- -- | Supported type of open source license. data LicenseType = Apache2 -- ^ support for /Apache-2.0/ license | BSD3 -- ^ support for /BSD-3-Clause/ license | GPL2 -- ^ support for /GNU GPL2/ license | GPL3 -- ^ support for /GNU GPL3/ license | MIT -- ^ support for /MIT/ license | MPL2 -- ^ support for /MPL2/ license deriving (Bounded, Enum, EnumExtra, Eq, Ord, Show) -------------------------------------------------------------------------------- -- | Info extracted about the concrete source code file. data FileInfo = FileInfo { fiFileType :: !FileType -- ^ type of the file , fiHeaderConfig :: !HeaderConfig -- ^ configuration for license header , fiHeaderPos :: !(Maybe (Int, Int)) -- ^ position of existing license header , fiVariables :: !(HashMap Text Text) -- ^ additional extracted variables } deriving (Eq, Show) -------------------------------------------------------------------------------- -- | Syntax of the license header comment. data HeaderSyntax = BlockComment !Text !Text -- ^ block (multi-line) comment syntax (e.g. @/* */@) | LineComment !Text -- ^ single line comment syntax (e.g. @//@) deriving (Eq, Show) -- | Application configuration. data Configuration = Configuration { cRunMode :: !RunMode -- ^ mode of the @run@ command , cSourcePaths :: ![FilePath] -- ^ paths to source code files , cExcludedPaths :: ![Text] -- ^ excluded source paths , cTemplatePaths :: ![FilePath] -- ^ paths to template files , cVariables :: !(HashMap Text Text) -- ^ variable values for templates , cLicenseHeaders :: !HeadersConfig -- ^ configuration of license headers } deriving (Eq, Show) -- | Configuration for specific license header. data HeaderConfig = HeaderConfig { hcFileExtensions :: ![Text] -- ^ list of file extensions (without dot) , hcMarginAfter :: !Int -- ^ number of empty lines to put after header , hcMarginBefore :: !Int -- ^ number of empty lines to put before header , hcPutAfter :: ![Text] -- ^ /regexp/ patterns after which to put the header , hcPutBefore :: ![Text] -- ^ /regexp/ patterns before which to put the header , hcHeaderSyntax :: !HeaderSyntax -- ^ syntax of the license header comment } deriving (Eq, Show) -- | Group of 'HeaderConfig' configurations for supported file types. data HeadersConfig = HeadersConfig { hscC :: !HeaderConfig -- ^ configuration for /C/ programming language , hscCpp :: !HeaderConfig -- ^ configuration for /C++/ programming language , hscCss :: !HeaderConfig -- ^ configuration for /CSS/ , hscHaskell :: !HeaderConfig -- ^ configuration for /Haskell/ programming language , hscHtml :: !HeaderConfig -- ^ configuration for /HTML/ , hscJava :: !HeaderConfig -- ^ configuration for /Java/ programming language , hscJs :: !HeaderConfig -- ^ configuration for /JavaScript/ programming language , hscRust :: !HeaderConfig -- ^ configuration for /Rust/ programming language , hscScala :: !HeaderConfig -- ^ configuration for /Scala/ programming language , hscShell :: !HeaderConfig -- ^ configuration for /Shell/ } deriving (Eq, Show) -------------------------------------------------------------------------------- -- | Internal representation of block comment style of 'HeaderSyntax'. data BlockComment' = BlockComment' { bcStartsWith :: !Text -- ^ starting pattern (e.g. @/*@) , bcEndsWith :: !Text -- ^ ending pattern (e.g. @*/@) } deriving (Eq, Generic, Show) -- | Internal representation of the line style of 'HeaderSyntax'. newtype LineComment' = LineComment' { lcPrefixedBy :: Text -- ^ prefix of the comment line (e.g. @//@) } deriving (Eq, Generic, Show) -- | Partial (possibly incomplete) version of 'Configuration'. data PartialConfiguration = PartialConfiguration { pcRunMode :: !(Last RunMode) -- ^ mode of the @run@ command , pcSourcePaths :: !(Last [FilePath]) -- ^ paths to source code files , pcExcludedPaths :: !(Last [Text]) -- ^ excluded source paths , pcTemplatePaths :: !(Last [FilePath]) -- ^ paths to template files , pcVariables :: !(Last (HashMap Text Text)) -- ^ variable values for templates , pcLicenseHeaders :: !PartialHeadersConfig -- ^ configuration of license headers } deriving (Eq, Generic, Show) -- | Partial (possibly incomplete) version of 'HeaderConfig'. data PartialHeaderConfig = PartialHeaderConfig { phcFileExtensions :: !(Last [Text]) -- ^ list of file extensions (without dot) , phcMarginAfter :: !(Last Int) -- ^ number of empty lines to put after header , phcMarginBefore :: !(Last Int) -- ^ number of empty lines to put before header , phcPutAfter :: !(Last [Text]) -- ^ /regexp/ patterns after which to put the header , phcPutBefore :: !(Last [Text]) -- ^ /regexp/ patterns before which to put the header , phcHeaderSyntax :: !(Last HeaderSyntax) -- ^ syntax of the license header comment } deriving (Eq, Generic, Show) -- | Partial (possibly incomplete) version of 'HeadersConfig'. data PartialHeadersConfig = PartialHeadersConfig { phscC :: !PartialHeaderConfig -- ^ configuration for /C/ programming language , phscCpp :: !PartialHeaderConfig -- ^ configuration for /C++/ programming language , phscCss :: !PartialHeaderConfig -- ^ configuration for /CSS/ , phscHaskell :: !PartialHeaderConfig -- ^ configuration for /Haskell/ programming language , phscHtml :: !PartialHeaderConfig -- ^ configuration for /HTML/ , phscJava :: !PartialHeaderConfig -- ^ configuration for /Java/ programming language , phscJs :: !PartialHeaderConfig -- ^ configuration for /JavaScript/ programming language , phscRust :: !PartialHeaderConfig -- ^ configuration for /Rust/ programming language , phscScala :: !PartialHeaderConfig -- ^ configuration for /Scala/ programming language , phscShell :: !PartialHeaderConfig -- ^ configuration for /Shell/ } deriving (Eq, Generic, Show) instance FromJSON BlockComment' where parseJSON = genericParseJSON aesonOptions instance FromJSON LineComment' where parseJSON = genericParseJSON aesonOptions instance FromJSON PartialConfiguration where parseJSON = withObject "PartialConfiguration" $ \obj -> do pcRunMode <- Last <$> obj .:? "run-mode" pcSourcePaths <- Last <$> obj .:? "source-paths" pcExcludedPaths <- Last <$> obj .:? "excluded-paths" pcTemplatePaths <- Last <$> obj .:? "template-paths" pcVariables <- Last <$> obj .:? "variables" pcLicenseHeaders <- obj .:? "license-headers" .!= mempty pure PartialConfiguration { .. } instance FromJSON PartialHeaderConfig where parseJSON = withObject "PartialHeaderConfig" $ \obj -> do phcFileExtensions <- Last <$> obj .:? "file-extensions" phcMarginAfter <- Last <$> obj .:? "margin-after" phcMarginBefore <- Last <$> obj .:? "margin-before" phcPutAfter <- Last <$> obj .:? "put-after" phcPutBefore <- Last <$> obj .:? "put-before" blockComment <- obj .:? "block-comment" lineComment <- obj .:? "line-comment" let phcHeaderSyntax = Last $ headerSyntax blockComment lineComment pure PartialHeaderConfig { .. } where headerSyntax (Just (BlockComment' s e)) Nothing = Just $ BlockComment s e headerSyntax Nothing (Just (LineComment' p)) = Just $ LineComment p headerSyntax Nothing Nothing = Nothing headerSyntax _ _ = throw error' error' = ConfigurationError MixedHeaderSyntax instance FromJSON PartialHeadersConfig where parseJSON = withObject "PartialHeadersConfig" $ \obj -> do phscC <- obj .:? "c" .!= mempty phscCpp <- obj .:? "cpp" .!= mempty phscCss <- obj .:? "css" .!= mempty phscHaskell <- obj .:? "haskell" .!= mempty phscHtml <- obj .:? "html" .!= mempty phscJava <- obj .:? "java" .!= mempty phscJs <- obj .:? "js" .!= mempty phscRust <- obj .:? "rust" .!= mempty phscScala <- obj .:? "scala" .!= mempty phscShell <- obj .:? "shell" .!= mempty pure PartialHeadersConfig { .. } instance Semigroup PartialConfiguration where x <> y = PartialConfiguration { pcRunMode = pcRunMode x <> pcRunMode y , pcSourcePaths = pcSourcePaths x <> pcSourcePaths y , pcExcludedPaths = pcExcludedPaths x <> pcExcludedPaths y , pcTemplatePaths = pcTemplatePaths x <> pcTemplatePaths y , pcVariables = pcVariables x <> pcVariables y , pcLicenseHeaders = pcLicenseHeaders x <> pcLicenseHeaders y } instance Semigroup PartialHeaderConfig where x <> y = PartialHeaderConfig { phcFileExtensions = phcFileExtensions x <> phcFileExtensions y , phcMarginAfter = phcMarginAfter x <> phcMarginAfter y , phcMarginBefore = phcMarginBefore x <> phcMarginBefore y , phcPutAfter = phcPutAfter x <> phcPutAfter y , phcPutBefore = phcPutBefore x <> phcPutBefore y , phcHeaderSyntax = phcHeaderSyntax x <> phcHeaderSyntax y } instance Semigroup PartialHeadersConfig where x <> y = PartialHeadersConfig { phscC = phscC x <> phscC y , phscCpp = phscCpp x <> phscCpp y , phscCss = phscCss x <> phscCss y , phscHaskell = phscHaskell x <> phscHaskell y , phscHtml = phscHtml x <> phscHtml y , phscJava = phscJava x <> phscJava y , phscJs = phscJs x <> phscJs y , phscRust = phscRust x <> phscRust y , phscScala = phscScala x <> phscScala y , phscShell = phscShell x <> phscShell y } instance Monoid PartialConfiguration where mempty = PartialConfiguration mempty mempty mempty mempty mempty mempty instance Monoid PartialHeaderConfig where mempty = PartialHeaderConfig mempty mempty mempty mempty mempty mempty instance Monoid PartialHeadersConfig where mempty = PartialHeadersConfig mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty -------------------------------------------------------------------------------- commandGenError :: CommandGenError -> Text commandGenError = \case NoGenModeSelected -> noGenModeSelected where noGenModeSelected = mconcat [ "Please select at least one option what to generate " , "(see --help for details)" ] commandInitError :: CommandInitError -> Text commandInitError = \case AppConfigAlreadyExists path -> appConfigAlreadyExists path NoProvidedSourcePaths -> noProvidedSourcePaths NoSupportedFileType -> noSupportedFileType where appConfigAlreadyExists path = mconcat ["Configuration file '", T.pack path, "' already exists"] noProvidedSourcePaths = "No source code paths (files or directories) defined" noSupportedFileType = "No supported file type found in scanned source paths" configurationError :: ConfigurationError -> Text configurationError = \case InvalidVariable input -> invalidVariable input MixedHeaderSyntax -> mixedHeaderSyntax NoFileExtensions fileType -> noProp "file-extensions" fileType NoHeaderSyntax fileType -> noProp "block-comment/line-comment" fileType NoMarginAfter fileType -> noProp "margin-after" fileType NoMarginBefore fileType -> noProp "margin-before" fileType NoPutAfter fileType -> noProp "put-after" fileType NoPutBefore fileType -> noProp "put-before" fileType NoRunMode -> noFlag "run-mode" NoSourcePaths -> noFlag "source-paths" NoExcludedPaths -> noFlag "excluded-paths" NoTemplatePaths -> noFlag "template-paths" NoVariables -> noFlag "variables" where invalidVariable = ("Cannot parse variable key=value from: " <>) noProp prop fileType = T.pack $ mconcat ["Missing '", prop, "' configuration key for file type", show fileType] noFlag flag = mconcat ["Missing configuration key: ", flag] mixedHeaderSyntax = mconcat [ "Invalid configuration, combining 'block-comment' with 'line-comment' " , "is not allowed. Either use 'block-comment' to define multi-line " , "comment header, or 'line-comment' to define header composed of " , "multiple single-line comments." ] templateError :: TemplateError -> Text templateError = \case MissingVariables name variables -> missingVariables name variables ParseError msg -> parseError msg where missingVariables name variables = mconcat ["Missing variables for template '", name, "': ", T.pack $ show variables] parseError msg = "Error parsing template: " <> msg