-- -- Copyright (c) 2013-2025 Nicola Bonelli -- -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- module Config ( Config (..), dumpPalette, getConfig, ) where import Control.Monad (MonadPlus (mzero), filterM, forM_) import System.Console.ANSI.Types (ConsoleIntensity (BoldIntensity), xterm6LevelRGB) import System.Directory (doesFileExist, getHomeDirectory) import Data.Aeson (FromJSON (parseJSON), (.!=), (.:?)) import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) import qualified Data.Yaml as Y import CGrep.FileType (FileType) import GHC.Generics (Generic) import Data.List.Split (splitOn) import System.FilePath (()) import CGrep.FileKind (FileKind) import System.Console.ANSI (Color (..), ColorIntensity (..), ConsoleLayer (..), SGR (..)) import System.Console.ANSI.Codes (setSGRCode) import Text.Read (readMaybe) cgreprc :: FilePath cgreprc = "cgreprc" data Config = Config { configFileTypes :: [FileType] , configFileKinds :: [FileKind] , configPruneDirs :: [String] , configColors :: Bool , configColorFile :: [SGR] , configColorMatch :: [SGR] , configFileLine :: Bool , configJobs :: Maybe Int } deriving stock (Show, Read) defaultConfig :: Config defaultConfig = Config { configFileTypes = [] , configFileKinds = [] , configPruneDirs = [] , configColors = False , configColorFile = [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Blue] , configColorMatch = [SetConsoleIntensity BoldIntensity] , configFileLine = False , configJobs = Nothing } mkConfig :: YamlConfig -> Config mkConfig YamlConfig{..} = let configFileTypes = mapMaybe readMaybe yamlFileTypes configFileKinds = mapMaybe readMaybe yamlFileKinds configPruneDirs = yamlPruneDirs configColors = yamlColors configColorFile = fromMaybe [] (yamlColorFileName >>= readColor) configColorMatch = fromMaybe [] (yamlColorMatch >>= readColor) configFileLine = yamlFileLine configJobs = yamlJobs in Config{..} data YamlConfig = YamlConfig { yamlFileTypes :: [String] , yamlFileKinds :: [String] , yamlPruneDirs :: [String] , yamlColors :: Bool , yamlColorFileName :: Maybe String , yamlColorMatch :: Maybe String , yamlFileLine :: Bool , yamlJobs :: Maybe Int } deriving stock (Show, Generic) instance Y.FromJSON YamlConfig where parseJSON (Y.Object v) = YamlConfig <$> v .:? "file_types" .!= [] <*> v .:? "file_kinds" .!= [] <*> v .:? "prune_dirs" .!= [] <*> v .:? "colors" .!= False <*> v .:? "color_filename" .!= Nothing <*> v .:? "color_match" .!= Nothing <*> v .:? "file_line" .!= False <*> v .:? "threads" .!= Nothing parseJSON _ = mzero getConfig :: IO (Config, Maybe FilePath) getConfig = do home <- getHomeDirectory confs <- filterM doesFileExist ["." <> cgreprc, home "." <> cgreprc, "/etc" cgreprc] case (listToMaybe confs) of Just fp -> do conf <- Y.decodeFileEither fp case conf of Left e -> errorWithoutStackTrace $ "CGrep:" <> Y.prettyPrintParseException e Right yconf -> return (mkConfig yconf, Just fp) Nothing -> return (defaultConfig, Nothing) readColor :: String -> Maybe [SGR] readColor "Bold" = Just [SetConsoleIntensity BoldIntensity] readColor "Red" = Just [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Red] readColor "Green" = Just [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Green] readColor "Yellow" = Just [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Yellow] readColor "Blue" = Just [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Blue] readColor "Magenta" = Just [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Magenta] readColor "Cyan" = Just [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Cyan] readColor "White" = Just [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid White] readColor "Orange" = Just [SetConsoleIntensity BoldIntensity, SetPaletteColor Foreground $ xterm6LevelRGB 5 2 0] readColor "Acqua" = Just [SetConsoleIntensity BoldIntensity, SetPaletteColor Foreground $ xterm6LevelRGB 2 5 4] readColor xs = case splitOn ":" xs of [r, g, b] -> Just [SetConsoleIntensity BoldIntensity, SetPaletteColor Foreground $ xterm6LevelRGB (read r) (read g) (read b)] _ -> Nothing dumpPalette :: IO () dumpPalette = do let palette = [(r, g, b) | r <- [0 .. 5], g <- [0 .. 5], b <- [0 .. 5]] forM_ palette $ \(r, g, b) -> do putStrLn $ setSGRCode [SetConsoleIntensity BoldIntensity, SetPaletteColor Foreground $ xterm6LevelRGB r g b] <> "COLOR " <> show r <> ":" <> show g <> ":" <> show b <> setSGRCode []