zifter-0.0.1.8: zifter

Safe HaskellNone
LanguageHaskell2010

Zifter

Contents

Description

The main Zifter module.

In most cases this should be the only module you import to start writing a zift.hs script. You will most likely want to import the appropriate modules from the 'zifter-*' companion packages.

Synopsis

Documentation

ziftWith :: ZiftScript () -> IO () Source #

Run a ZiftScript to create the ZiftSetup, and then use ziftWithSetup

ziftWith = renderZiftSetup >=> ziftWithSetup

ziftWithSetup :: ZiftSetup -> IO () Source #

Build a zifter using a ZiftSetup.

A zifter has the capabilities that you would expect from a 'zift.hs' file:

  • zift.hs run: Run the zift.hs script as a pre-commit hook.
  • zift.hs preprocess: Run the preprocessor
  • zift.hs precheck: Run the prechecker
  • zift.hs check: Run the checker
  • zift.hs install: Install the zift.hs script as a pre-commit hook.

Defining your own zift scripts

preprocessor :: Zift () -> ZiftScript () Source #

Add a given zift action as a preprocessor.

prechecker :: Zift () -> ZiftScript () Source #

Add a given zift action as a prechecker.

checker :: Zift () -> ZiftScript () Source #

Add a given zift action as a checker.

ziftP :: [Zift ()] -> Zift () Source #

Declare a given list of Zift actions to be execute in parallel.

mapZ :: (a -> Zift b) -> [a] -> Zift [b] Source #

Like mapA, but specialised to Zift and '[]', and ensures that the output of actions is printed in the right order, even if they are executed in an arbitrary order.

mapZ_ :: (a -> Zift b) -> [a] -> Zift () Source #

Like mapA_, but specialised to Zift and '[]', and ensures that the output of actions is printed in the right order, even if they are executed in an arbitrary order.

forZ :: [a] -> (a -> Zift b) -> Zift [b] Source #

Like for, but specialised to Zift and '[]', and ensures that the output of actions is printed in the right order, even if they are executed in an arbitrary order.

forZ_ :: [a] -> (a -> Zift b) -> Zift () Source #

Like for_, but specialised to Zift and '[]', and ensures that the output of actions is printed in the right order.

recursiveZift :: ZiftScript () Source #

Recursively call each zift.hs script in the directories below the directory of the currently executing zift.hs script.

Only the topmost zift.hs script in each directory is executed. This means that, to execute all zift.hs scripts recursively, each of those zift.hs scripts must also have a recursiveZift declaration.

data ZiftScript a Source #

Instances

Monad ZiftScript Source # 

Methods

(>>=) :: ZiftScript a -> (a -> ZiftScript b) -> ZiftScript b #

(>>) :: ZiftScript a -> ZiftScript b -> ZiftScript b #

return :: a -> ZiftScript a #

fail :: String -> ZiftScript a #

Functor ZiftScript Source # 

Methods

fmap :: (a -> b) -> ZiftScript a -> ZiftScript b #

(<$) :: a -> ZiftScript b -> ZiftScript a #

Applicative ZiftScript Source # 

Methods

pure :: a -> ZiftScript a #

(<*>) :: ZiftScript (a -> b) -> ZiftScript a -> ZiftScript b #

liftA2 :: (a -> b -> c) -> ZiftScript a -> ZiftScript b -> ZiftScript c #

(*>) :: ZiftScript a -> ZiftScript b -> ZiftScript b #

(<*) :: ZiftScript a -> ZiftScript b -> ZiftScript a #

Generic (ZiftScript a) Source # 

Associated Types

type Rep (ZiftScript a) :: * -> * #

Methods

from :: ZiftScript a -> Rep (ZiftScript a) x #

to :: Rep (ZiftScript a) x -> ZiftScript a #

type Rep (ZiftScript a) Source # 
type Rep (ZiftScript a) = D1 * (MetaData "ZiftScript" "Zifter.Script.Types" "zifter-0.0.1.8-3ERxpTErtznAlOPG1cr0A4" True) (C1 * (MetaCons "ZiftScript" PrefixI True) (S1 * (MetaSel (Just Symbol "renderZiftScript") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (IO (a, ZiftSetup)))))

Defining your own zift actions

data Zift a Source #

Instances

Monad Zift Source #

Zift actions can be composed.

Methods

(>>=) :: Zift a -> (a -> Zift b) -> Zift b #

(>>) :: Zift a -> Zift b -> Zift b #

return :: a -> Zift a #

fail :: String -> Zift a #

Functor Zift Source # 

Methods

fmap :: (a -> b) -> Zift a -> Zift b #

(<$) :: a -> Zift b -> Zift a #

MonadFail Zift Source #

A Zift action can fail.

To make a Zift action fail, you can use the fail :: String -> Zift a function.

The implementation uses the given string as the message that is shown at the very end of the run.

