biegunka-0.2: DSL definitions, interpreters, templating, git support

Safe HaskellNone

Control.Biegunka

Contents

Description

Biegunka - configuration development library

Synopsis

Interpreters control

biegunkaSource

Arguments

:: (Settings () -> Settings ())

User defined settings

-> Interpreter

Combined interpreters

-> Script Sources ()

Script to interpret

-> IO ExitCode 

Entry point into the library

data Settings a Source

Settings common for all interpreters and also specific for this one

Instances

~ * () a => Default (Settings a) 
HasRoot (Settings a) 

root :: HasRoot s => Lens' s FilePathSource

Biegunka root

appData :: Lens' (Settings a) FilePathSource

Biegunka profile files

colors :: Lens' (Settings a) ColorSchemeSource

Pretty printing

data Templates Source

Wraps templating system, hiding implementation

Constructors

forall t . TemplateSystem t => Templates t 

templates :: Lens' (Settings a) TemplatesSource

Templates mapping

Interpreters

data Interpreter Source

Abstract Interpreter data type

Instances

Monoid Interpreter

Combination of the Default and Semigroup instances

Semigroup Interpreter

Two Interpreters combined take the same script and do things with it one after another

Default Interpreter

Default Interpreter does nothing

pause :: InterpreterSource

Interpreter that just waits user to press any key

confirm :: InterpreterSource

Interpreter that awaits user confirmation

dryRun :: InterpreterSource

Dry run interpreter

run :: InterpreterSource

Real run interpreter

check :: InterpreterSource

Check interpreter

Types

data Script s a Source

Newtype used to provide better error messages for type errors in DSL (for users, mostly)

Instances

MonadReader Annotations (Script s) 
Monad (Script s) 
Functor (Script s) 
Applicative (Script s) 
(~ Scope scope Actions, ~ * a ()) => Eval (Script scope a)

Biegunka script shell commands

Default a => Default (Script s a) 

data Scope Source

Language terms scopes [kind]

Constructors

Actions 
Sources 

Sources layer primitives

class Sourceable s whereSource

Common Sources structure

Methods

actions :: Lens' s (Script Actions ())Source

Actions to run after source update

(==>) :: String -> FilePath -> s -> Script Sources ()Source

Instances

Actions layer primitives

link :: FilePath -> FilePath -> Script Actions ()Source

Links given file to specified filepath

 git "https://example.com/source.git" "git/source" $
   link "some-file" "anywhere"

Links ~/git/source/some-file to ~/anywhere.

register :: FilePath -> Script Actions ()Source

Links source to specified filepath

 git "https://example.com/source.git" "git/source" $
   register "somewhere"

Links ~/git/source to ~/somewhere.

copy :: FilePath -> FilePath -> Script Actions ()Source

Copies file or directory to specified filepath

 git "https://example.com/source.git" "git/source" $
   copy "some-file" "anywhere"

Copies ~/git/source/some-file to ~/anywhere.

copyFile :: FilePath -> FilePath -> Script Actions ()Source

Copies only single file to specified filepath

 git "https://example.com/source.git" "git/source" $
   copy "some-file" "anywhere"

Copies ~/git/source/some-file to ~/anywhere.

copyDirectory :: FilePath -> FilePath -> Script Actions ()Source

Copies file or directory to specified filepath

 git "https://example.com/source.git" "git/source" $
   copy "some-file" "anywhere"

Copies ~/git/source/some-file to ~/anywhere.

substitute :: FilePath -> FilePath -> Script Actions ()Source

Substitutes templates in HStringTemplate syntax in given file and writes result to specified filepath

 git "https://example.com/source.git" "git/source" $
   substitute "some-file.template" "anywhere"

Copies ~/git/source/some-file.template to ~/anywhere.

Substitutes templates in ~/anywhere with values from templates part of Controls

patch :: FilePath -> FilePath -> PatchSpec -> Script Actions ()Source

Applies the patch given the PatchSpec

 git "https://example.com/source.git" "git/source" $
   patch "some-patch.patch" "anywhere" (def { reversely = True })

Applies ~/git/source/some-patch.patch to ~/anywhere reversely.

data PatchSpec Source

Patch settings

Constructors

PatchSpec 

Fields

strip :: Int

How many leading slashes to strip

reversely :: Bool

Apply in reverse?

Instances

raw :: FilePath -> [String] -> Script Actions ()Source

Monomorphised interface to sh quasiquoter for those who do not like -XTemplateHaskell (or -XQuasiQuotes)

 git "https://example.com/source.git" "git/source" $
   raw "/bin/echo" ["-n", "hello"]

Prints "hello" to stdout

Script environment

