Copyright | (c) Fuzz Leonard 2025 |
---|---|
License | MIT |
Maintainer | cyborg@bionicfuzz.com |
Stability | experimental |
Safe Haskell | None |
Language | Haskell2010 |
Clod.Effects
Description
This module provides types and utilities for working with effects in Clod. It uses a traditional monad transformer stack rather than an algebraic effects system, prioritizing type inference and error reporting clarity.
The module re-exports the core functionality from Clod.Types to provide a clean interface for working with the ClodM monad stack.
Synopsis
- type ClodM a = ReaderT ClodConfig (ExceptT ClodError IO) a
- data ClodError
- data ClodConfig = ClodConfig {
- projectPath :: !FilePath
- stagingDir :: !FilePath
- configDir :: !FilePath
- databaseFile :: !FilePath
- timestamp :: !String
- currentStaging :: !FilePath
- previousStaging :: !(Maybe FilePath)
- testMode :: !Bool
- verbose :: !Bool
- flushMode :: !Bool
- lastMode :: !Bool
- ignorePatterns :: ![IgnorePattern]
- runClodM :: ClodConfig -> ClodM a -> IO (Either ClodError a)
- throwError :: MonadError e m => e -> m a
- catchError :: MonadError e m => m a -> (e -> m a) -> m a
- liftIO :: MonadIO m => IO a -> m a
- ask :: MonadReader r m => m r
- asks :: MonadReader r m => (r -> a) -> m a
- local :: MonadReader r m => (r -> r) -> m a -> m a
Core effect types
type ClodM a = ReaderT ClodConfig (ExceptT ClodError IO) a Source #
The Clod monad
This monad stack combines:
- Reader for dependency injection of ClodConfig
- Error handling with ExceptT for
ClodError
- IO for filesystem, git, and other side effects
This replaces the previous effects-based approach with a simpler, more traditional monad stack.
Errors that can occur during Clod operation
These represent the different categories of errors that can occur during file processing, allowing for specific error handling for each case.
Constructors
FileSystemError !FilePath !IOError | Error related to filesystem operations |
ConfigError !String | Error related to configuration (e.g., invalid settings) |
PatternError !String | Error related to pattern matching (e.g., invalid pattern) |
CapabilityError !String | Error related to capability validation |
DatabaseError !String | Error related to checksums database |
ChecksumError !String | Error related to checksum calculation |
Instances
data ClodConfig Source #
Configuration for the clod program
Constructors
ClodConfig | |
Fields
|
Instances
Generic ClodConfig Source # | |||||
Defined in Clod.Types Associated Types
| |||||
Show ClodConfig Source # | |||||
Defined in Clod.Types Methods showsPrec :: Int -> ClodConfig -> ShowS # show :: ClodConfig -> String # showList :: [ClodConfig] -> ShowS # | |||||
Eq ClodConfig Source # | |||||
Defined in Clod.Types | |||||
type Rep ClodConfig Source # | |||||
Defined in Clod.Types type Rep ClodConfig = D1 ('MetaData "ClodConfig" "Clod.Types" "clod-0.1.4-inplace" 'False) (C1 ('MetaCons "ClodConfig" 'PrefixI 'True) (((S1 ('MetaSel ('Just "projectPath") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 FilePath) :*: (S1 ('MetaSel ('Just "stagingDir") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 FilePath) :*: S1 ('MetaSel ('Just "configDir") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 FilePath))) :*: (S1 ('MetaSel ('Just "databaseFile") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 FilePath) :*: (S1 ('MetaSel ('Just "timestamp") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 String) :*: S1 ('MetaSel ('Just "currentStaging") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 FilePath)))) :*: ((S1 ('MetaSel ('Just "previousStaging") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe FilePath)) :*: (S1 ('MetaSel ('Just "testMode") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool) :*: S1 ('MetaSel ('Just "verbose") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool))) :*: (S1 ('MetaSel ('Just "flushMode") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool) :*: (S1 ('MetaSel ('Just "lastMode") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool) :*: S1 ('MetaSel ('Just "ignorePatterns") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [IgnorePattern])))))) |
Running effects
runClodM :: ClodConfig -> ClodM a -> IO (Either ClodError a) Source #
Run a ClodM computation, returning either an error or a result
Monadic operations
throwError :: MonadError e m => e -> m a #
Is used within a monadic computation to begin exception processing.
catchError :: MonadError e m => m a -> (e -> m a) -> m a #
A handler function to handle previous errors and return to normal execution. A common idiom is:
do { action1; action2; action3 } `catchError` handler
where the action
functions can call throwError
.
Note that handler
and the do-block must have the same return type.
liftIO :: MonadIO m => IO a -> m a #
Lift a computation from the IO
monad.
This allows us to run IO computations in any monadic stack, so long as it supports these kinds of operations
(i.e. IO
is the base monad for the stack).
Example
import Control.Monad.Trans.State -- from the "transformers" library printState :: Show s => StateT s IO () printState = do state <- get liftIO $ print state
Had we omitted
, we would have ended up with this error:liftIO
• Couldn't match type ‘IO’ with ‘StateT s IO’ Expected type: StateT s IO () Actual type: IO ()
The important part here is the mismatch between StateT s IO ()
and
.IO
()
Luckily, we know of a function that takes an
and returns an IO
a(m a)
:
,
enabling us to run the program and see the expected results:liftIO
> evalStateT printState "hello" "hello" > evalStateT printState 3 3
Reader operations
ask :: MonadReader r m => m r #
Retrieves the monad environment.
Arguments
:: MonadReader r m | |
=> (r -> a) | The selector function to apply to the environment. |
-> m a |
Retrieves a function of the current environment.
Arguments
:: MonadReader r m | |
=> (r -> r) | The function to modify the environment. |
-> m a |
|
-> m a |
Executes a computation in a modified environment.