Methods

fail :: String -> Zift a #

Applicative Zift Source #

Zift actions can be sequenced.

The implementation automatically parallelises the arguments of the (*) function. If any of the actions fails, the other is cancelled and the result fails.

Methods

pure :: a -> Zift a #

(<*>) :: Zift (a -> b) -> Zift a -> Zift b #

liftA2 :: (a -> b -> c) -> Zift a -> Zift b -> Zift c #

(*>) :: Zift a -> Zift b -> Zift b #

(<*) :: Zift a -> Zift b -> Zift a #

MonadIO Zift Source #

Any IO action can be part of a Zift action.

This is the most important instance for the end user.

liftIO :: IO a -> Zift a

allows embedding arbitrary IO actions inside a Zift action.

The implementation also ensures that exceptions are caught.

Methods

liftIO :: IO a -> Zift a #

MonadThrow Zift Source # 

Methods

throwM :: Exception e => e -> Zift a #

Monoid a => Monoid (Zift a) Source # 

Methods

mempty :: Zift a #

mappend :: Zift a -> Zift a -> Zift a #

mconcat :: [Zift a] -> Zift a #

getRootDir :: Zift (Path Abs Dir) Source #

Get the root directory of the zift.hs script that is being executed.

getTmpDir :: Zift (Path Abs Dir) Source #

Get the temporary directory of the zift.hs script that is being executed.

To persist any state between runs, use this directory.

getSetting :: (Settings -> a) -> Zift a Source #

Get a single setting

data Settings Source #

Instances

Eq Settings Source # 
Show Settings Source # 
Generic Settings Source # 

Associated Types

type Rep Settings :: * -> * #

Methods

from :: Settings -> Rep Settings x #

to :: Rep Settings x -> Settings #

type Rep Settings Source # 
type Rep Settings = D1 * (MetaData "Settings" "Zifter.OptParse.Types" "zifter-0.0.1.8-3ERxpTErtznAlOPG1cr0A4" False) (C1 * (MetaCons "Settings" PrefixI True) ((:*:) * (S1 * (MetaSel (Just Symbol "setsOutputColor") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Bool)) (S1 * (MetaSel (Just Symbol "setsOutputMode") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * OutputMode))))

Console outputs of a zift action

Because Zift actions are automatically parallelised, it is important that they do not arbitrarily output data to the console. Instead, you should use these functions to output to the console.

The ziftWith and ziftWithSetup functions will take care of ensuring that the output appears linear.

printZift :: String -> Zift () Source #

Print a message (with a newline appended to the end).

printZiftMessage :: String -> Zift () Source #

Print a message (with a newline appended to the end), in the standard zift script color. This is the function that the zift script uses to output information about the stages of the zift script run.

printPreprocessingDone :: String -> Zift () Source #

Print a message (with a newline appended to the end) that signifies that a part of the processing is now done.

Example:

doThingZift :: Zift ()
doThingZift = do
    doThing
    printProcessingDone "doThing completed successfully."

printPreprocessingError :: String -> Zift () Source #

Print a message (with a newline appended to the end) that signifies that a part of the processing failed. This message will not cause the zift script run to fail.

Example:

doDangerousThing :: Zift ()
doDangerousThing = do
    errOrResult <- doThing
    case errOrResult of
        Left err ->
            printPreprocessingError $
                unwords ["doThing failed with error:", err]
            fail "doThing failed."
        Right result -> do
            printPreprocessingDone
                unwords ["doThing succeeded with result:", result]

printWithColors :: [SGR] -> String -> Zift () Source #

Print a message (with a newline appended to the end) with custom colors.

See the ansi-terminal package for more details.

Utilities

You will most likely not need these

outputPrinter :: OutputSets -> TChan ZiftToken -> TMVar () -> IO () Source #

data Buf Source #

Instances

Eq Buf Source # 

Methods

(==) :: Buf -> Buf -> Bool #

(/=) :: Buf -> Buf -> Bool #

Show Buf Source # 

Methods

showsPrec :: Int -> Buf -> ShowS #

show :: Buf -> String #

showList :: [Buf] -> ShowS #

Generic Buf Source # 

Associated Types

type Rep Buf :: * -> * #

Methods

from :: Buf -> Rep Buf x #

to :: Rep Buf x -> Buf #

Monoid Buf Source # 

Methods

mempty :: Buf #

mappend :: Buf -> Buf -> Buf #

mconcat :: [Buf] -> Buf #

type Rep Buf Source # 
type Rep Buf = D1 * (MetaData "Buf" "Zifter" "zifter-0.0.1.8-3ERxpTErtznAlOPG1cr0A4" False) ((:+:) * (C1 * (MetaCons "BufNotReady" PrefixI False) (U1 *)) (C1 * (MetaCons "BufReady" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * [ZiftOutput]))))