root :: HasRoot s => Lens' s FilePathSource

Biegunka root

source :: HasSource s => Lens' s FilePathSource

Source root

Modifiers

profile :: String -> Script Sources a -> Script Sources aSource

Provides convenient Sources grouping. May be nested

Information about sources and files related to a particular profile profile could be found in ~/.biegunka/profiles/.

Example usage:

 profile "dotfiles" $ do
   group "mine" $
     git "https://github.com/supki/.dotfiles"
       ...
   group "not-mine" $
     git "https://github.com/dmalikov/dotfiles"
       ...
 profile "experimental" $ do
   git "https://github.com/ekmett/lens"
     ...

group :: String -> Script Sources a -> Script Sources aSource

Alias for profile. May be useful for nested grouping

role :: String -> Script Sources a -> Script Sources aSource

Alias for profile. Everyone uses roles for something

sudo :: User u -> Script s a -> Script s aSource

Change effective user id for wrapped commands

data User u whereSource

User setting modifier

Constructors

UserID :: CUid -> User CUid 
Username :: String -> User String 

Instances

~ * u CUid => Num (User u)

Because I can

Show (User u) 
~ * u String => IsString (User u) 

retries :: Int -> Script s a -> Script s aSource

Change maximum retries count

reacting :: React -> Script s a -> Script s aSource

Change reaction pattern when retries are all failed

data React Source

Failure reaction

Used then all retries errored

Constructors

Ignorant 
Abortive 

prerequisiteOf :: Script Sources a -> Script Sources b -> Script Sources bSource

Execute scripts sequentially Connects two scripts which forces them to run sequentially one after another.

Auxiliary

into :: FilePath -> FilePathSource

A hack to support the notion of making destination FilePath inside some directory

Options autogeneration

class Typeable a => Data a

The Data class comprehends a fundamental primitive gfoldl for folding over constructor applications, say terms. This primitive can be instantiated in several ways to map over the immediate subterms of a term; see the gmap combinators later in this class. Indeed, a generic programmer does not necessarily need to use the ingenious gfoldl primitive but rather the intuitive gmap combinators. The gfoldl primitive is completed by means to query top-level constructors, to turn constructor representations into proper terms, and to list all possible datatype constructors. This completion allows us to serve generic programming scenarios like read, show, equality, term generation.

The combinators gmapT, gmapQ, gmapM, etc are all provided with default definitions in terms of gfoldl, leaving open the opportunity to provide datatype-specific definitions. (The inclusion of the gmap combinators as members of class Data allows the programmer or the compiler to derive specialised, and maybe more efficient code per datatype. Note: gfoldl is more higher-order than the gmap combinators. This is subject to ongoing benchmarking experiments. It might turn out that the gmap combinators will be moved out of the class Data.)

Conceptually, the definition of the gmap combinators in terms of the primitive gfoldl requires the identification of the gfoldl function arguments. Technically, we also need to identify the type constructor c for the construction of the result type from the folded term type.

In the definition of gmapQx combinators, we use phantom type constructors for the c in the type of gfoldl because the result type of a query does not involve the (polymorphic) type of the term argument. In the definition of gmapQl we simply use the plain constant type constructor because gfoldl is left-associative anyway and so it is readily suited to fold a left-associative binary operation over the immediate subterms. In the definition of gmapQr, extra effort is needed. We use a higher-order accumulation trick to mediate between left-associative constructor application vs. right-associative binary operation (e.g., (:)). When the query is meant to compute a value of type r, then the result type withing generic folding is r -> r. So the result of folding is a function to which we finally pass the right unit.

With the -XDeriveDataTypeable option, GHC can generate instances of the Data class automatically. For example, given the declaration

 data T a b = C1 a b | C2 deriving (Typeable, Data)

GHC will generate an instance that is equivalent to

 instance (Data a, Data b) => Data (T a b) where
     gfoldl k z (C1 a b) = z C1 `k` a `k` b
     gfoldl k z C2       = z C2

     gunfold k z c = case constrIndex c of
                         1 -> k (k (z C1))
                         2 -> z C2

     toConstr (C1 _ _) = con_C1
     toConstr C2       = con_C2

     dataTypeOf _ = ty_T

 con_C1 = mkConstr ty_T "C1" [] Prefix
 con_C2 = mkConstr ty_T "C2" [] Prefix
 ty_T   = mkDataType "Module.T" [con_C1, con_C2]

This is suitable for datatypes that are exported transparently.

Instances

