diff --git a/CHANGELOG.md b/CHANGELOG.md index 51b76db..0c3349f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,16 @@ `lineman` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 1.0.5 + +* Restructure modules +* Differ raw and domain types +* Add option for swarm concurrency +* Prevent processing of invalid paths and absent targets +* Add delay option to config +* Use clear namings +* Update README + ## 1.0.4 * Land on `typed-base` diff --git a/README.md b/README.md index 2a61ecb..aea9ad1 100644 --- a/README.md +++ b/README.md @@ -26,8 +26,22 @@ And either Lineman uses [dhall](https://dhall-lang.org) configuration. See [Config](./lineman.dhall) example. -According to the config `lineman`: -- traverses target directory recursively. -- finds directories that have `lineman.cabal` file. -- apply `mkdir test_dir` in the found directories. +## Term policy + +- `Action` - a single command that run in a directory due to particular `conditions` +- `Conditions` describe the directory has to have to run `action` +- `EntryPoint` is a parent directory where `lineman` starts seeking for `targets` +- `Target` is a directory that aligns to `condition` +- `Swarm` is a bunch of `actions` that match to `condition` +- `Hive` is a collection of `swarms` + +## Features + +- Both `actions` in a `swarm` and `swarms` in a `hive` can be run concurrently or successively +- Both `actions` and `swarms` can be interspersed with breaks +- `Lineman` starts seeking `targets` from `entryPoint` recursively and finds directories that have particular subdirectories, files or extensions. And then it run `Action` in found `targets`. + +## Use cases + +- Clear build artefact in bunch of projects. diff --git a/justfile b/justfile index c82b57e..e0c7c40 100644 --- a/justfile +++ b/justfile @@ -12,6 +12,9 @@ install: build: cabal build +run: + cabal run lineman -- ./lineman.dhall + # update the bounds of dependencies update: cabal-bounds update diff --git a/lineman.cabal b/lineman.cabal index d951b4d..41dfe04 100644 --- a/lineman.cabal +++ b/lineman.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: lineman -version: 1.0.4 +version: 1.0.5 synopsis: traverse directory and run command description: Lineman traverses directory recursively and run command by condition @@ -54,18 +54,18 @@ library hs-source-dirs: src exposed-modules: App - Cook + Type.Raw + Type.Domain + Parser Concurrent Lineman Log - Types build-depends: , containers , dhall , directory , extra - , filepath , katip , ki , monad-control diff --git a/lineman.dhall b/lineman.dhall index d2d4cfc..82f4e88 100644 --- a/lineman.dhall +++ b/lineman.dhall @@ -1,37 +1,72 @@ -let Condition : Type = - { hasFiles : List Text - , hasDirectories : List Text - , hasExtensions : List Text - , command : Text - , args : List Text - } - -let condition1 : Condition = - { hasFiles = ["stack.yaml"] : List Text - -- ^ Target directory has files - , hasDirectories = [".exercism"] : List Text - -- ^ Target directory has directories - , hasExtensions = [] : List Text - -- ^ Target directory has extensions. +let RawCondition : Type = + { rcIndex : Natural + -- Arbitrary index + , rcEntryPoint : Text + -- ^ first target where lineman starts recursively from. + -- target consume 'rel', 'abs' and '~'' paths + , rcHasFiles : List Text + -- ^ Target directory has files that have to be relative to target path. + , rcHasDirectories : List Text + -- ^ Target directory has directories that have to be relative to target path + , rcHasExtensions : List Text + -- ^ Target directory has files with these extensions. -- It consume exts with and without '.' - , command = "ls" + , rcCommand : Text -- ^ Command to run in searched directories - , args = [] : List Text + , rcArgs : List Text -- ^ Command's arguments + , rcConcurrentAgents : Bool + -- ^ run actions concurrently within the particular condition + , rcBreakBetweenAgents : Double + -- ^ Interval between actions in seconds + } + +let condition_1 : RawCondition = + { rcIndex = 1 + , rcEntryPoint = "~/source/test/" + , rcHasFiles = ["a/log"] : List Text + , rcHasDirectories = [] : List Text + , rcHasExtensions = [] : List Text + , rcCommand = "touch" + , rcArgs = ["readme.txt"] : List Text + , rcConcurrentAgents = False + , rcBreakBetweenAgents = 1.0 + } + +let condition_2 : RawCondition = + { rcIndex = 2 + , rcEntryPoint = "~/source/test/" + , rcHasFiles = ["a/log"] : List Text + , rcHasDirectories = [] : List Text + , rcHasExtensions = [] : List Text + , rcCommand = "rm" + , rcArgs = ["readme.txt"] : List Text + , rcConcurrentAgents = False + , rcBreakBetweenAgents = 1.0 } let Verbosity : Type = < V0 | V1 | V2 | V3 > --- ^ levels of verbosity let Severity : Type = < DebugS | InfoS | NoticeS | WarningS | ErrorS | CriticalS | AlertS | EmergencyS > -in { cTarget = "your/path" - -- ^ target where you plan that the lineman recursively starts from. - -- target consume 'rel', 'abs' and '~'' paths - , cConditions = [ condition1 ] : List Condition - -- ^ within the target one can run several commands with its own conditions - , cAsync = False - -- ^ make lineman to work concurrently - , cSeverity = Severity.DebugS - , cVerbosity = Verbosity.V0 - } \ No newline at end of file +let Config : Type = + { confRawConditions : List RawCondition + -- ^ within the target it is possible to run several commands with own conditions + , confSeverity : Severity + , confVerbosity : Verbosity +-- ^ level of verbosity + , confConcurrentSwarms : Bool + -- ^ run the swarm of actions concurrently + , confBreakBetweenSwarms : Double + -- ^ add delay of running next batch of actions (in seconds) + } + +let config : Config = + { confRawConditions = [ condition_1, condition_2 ] : List RawCondition + , confSeverity = Severity.DebugS + , confVerbosity = Verbosity.V0 + , confConcurrentSwarms = False + , confBreakBetweenSwarms = 5.0 + } + +in config \ No newline at end of file diff --git a/src/App.hs b/src/App.hs index 35342f6..bacc878 100644 --- a/src/App.hs +++ b/src/App.hs @@ -2,15 +2,14 @@ module App ( appLineman, ) where -import Cook (safeHead) -import Lineman (launchAction) +import Lineman (launchSwarm) import Log (mkLogEnv) -import Types (App (unApp), Config (..), Env (..)) -import Concurrent (forConcurrentlyKi) +import Parser (prepareConditions, safeHead) +import Type.Domain (App (unApp), Env (..)) +import Type.Raw (Config (..)) --- import Control.Concurrent.Async.Lifted (forConcurrently) import Control.Exception.Safe (throwIO, tryAny) -import Control.Monad (forM, when) +import Control.Monad (when) import Control.Monad.Reader (ReaderT (..)) import Dhall (auto, inputFile) import System.Environment (getArgs) @@ -27,20 +26,21 @@ appLineman = do pPrintString "Launch command with that Config? (yes/no)" str <- getLine when (str == "yes") $ do - logEnv <- mkLogEnv (cVerbosity config) (cSeverity config) - let env = - Env - { envLogEnv = logEnv - , envActionMode = - if cAsync config - then forConcurrentlyKi - else forM - , envLogContext = mempty - , envLogNamespace = mempty - , envTarget = cTarget config - , envConditions = cConditions config - } - runApp env launchAction + mConditions <- prepareConditions $ confRawConditions config + case mConditions of + Nothing -> pPrintString "No conditions found in config file for running lineman" + Just conditions -> do + logEnv <- mkLogEnv (confVerbosity config) (confSeverity config) + let env = + Env + { envLogEnv = logEnv + , envLogContext = mempty + , envLogNamespace = mempty + , envConditions = conditions + , envSwarmConcurrent = confConcurrentSwarms config + , envSwarmBreak = confBreakBetweenSwarms config + } + runApp env launchSwarm runApp :: Env -> App a -> IO a runApp env app = runReaderT (unApp app) env @@ -53,4 +53,3 @@ getConfig path = do pPrintString "Config parsing failed" throwIO err Right decoded -> pure decoded - diff --git a/src/Concurrent.hs b/src/Concurrent.hs index 4f15845..a22b666 100644 --- a/src/Concurrent.hs +++ b/src/Concurrent.hs @@ -4,6 +4,7 @@ module Concurrent ( forConcurrentlyKi, + forConcurrentlyKi_, ) where import Control.Concurrent.STM (atomically) @@ -13,14 +14,23 @@ import Control.Monad.Trans.Control (MonadBaseControl, StM, control) import Ki forConcurrentlyKi - :: (MonadBaseControl IO m, StM m (Ki.Thread b) ~ Ki.Thread b, StM m b ~ b, MonadIO m) - => [a] + :: (Traversable t, MonadBaseControl IO m, StM m (Ki.Thread b) ~ Ki.Thread b, StM m b ~ b, MonadIO m) + => t a -> (a -> m b) - -> m [b] + -> m (t b) forConcurrentlyKi ns f = control $ \unlift -> scopedM \scope -> unlift $ do threads <- mapM (forkM scope . f) ns mapM (liftBase . atomically . Ki.await) threads +forConcurrentlyKi_ + :: (Traversable t, MonadBaseControl IO m, StM m (Ki.Thread b) ~ Ki.Thread b, StM m b ~ b, MonadIO m) + => t a + -> (a -> m b) + -> m () +forConcurrentlyKi_ ns f = control $ \unlift -> scopedM \scope -> unlift $ do + threads <- mapM (forkM scope . f) ns + mapM_ (liftBase . atomically . Ki.await) threads + forkM :: (MonadBaseControl IO m, StM m (Ki.Thread a) ~ Ki.Thread a, StM m a ~ a) => Ki.Scope diff --git a/src/Cook.hs b/src/Cook.hs deleted file mode 100644 index 43a4b1d..0000000 --- a/src/Cook.hs +++ /dev/null @@ -1,78 +0,0 @@ -module Cook ( - safeHead, - prepareConditions, -) where - -import Control.Monad (forM) -import qualified Control.Monad.Extra as E -import qualified Data.List.Extra as E -import Data.Maybe (fromMaybe) -import Data.Set (toList) -import Path.IO (AnyPath (makeAbsolute)) -import Path.Posix ( - Abs, - Dir, - File, - Path, - Rel, - SomeBase (Abs, Rel), - parseRelDir, - parseSomeDir, - parseSomeFile, - ) -import qualified System.Directory as D -import qualified System.FilePath.Posix as FP - -import Control.Monad.IO.Class (liftIO) -import Types (App, Conditions (..)) - -safeHead :: [a] -> Maybe a -safeHead [] = Nothing -safeHead (a : _) = Just a - --- Normilize functions - -normilizeDirAbs :: FilePath -> App (Maybe (Path Abs Dir)) -normilizeDirAbs path = do - let (homeMarker, relPath) = splitAt 1 path - path' <- E.whenMaybe (homeMarker == "~") $ do - home <- liftIO D.getHomeDirectory - pure $ home <> "/" <> relPath - someDir <- liftIO $ parseSomeDir $ fromMaybe path path' - case someDir of - Abs a -> pure $ Just a - Rel r -> Just <$> makeAbsolute r - -normilizeDirRel :: FilePath -> App (Path Rel Dir) -normilizeDirRel = liftIO . parseRelDir - -normilizeFile :: FilePath -> App (Maybe (Path Rel File)) -normilizeFile path = - if FP.isRelative path && FP.isValid path && not (FP.hasTrailingPathSeparator path) - then do - someFile <- liftIO $ parseSomeFile path - case someFile of - Abs _ -> pure Nothing - Rel r -> pure $ Just r - else pure Nothing - -prepareConditions - :: FilePath - -> [Conditions] - -> App - [ ( Maybe (Path Abs Dir) - , Maybe [Path Rel File] - , [Path Rel Dir] - , [String] - , String - , [String] - ) - ] -prepareConditions target conditions = do - mTarget <- normilizeDirAbs $ E.trim target - forM conditions $ \Conditions{..} -> do - mFiles <- sequence <$> traverse normilizeFile (toList hasFiles) - dirs <- traverse normilizeDirRel $ toList hasDirectories - let normalizedExt e = if "." == take 1 e then e else '.' : e - let exts = map normalizedExt $ toList hasExtensions - pure (mTarget, mFiles, dirs, exts, command, args) diff --git a/src/Lineman.hs b/src/Lineman.hs index dd7b917..6414170 100644 --- a/src/Lineman.hs +++ b/src/Lineman.hs @@ -1,57 +1,68 @@ {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE BangPatterns #-} module Lineman ( - launchAction, + launchSwarm, ) where --- import Control.Concurrent (threadDelay) +import Concurrent (forConcurrentlyKi, forConcurrentlyKi_) +import Type.Domain (App, Condition (..), Env (..)) + import Control.Exception.Safe (try) -import Control.Monad (forM_) +import Control.Monad (forM, forM_, when) import qualified Control.Monad.Extra as E import Control.Monad.IO.Class (liftIO) -import Control.Monad.Reader (asks) -import Cook (prepareConditions) +import Control.Monad.Reader (ask) +import Data.Text (Text) +import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Text as T import Log (logDebug, logError, logInfo) import Path.IO (doesDirExist, doesFileExist, listDir, listDirRecur) import Path.Posix (Abs, Dir, File, Path, PathException, Rel, fileExtension, toFilePath, ()) import System.Process.Extra (showCommandForUser) import System.Process.Typed -import Types (App, Env (..)) import Witch import Prelude hiding (log) +import System.Time.Extra (sleep) -launchAction :: App () -launchAction = do - target <- asks envTarget - conditions <- asks envConditions - list <- prepareConditions target conditions - logDebug $ T.pack $ show list - forM_ list $ \(mTarget, mFiles, dirs, exts, command, args) -> do - dirsForLaunch <- case (mTarget, mFiles) of - (Just t, Just fs) -> getDirsForCommand t fs dirs exts - _ -> pure [] - logDebug $ "Directories for running action: " <> T.pack (show dirsForLaunch) - forAction <- asks envActionMode - codes <- seq dirsForLaunch $ - forAction dirsForLaunch $ \d -> do - let act = showCommandForUser command args - let dir = T.pack (show d) - logInfo $ "Action \'" <> T.pack act <> "\' is running in " <> dir - action command args d +launchSwarm :: App () +launchSwarm = do + env <- ask + let conditions = envConditions env + logDebug $ "Conditions: " <> into @Text (show conditions) + let forSwarm = if envSwarmConcurrent env then forConcurrentlyKi_ else forM_ + let firstIndex = cIndex $ NonEmpty.head conditions + forSwarm conditions $ \Condition{..} -> do + when (cIndex /= firstIndex) $ liftIO $ sleep $ envSwarmBreak env + dirsForLaunch <- getDirsForCommand cEntryPoint cFiles cDirectories cExtensions + logDebug $ "Directories for running action: " <> into @Text (show dirsForLaunch) + let forAction = if cActConcurrent then forConcurrentlyKi else forM + let firstDirectory = seq dirsForLaunch $ head dirsForLaunch + codes <- forAction dirsForLaunch $ \d -> do + when (d /= firstDirectory) $ liftIO $ sleep cWithBreak + let act = showCommandForUser cCommand cArguments + let dir = into @Text (show d) + logInfo $ "Action \'" <> into @Text act <> "\' is running in " <> dir + action cCommand cArguments d if all (== ExitSuccess) codes - then logInfo "All actions successfuly finished!" + then logInfo "All actions successfully finished!" else logError "Some action(s) failed" + -getDirsForCommand :: Path Abs Dir -> [Path Rel File] -> [Path Rel Dir] -> [String] -> App [Path Abs Dir] +getDirsForCommand + :: Path Abs Dir + -> [Path Rel File] + -> [Path Rel Dir] + -> [String] + -> App [Path Abs Dir] getDirsForCommand target files dirs exts = do (targets, _) <- listDirRecur target seq targets $ do res <- findDirsDyFiles (target : targets) files dirs exts - logDebug $ "Found directories: " <> T.pack (show res) + logDebug $ "Found directories: " <> into @Text (show res) pure res action :: FilePath -> [String] -> Path Abs Dir -> App ExitCode @@ -64,17 +75,21 @@ action commandName args path = do readProcess dateConfig case stderr of "" -> pure () - err -> logError $ "In " - <> T.pack (show path) - <> " occurred stderr: \n" - <> T.strip (unsafeInto @T.Text $ into @Utf8L err) + err -> + logError $ + "In " + <> into @Text (toFilePath path) + <> " occurred stderr: \n" + <> T.strip (unsafeInto @Text $ into @Utf8L err) case stdout of "" -> pure () - out -> logDebug $ "In " - <> T.pack (show path) - <> " occurred stdout: \n" - <> unsafeInto @T.Text (into @Utf8L out) - logDebug $ T.pack (show exitCode) + out -> + logDebug $ + "In " + <> into @Text (toFilePath path) + <> " occurred stdout: \n" + <> unsafeInto @Text (into @Utf8L out) + logDebug $ into @Text (show exitCode) pure exitCode findDirsDyFiles @@ -93,9 +108,9 @@ findDirsDyFiles d [] [] [] = pure d findDirsDyFiles (d : ds) files dirs exts = do dFiles <- snd <$> listDir d existFiles <- E.allM (\f -> doesFileExist $ d f) files - logDebug $ "In directory: " <> T.pack (show d) - logDebug $ "file(s) " <> T.pack (show files) - logDebug $ "exist? " <> T.pack (show existFiles) + logDebug $ "In directory: " <> into @Text (toFilePath d) + logDebug $ "file(s) " <> into @Text (show files) + logDebug $ "exist? " <> into @Text (show existFiles) existDirs <- E.allM (\f -> doesDirExist $ d f) dirs existExts <- isExtsInFiles exts dFiles if existFiles && existDirs && existExts diff --git a/src/Parser.hs b/src/Parser.hs new file mode 100644 index 0000000..7af895a --- /dev/null +++ b/src/Parser.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE TypeApplications #-} + +module Parser ( + safeHead, + prepareConditions, +) where + +import Type.Domain (Condition (..)) +import Type.Raw (RawCondition (..)) + +import Control.Monad (forM) +import qualified Control.Monad.Extra as E +import qualified Data.List.Extra as E +import Data.Maybe (fromMaybe) +import Data.Set (toList) +import Path.IO (AnyPath (makeAbsolute)) +import Path.Posix ( + Abs, + Dir, + File, + Path, + PathException, + Rel, + SomeBase (Abs, Rel), + parseRelDir, + parseRelFile, + parseSomeDir, + toFilePath, + ) + +import Control.Exception (catch, throwIO) +import Control.Monad.Extra (whenM) +import Data.List.NonEmpty (NonEmpty, nonEmpty) +import System.Directory (doesDirectoryExist) +import qualified System.Directory as D +import Text.Pretty.Simple (pPrintString, pString) +import Witch (into) + +safeHead :: [a] -> Maybe a +safeHead [] = Nothing +safeHead (a : _) = Just a + +-- Normalize functions + +normalizeDirAbs :: Word -> FilePath -> IO (Path Abs Dir) +normalizeDirAbs index path = do + let (homeMarker, relPath) = splitAt 1 path + path' <- E.whenMaybe (homeMarker == "~") $ do + home <- D.getHomeDirectory + pure $ home <> "/" <> relPath + someDir <- catch @PathException (parseSomeDir $ fromMaybe path path') $ \e -> do + pPrintString $ "Target path " <> path <> " from condition " <> show index <> " is invalid" + throwIO e + aPath <- case someDir of + Abs a -> pure a + Rel r -> makeAbsolute r + whenM (not <$> doesDirectoryExist (toFilePath aPath)) $ + throwIO $ + userError $ + into @String $ + pString "Target path not found" + pure aPath + +normalizeRelFile :: FilePath -> IO (Path Rel File) +normalizeRelFile path = catch @PathException (parseRelFile path) $ \e -> do + pPrintString $ "File path " <> path <> " is invalid" + throwIO e + +normalizeRelDir :: FilePath -> IO (Path Rel Dir) +normalizeRelDir path = catch @PathException (parseRelDir path) $ \e -> do + pPrintString $ "Directory path " <> path <> " is invalid" + throwIO e + +prepareConditions + :: [RawCondition] + -> IO (Maybe (NonEmpty Condition)) +prepareConditions raw = do + conditions <- forM raw $ \RawCondition{..} -> do + target <- normalizeDirAbs rcIndex $ E.trim rcEntryPoint + files <- mapM normalizeRelFile $ toList rcHasFiles + dirs <- traverse normalizeRelDir $ toList rcHasDirectories + let normalizedExt e = if "." == take 1 e then e else '.' : e + let exts = map normalizedExt $ toList rcHasExtensions + pure $ + Condition + { cIndex = rcIndex + , cEntryPoint = target + , cFiles = files + , cDirectories = dirs + , cExtensions = exts + , cCommand = rcCommand + , cArguments = rcArgs + , cActConcurrent = rcConcurrentAgents + , cWithBreak = rcBreakBetweenAgents + } + pure $ nonEmpty conditions diff --git a/src/Types.hs b/src/Type/Domain.hs similarity index 63% rename from src/Types.hs rename to src/Type/Domain.hs index 8f73ee8..ce473f8 100644 --- a/src/Types.hs +++ b/src/Type/Domain.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -7,18 +6,13 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StrictData #-} -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -module Types ( +module Type.Domain ( App (..), Env (..), - Conditions (..), - Config (..), - ActionMode, + Condition (..), ) where import Control.Exception.Safe (MonadCatch, MonadMask, MonadThrow) @@ -31,14 +25,11 @@ import Control.Monad.Reader ( local, ) import Control.Monad.Trans.Control (MonadBaseControl) -import Data.Set (Set) -import Dhall (FromDhall (..)) -import GHC.Generics (Generic) -import GHC.IO.Exception (ExitCode (..)) -import Katip (Katip (..), KatipContext (..), LogContexts, LogEnv (..), Namespace, Severity, Verbosity) +import Data.List.NonEmpty (NonEmpty) +import Katip (Katip (..), KatipContext (..), LogContexts, LogEnv (..), Namespace) +import Path (File, Rel) import Path.Posix (Abs, Dir, Path) - newtype App a = MkApp { unApp :: ReaderT Env IO a } @@ -75,36 +66,26 @@ instance KatipContext App where localKatipNamespace f (MkApp m) = MkApp (local (\s -> s{envLogNamespace = f (envLogNamespace s)}) m) -type ActionMode = [Path Abs Dir] -> (Path Abs Dir -> App ExitCode) -> App [ExitCode] +-- type ActionMode = [Path Abs Dir] -> (Path Abs Dir -> App ExitCode) -> App [ExitCode] data Env = Env { envLogEnv :: LogEnv - , envActionMode :: ActionMode , envLogContext :: LogContexts , envLogNamespace :: Namespace - , envTarget :: FilePath - , envConditions :: [Conditions] + , envConditions :: NonEmpty Condition + , envSwarmConcurrent :: Bool + , envSwarmBreak :: Double } -data Config = Config - { cTarget :: FilePath - , cConditions :: [Conditions] - , cAsync :: Bool - , cSeverity :: Severity - , cVerbosity :: Verbosity - } - deriving stock (Eq, Show, Generic) - deriving anyclass (FromDhall) - -deriving anyclass instance FromDhall Verbosity -deriving anyclass instance FromDhall Severity - -data Conditions = Conditions - { hasFiles :: Set FilePath - , hasDirectories :: Set FilePath - , hasExtensions :: Set String - , command :: String - , args :: [String] +data Condition = Condition + { cIndex :: Word + , cEntryPoint :: Path Abs Dir + , cFiles :: [Path Rel File] + , cDirectories :: [Path Rel Dir] + , cExtensions :: [String] + , cCommand :: String + , cArguments :: [String] + , cActConcurrent :: Bool + , cWithBreak :: Double } - deriving stock (Eq, Show, Generic, Ord) - deriving anyclass (FromDhall) + deriving stock (Show, Eq) diff --git a/src/Type/Raw.hs b/src/Type/Raw.hs new file mode 100644 index 0000000..bd84e59 --- /dev/null +++ b/src/Type/Raw.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Type.Raw ( + RawCondition (..), + Config (..), +) +where + +import Data.Set (Set) +import Dhall (FromDhall (..)) +import GHC.Generics (Generic) +import Katip (Severity, Verbosity) + +data RawCondition = RawCondition + { rcIndex :: Word + , rcEntryPoint :: FilePath + , rcHasFiles :: Set FilePath + , rcHasDirectories :: Set FilePath + , rcHasExtensions :: Set String + , rcCommand :: String + , rcArgs :: [String] + , rcConcurrentAgents :: Bool + , rcBreakBetweenAgents :: Double + } + deriving stock (Eq, Show, Generic, Ord) + deriving anyclass (FromDhall) + +data Config = Config + { confRawConditions :: [RawCondition] + , confSeverity :: Severity + , confVerbosity :: Verbosity + , confConcurrentSwarms :: Bool + , confBreakBetweenSwarms :: Double + } + deriving stock (Eq, Show, Generic) + deriving anyclass (FromDhall) + +deriving anyclass instance FromDhall Verbosity + +deriving anyclass instance FromDhall Severity