Data Bool 
Data Char 
Data Double 
Data Float 
Data Int 
Data Int8 
Data Int16 
Data Int32 
Data Int64 
Data Integer 
Data Ordering 
Data Word 
Data Word8 
Data Word16 
Data Word32 
Data Word64 
Data Exp 
Data Match 
Data Clause 
Data Pat 
Data Type 
Data Dec 
Data Name 
Data FunDep 
Data Pred 
Data TyVarBndr 
Data () 
Data ByteString 
Data ByteString 
Data IntSet 
Data ModName 
Data PkgName 
Data OccName 
Data NameFlavour

Although the NameFlavour type is abstract, the Data instance is not. The reason for this is that currently we use Data to serialize values in annotations, and in order for that to work for Template Haskell names introduced via the 'x syntax we need gunfold on NameFlavour to work. Bleh!

The long term solution to this is to use the binary package for annotation serialization and then remove this instance. However, to do _that_ we need to wait on binary to become stable, since boot libraries cannot be upgraded seperately from GHC itself.

This instance cannot be derived automatically due to bug #2701

Data NameSpace 
Data Info 
Data Fixity 
Data FixityDirection 
Data Lit 
Data Body 
Data Guard 
Data Stmt 
Data Range 
Data FamFlavour 
Data Foreign 
Data Callconv 
Data Safety 
Data Pragma 
Data Inline 
Data RuleMatch 
Data Phases 
Data RuleBndr 
Data Strict 
Data Con 
Data TyLit 
Data AbsoluteTime 
Data LocalTime 
Data ZonedTime 
Data TimeOfDay 
Data TimeZone 
Data UTCTime 
Data NominalDiffTime 
Data Day 
Data UniversalTime 
Data DiffTime 
Data Text 
Data Void 
Data Text 
Data SourcePos 
Data Addr 
Data Value 
Data Number 
Data Scientific 
Data a => Data [a] 
(Data a, Integral a) => Data (Ratio a) 
Typeable a => Data (Ptr a) 
Typeable a => Data (ForeignPtr a) 
Typeable a => Data (Fixed a) 
Data a => Data (Complex a) 
Data a => Data (Maybe a) 
Data a => Data (Tree a) 
Data a => Data (Seq a) 
Data a => Data (ViewL a) 
Data a => Data (ViewR a) 
Data a => Data (IntMap a) 
(Data a, Ord a) => Data (Set a) 
Data a => Data (NonEmpty a) 
Data a => Data (Min a) 
Data a => Data (Max a) 
Data a => Data (Last a) 
Data a => Data (First a) 
(Data a, Eq a, Hashable a) => Data (HashSet a) 
(Data a, Unbox a) => Data (Vector a) 
Data a => Data (Vector a) 
(Data a, Prim a) => Data (Vector a) 
(Data a, Storable a) => Data (Vector a) 
Typeable a => Data (Array a) 
Data m => Data (WrappedMonoid m) 
Data a => Data (Option a) 
(Data a, Data b) => Data (Either a b) 
(Data a, Data b) => Data (a, b) 
(Typeable a, Data b, Ix a) => Data (Array a b) 
(Data k, Data a, Ord k) => Data (Map k a) 
(Typeable1 f, Typeable a, Data a, Data (f (Free f a))) => Data (Free f a) 
(Data k, Data v, Eq k, Hashable k) => Data (HashMap k v) 
(Typeable s, Typeable a) => Data (MutableArray s a) 
Data s => Data (Proxy * s) 
(Data a, Data b, Data c) => Data (a, b, c) 
(Data s, Data b) => Data (Tagged * s b) 
(Data a, Data b, Data c, Data d) => Data (a, b, c, d) 
(Data a, Data b, Data c, Data d, Data e) => Data (a, b, c, d, e) 
(Data a, Data b, Data c, Data d, Data e, Data f) => Data (a, b, c, d, e, f) 
(Data a, Data b, Data c, Data d, Data e, Data f, Data g) => Data (a, b, c, d, e, f, g) 

class Typeable a

The class Typeable allows a concrete representation of a type to be calculated.

Instances

Typeable Bool 
Typeable Char 
Typeable Double 
Typeable Float 
Typeable Int 
Typeable Int8 
Typeable Int16 
Typeable Int32 
Typeable Int64 
Typeable Integer 
Typeable Ordering 
Typeable RealWorld 
Typeable Word 
Typeable Word8 
Typeable Word16 
Typeable Word32 
Typeable Word64 
Typeable Exp 
Typeable Match 
Typeable Clause 
Typeable Pat 
Typeable Type 
Typeable Dec 
Typeable Name 
Typeable FunDep 
Typeable Pred 
Typeable TyVarBndr 
Typeable () 
Typeable Handle 
Typeable Handle__ 
Typeable E0 
Typeable E1 
Typeable E2 
Typeable E3 
Typeable E6 
Typeable E9 
Typeable E12 
Typeable CDev 
Typeable CIno 
Typeable CMode 
Typeable COff 
Typeable CPid 
Typeable CSsize 
Typeable CGid 
Typeable CNlink 
Typeable CUid 
Typeable CCc 
Typeable CSpeed 
Typeable CTcflag 
Typeable CRLim 
Typeable Fd 
Typeable PatternMatchFail 
Typeable RecSelError 
Typeable RecConError 
Typeable RecUpdError 
Typeable NoMethodError 
Typeable NonTermination 
Typeable NestedAtomically 
Typeable ThreadId 
Typeable BlockedIndefinitelyOnMVar 
Typeable BlockedIndefinitelyOnSTM 
Typeable Deadlock 
Typeable AssertionFailed 
Typeable AsyncException 
Typeable ArrayException 
Typeable ExitCode 
Typeable CChar 
Typeable CSChar 
Typeable CUChar 
Typeable CShort 
Typeable CUShort 
Typeable CInt 
Typeable CUInt 
Typeable CLong 
Typeable CULong 
Typeable CLLong 
Typeable CULLong 
Typeable CFloat 
Typeable CDouble 
Typeable CPtrdiff 
Typeable CSize 
Typeable CWchar 
Typeable CSigAtomic 
Typeable CClock 
Typeable CTime 
Typeable CUSeconds 
Typeable CSUSeconds 
Typeable CIntPtr 
Typeable CUIntPtr 
Typeable CIntMax 
Typeable CUIntMax 
Typeable IOException 
Typeable SomeException 
Typeable ErrorCall 
Typeable ArithException 
Typeable TypeRep 
Typeable TyCon 
Typeable ByteString 
Typeable ByteString 
Typeable IntSet 
Typeable ModName 
Typeable PkgName 
Typeable OccName 
Typeable NameFlavour 
Typeable NameSpace 
Typeable Info 
Typeable Fixity 
Typeable FixityDirection 
Typeable Lit 
Typeable Body 
Typeable Guard 
Typeable Stmt 
Typeable Range 
Typeable FamFlavour 
Typeable Foreign 
Typeable Callconv 
Typeable Safety 
Typeable Pragma 
Typeable Inline 
Typeable RuleMatch 
Typeable Phases 
Typeable RuleBndr 
Typeable Strict 
Typeable Con 
Typeable TyLit 
Typeable AbsoluteTime 
Typeable LocalTime 
Typeable ZonedTime 
Typeable TimeOfDay 
Typeable TimeZone 
Typeable UTCTime 
Typeable NominalDiffTime 
Typeable Day 
Typeable UniversalTime 
Typeable DiffTime 
Typeable Text 
Typeable TmplException 
Typeable Void 
Typeable Text 
Typeable SourcePos 
Typeable SourceException 
Typeable ShellException 
Typeable PatchingException 
Typeable CopyingException 
Typeable Addr 
Typeable Value 
Typeable DotNetTime 
Typeable Number 
Typeable Scientific 
Typeable GroupRecord 
Typeable Groups 
Typeable Natural 
(Typeable1 s, Typeable a) => Typeable (s a)

One Typeable instance for all Typeable1 instances

options :: Data a => [a] -> IO (a, Runner b)Source

Run constructed parser

Quasiquoters

multiline :: QuasiQuoterSource

QuasiQuoter for raw multiline strings

Settings

Colors

data ColorScheme Source

Colors used in logger

Constructors

ColorScheme 

Fields

_actionColor :: Doc -> Doc
 
_sourceColor :: Doc -> Doc
 
_srcColor :: Doc -> Doc
 
_dstColor :: Doc -> Doc
 
_errorColor :: Doc -> Doc
 
_retryColor :: Doc -> Doc
 

Instances

Default ColorScheme 

actionColor :: Lens' ColorScheme (Doc -> Doc)Source

Action color

sourceColor :: Lens' ColorScheme (Doc -> Doc)Source

Source color

srcColor :: Lens' ColorScheme (Doc -> Doc)Source

Src color

dstColor :: Lens' ColorScheme (Doc -> Doc)Source

Dst color

errorColor :: Lens' ColorScheme (Doc -> Doc)Source

Error color

retryColor :: Lens' ColorScheme (Doc -> Doc)Source

Retry color

noColors :: ColorSchemeSource

Disable colors

Mode

mode :: Lens' (Settings a) ModeSource

Biegunka mode

data Mode Source

Constructors

Offline 
Online 

Instances

Little helpers

(~>) :: a -> b -> (a, b)Source

An alias for '(,)' for better looking pairing