packages feed

dzen-dhall (empty) → 1.0.0

raw patch · 113 files changed

+6660/−0 lines, 113 filesdep +HUnitdep +QuickCheckdep +ansi-terminalsetup-changed

Dependencies added: HUnit, QuickCheck, ansi-terminal, base, bytestring, dhall, directory, dzen-dhall, file-embed-lzma, filepath, generic-random, hashable, hourglass, hspec, http-conduit, http-types, megaparsec, microlens, microlens-th, network-uri, optparse-applicative, parsec, parsers, pipes, prettyprinter, prettyprinter-ansi-terminal, process, random, tasty, tasty-hspec, tasty-hunit, tasty-quickcheck, template-haskell, text, transformers, unix, unordered-containers, utf8-string, vector

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for dzen-dhall++## 0.0.1 -- 2019-08-25++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2019, klntsky++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of klntsky nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,846 @@+# dzen-dhall++[![Build Status](https://travis-ci.com/dzen-dhall/dzen-dhall.svg?branch=master)](https://travis-ci.com/dzen-dhall/dzen-dhall/)++[Dzen](https://github.com/robm/dzen) is a general purpose messaging, notification and menuing program for X11. It features rich in-text formatting & control language, allowing to create GUIs by piping output of arbitrary executables to the `dzen2` binary. There are plenty of good usage examples on [r/unixporn](https://www.reddit.com/r/unixporn/search/?q=dzen&restrict_sr=1).++Unfortunately, combining outputs of multiple executables before feeding them to `dzen2`, which is usually done by custom shell scripts, is a tedious and error-prone task. Consider the following problems:++### Use of newlines++By default, dzen2 only renders the last line of its input, so newlines must be handled somehow by the user.++### Complexity of dynamic text formatting++If one wants each program's output to appear on its own fixed position on the screen, trimming and padding the output of each executable is required, to make sure that the text will not jitter when combined.++### High delays++Some output sources (shell scripts or commands used to provide the data) take too long to produce the output, some change their outputs rarely, but some are expected to update very frequently (like those that output current time or volume indicators on your screen). It means that the `while true; do ...; done | dzen2` pattern is not ideal. Some clever scheduling should be done to avoid delays and excessive resource waste. Output sources should be ran in parallel with their own update intervals.++### No code reuse++It is hard to share pieces of code used to produce output in `dzen2` markup format because of the need to adapt the code. Ideally, there should be a "plugin system" allowing to import reusable configurations with a single command.++### Non-trivial markup is hard++[Dzen in-text format and control language](https://github.com/robm/dzen/blob/488ab66019f475e35e067646621827c18a879ba1/README#L382) is quite rich: it features almost-arbitrary text positioning, text coloring, drawing simple shapes, loading XBM images and even allows to define clickable areas. However, these control structures are too low-level: implementing UI elements we want to use (for example, [marquee](https://developer.mozilla.org/en-US/docs/Web/HTML/Element/marquee)-like blocks with arbitrary content) would require too much effort. Besides, one more problem with this markup language is that nested tags are not supported.++To fill the *abstraction gap*, a new [DSL](https://en.wikipedia.org/wiki/Domain-specific_language) should be introduced. This language should allow its users to abstract away from markup-as-text and focus on markup-as-[syntax-tree](https://en.wikipedia.org/wiki/Abstract_syntax_tree) instead - no need to say, tree structures are more suitable for the purpose of defining UIs. It is also way easier to process tree representations programmatically.++## The solution++[Dhall](https://dhall-lang.org/) is a statically-typed [total](https://en.wikipedia.org/wiki/Total_functional_programming) functional programming language. These properties make it a good choice for dealing with complex user-defined configurations: static typing allows to catch typos and errors early, and totality guarantees that a configuration program will always terminate.++This repository contains data type and function definitions in Dhall that form a DSL for creating almost arbitrary Dzen UIs, called "bars", and a Haskell program capable of reading bar definitions and producing input for `dzen2` binary based on them.++In effect, `dzen-dhall` introduces a new approach to desktop scripting/customization with Dzen. Basically, it provides solutions for all of the aforementioned problems. `dzen-dhall` is smart when formatting text, handles newlines gracefully, runs output sources in parallel, and its [plugin system](#installing-plugins) solves the problem of code reuse.++### Quick example++The essence of the DSL can be illustrated by the following excerpt from [the default config file](dhall/config.dhall) (with additional comments):++```dhall+-- A bar that shows how much memory is used:+let memoryUsage+-- ^ `let` keyword introduces a new binding+	: Bar+	-- ^ Colon means "has type". `memoryUsage` is a `Bar`+	= bashWithBinaries+	  -- ^ Call to a function named `bashWithBinaries` with three arguments:+	  [ "free", "grep", "echo", "awk" ]+	  -- ^ Binaries required to run the script (used to exit early if some of them+	  -- are not present).+	  5000+	  -- ^ Update interval in milliseconds+	  ''+	  TMP=`free -b | grep 'Mem'`+	  TotalMem=`echo "$TMP" | awk '{ print $2; }'`+	  UsedMem=`echo "$TMP" | awk '{ print $3; }'`+	  echo "$((UsedMem * 100 / TotalMem))"+	  ''+	  -- ^ The script itself++-- A bar that shows how much swap is used:+let swapUsage+	: Bar+	= bashWithBinaries+	  [ "free", "grep", "echo", "awk" ]+	  5000+	  ''+	  TMP=`free -b | grep 'Swap'`+	  TotalSwap=`echo "$TMP" | awk '{ print $2; }'`+	  UsedSwap=`echo "$TMP" | awk '{ print $3; }'`+	  echo "$((UsedSwap * 100 / TotalSwap))"+	  ''++-- A bar that shows current date:+let date+	: Bar+	= bashWithBinaries [ "date" ] 1000 "date +'%d.%m.%Y'"++-- A bar that shows current time:+let time+	: Bar+	= bashWithBinaries [ "date" ] 1000 "date +'%H:%M'"++-- A function that colorizes a given `Bar`:+let accent : Bar → Bar = fg "white"++in	separate+    -- ^ a function that inserts |-separators between nearby elements of a list+	[ join [ text "Mem: ", accent memoryUsage, text "%" ]+	-- ^ `join` concatenates multiple `Bar`s+	, join [ text "Swap: ", accent swapUsage, text "%" ]+		  -- ^ `text` is used to convert a text value to a `Bar`+	, join [ date, text " ", accent time ]+	] : Bar+```++This definition results in the following Dzen output:++![Example 1](img/example1.png)++## Getting started++### Building++#### Using [stack](https://docs.haskellstack.org/en/stable/README/)++```+stack build+```++#### Using [Nix](https://nixos.org/nix/)++```+nix-build --attr dzen-dhall+```++To use pinned version of nixpkgs, pass `--arg usePinned true`.++### Installing++[Binary releases](https://github.com/dzen-dhall/dzen-dhall/releases) are available.++#### Using [stack](https://docs.haskellstack.org/en/stable/README/)++```+stack install+```++#### Using [Nix](https://nixos.org/nix/)++```+nix-env --file default.nix --install dzen-dhall+```++To use pinned version of nixpkgs, pass `--arg usePinned true`.++### Running++To create a default configuration, run:++```+dzen-dhall init+```++`dzen-dhall` will put some files to `~/.config/dzen-dhall/`++Files in `types/` and `utils/` subdirectories are set read-only by default - the user should not edit them, since they contain the implementation. They are still exposed to simplify learning and debugging. `prelude/` directory contains a copy of [Dhall prelude](https://github.com/dhall-lang/dhall-lang/tree/cf263a128d4e2e25afb3187cb8b243e7e68af9fb/Prelude).++## Installing plugins++`dzen-dhall` comes with a plugin system capable of pulling pieces of Dhall code with metadata either from a [curated set of plugins](https://github.com/dzen-dhall/plugins) or from third-party sources.++For example, let's install [a plugin named `tomato`](https://github.com/dzen-dhall/plugins#tomato), which is a countdown timer with interactive UI.++Running `dzen-dhall plug tomato` will result in fetching the plugin source from [this file](https://github.com/dzen-dhall/plugins/blob/master/tomato/plugin.dhall) and pretty-printing it to the terminal for review. You will be prompted for confirmation, and if you confirm the installation, you will see the following output:++```+New plugin "tomato" can now be used as follows:++let tomato = (./plugins/tomato.dhall).main++in  plug+  ( tomato+        ''+        notify-send --urgency critical " *** Time is up! *** "+        ''+  )+```++This is a message the author left for you, to demonstrate how to actually use their plugin.++Navigate to your [`config.dhall`](https://github.com/dzen-dhall/dzen-dhall/blob/master/dhall/config.dhall), find a comment saying `You can add new plugins right here` and insert the expression from above instead of the comment (don't forget to also add a leading comma).++After running `dzen-dhall` again, you should be able to see the output of the newly installed plugin.++## Modifying configuration++This chapter describes `dzen-dhall` DSL in depth. It's best to read the [Dhall wiki](https://github.com/dhall-lang/dhall-lang/wiki) to become familiar with Dhall syntax before you proceed.++### [Bars](dhall/src/Bar.dhall)++The most important concept of the DSL is `Bar`. Essentially, `Bar` is a tree data structure containing text, images, shapes, etc. in its leaves. [Default config file](dhall/config.dhall) exposes some functions for working with `Bar`s:++<big><pre>+-- [Text primitives](#text-primitives):+let text : Text → Bar+let markup : Text → Bar++-- Used to combine multiple Bars into one.+let join : List Bar → Bar++-- [Primitives of Dzen markup language](#primitives):+let [fg](#coloring) : Color → Bar → Bar+let [bg](#coloring) : Color → Bar → Bar+let [i](#drawing-images) : Image → Bar+let [r](#drawing-shapes) : Natural → Natural → Bar+let [ro](#drawing-shapes) : Natural → Natural → Bar+let [c](#drawing-shapes) : Natural → Bar+let [co](#drawing-shapes) : Natural → Bar+let [p](#relative-positioning) : Position → Bar → Bar+let [pa](#absolute-positioning) : AbsolutePosition → Bar → Bar+let [ca](#clickable-areas) : Button → Shell → Bar → Bar+let [ib](#ignoring-background-color) : Bar → Bar++-- [Animations](#animations)+let [slider](#sliders) : Slider → List Bar → Bar+let [marquee](#marquees) : Marquee → Bar → Bar++-- Other+let [pad](#padding-text) : Natural → Padding → Bar → Bar+let [trim](#trimming-text) : Natural → Direction → Bar → Bar+let [source](#sources) : Source → Bar+let [plug](#plugins) : Plugin → Bar+let [automaton](#automata) : Text → StateTransitionTable → [StateMap](#state-maps) Bar → Bar+let [check](#assertions) : List [Check](#assertions) → Bar+let [define](#variables) : Variable → Text → Bar+let [scope](#scopes) : Bar → Bar+</pre></big>++### Text primitives++`text` is used to create `Bar`s containing static, escaped pieces of text. `markup`, on the contrary, does not escape its input, so that if it does contain markup, it will be interpreted by dzen2.++### Primitives++Various primitives of dzen2 markup language (`^fg()`, `^bg()`, `^i()`, etc. - see [dzen2 README](https://github.com/robm/dzen) for details on them) are represented by corresponding `Bar` constructors (`fg`, `bg`, `i`, etc.).++#### Coloring++Background and foreground colors can be set using `bg` and `fg`. A color can be one of the following:++- [X11 color name](https://en.wikipedia.org/wiki/X11_color_names);+- `#XXX`-formatted hex number;+- `#XXXXXX`-formatted hex number.++`fg` can also be used to set colors of [XBM bitmaps](#drawing-images).++`dzen-dhall` color blocks can be nested (unlike when using plain dzen2 markup). `^fg(red) red ^fg(pink) pink ^fg() red ^fg()` will be rendered by dzen2 as ![](img/nested-colors1.png). But `dzen-dhall` will process `fg "red" (join [ text "red ", fg "pink" (text "pink"), text " red" ])` as ![](img/nested-colors2.png).++#### Ignoring background color++`ib` can be used to completely disable background coloring for a region of output. Background coloring can't be enabled again from within a child `Bar`.++For example, this:++```dhall+bg+("#F00")+( join+[ text "..."+, ib+  ( join+	[ text "background color is "+	, bg ("#0F0") (text "completely")+	, text "ignored"+	]+  )+, text "..."+]+)+```++results in the following output:++![Ignore background preview](img/ib.png)++#### Drawing images++[XBM bitmaps](https://www.fileformat.info/format/xbm/egff.htm) can be loaded using `i` function.++`i` accepts both filenames and raw image contents (XBM images are just pieces of C code):++For example,++```dhall+i+''+#define smiley_width 15+#define smiley_height 15+static unsigned char smiley_bits[] = {+   0x00, 0x00, 0x00, 0x00, 0xc8, 0x00, 0xcc, 0x00, 0x4c, 0x00, 0x48, 0x00,+   0x00, 0x00, 0x00, 0x08, 0x00, 0x08, 0x04, 0x04, 0x3c, 0x07, 0xe0, 0x01,+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00 };+''+```++will be rendered as ![smiley](img/xbm_smiley.png).++To edit/create XBM images, use [GIMP](https://www.gimp.org/).++#### Drawing shapes++Four types of shapes are supported:++| Function | Meaning           |+|----------|-------------------|+| `r`      | Rectangle         |+| `ro`     | Rectangle outline |+| `c`      | Circle            |+| `co`     | Circle outline    |++#### Relative positioning++Relative positioning (`p`) allows to shift by some number of pixels in any direction, reset vertical position, lock or unlock horizontal position, and "move" to one of the four edges of the screen:++```dhall+let Position+	: Type+	= < XY :+		  { x : Integer, y : Integer }+	  | _RESET_Y+	  | _LOCK_X+	  | _UNLOCK_X+	  | _LEFT+	  | _RIGHT+	  | _TOP+	  | _CENTER+	  | _BOTTOM+	  >+```++For example, `(p (Position.XY { x = +10, y = -5 }) (text "Relative position"))`.++#### Absolute positioning++With `pa` function, it is possible to specify absolute position of a bar, relative to the top-left edge of the screen.++`AbsolutePosition` is defined as:++```dhall+let AbsolutePosition : Type = { x : Integer, y : Integer }+```++Example:++```dhall+(pa { x = +0, y = +0 } (text "Absolute position"))+```++#### Clickable areas++Example:++```dhall+(ca Button.Left "notify-send hello!" (text "Click me!"))+```++`dzen2` does not allow a command in `^ca()` tag to contain closing parentheses, because `)` is used to indicate the end of the command. `dzen-dhall` bypasses this limitation:++```dhall+(ca Button.Left "notify-send '(even with parentheses)'" (text "Click me!"))+```++##### Buttons++`Button` is defined as:++```dhall+let Button : Type = < Left | Middle | Right | ScrollUp | ScrollDown | ScrollLeft | ScrollRight >+```++### Animations++Some built-in animations are available. More may be added in the future.++#### Sliders++Sliders change their outputs, variating between `Bar`s from a given list. Transitions are rendered smoothly.++E.g., the following piece:+++```dhall+let fadeIn : Fade = mkFade VerticalDirection.Up 5 16+       -- How many frames to spend on switching ^++let fadeOut : Fade = mkFade VerticalDirection.Down 5 16+    -- How many pixels up or down to move the output ^++in	slider+	(mkSlider fadeIn fadeOut 3000)+                -- Delay, ms ^++	[ join [ text "Mem: ", accent memoryUsage, text "%" ]+	, join [ text "Swap: ", accent swapUsage, text "%" ]+	]+	: Bar+```++[[view complete example]](test/dhall/configs/sliders.dhall)++results in this output:++![Slider preview](img/slider.gif)+++#### Marquees++Marquee animation type is inspired by the [deprecated marquee HTML tag](https://developer.mozilla.org/en-US/docs/Web/HTML/Element/marquee).++This example with multiple marquees shows how various settings affect appearance:++```dhall+separate+[ marquee+  (mkMarquee 5 15 False)+          -- ^ Number of animation frames per character.+  ( text+    "The most annoying HTML code in the history of HTML codes."+  )++  , marquee+  (mkMarquee 0 32 True)+            -- ^ Number of characters to show.+  ( text+    "The most annoying HTML code in the history of HTML codes."+  )++  , marquee (mkMarquee 3 10 True) (text "test...")+                         -- ^ Whether to repeat the input indefinitely+                         -- if it is too short, or just pad it with spaces+  , marquee (mkMarquee 3 10 False) (text "test...")++  -- A demo with colors:+  , marquee+  (mkMarquee 8 15 False)+  ( join+    [ text "The "+    , fg "white" (text "most ")+    , text "annoying "+    , fg "white" (text "HTML ")+    , text "code "+    , fg "white" (text "in ")+    , text "the "+    , fg "white" (text "history ")+    , text "of "+    , fg "white" (text "HTML ")+    , text "codes. "+    ]+  )+]+```++[[view complete example]](test/dhall/configs/marquees.dhall)++The output:++![Marquee preview](img/marquees.gif)++Obviously, marquees and sliders can be nested within each other.++### Padding text++Paddings allow to make sure that the width of a piece of text is no less than some number of characters.++```dhall+let Padding : Type = < Left | Right | Sides >+```++Example:++```dhall+(pad 30 Padding.Sides (text "...")) : Bar+```++### Trimming text++`trim` function allows to cut a given `Text` to desired width, removing excessive characters from either left or right.++Trim direction is defined as follows:++```dhall+let Direction = < Left | Right >+```++Example:++```dhall+(trim 5 Direction.Right (text "Some long text..."))+```++### Sources++Sources are arbitrary commands that generate text output for `dzen-dhall`.++```dhall+let Source : Type =+  { command : List Text+  , input : Text+  , updateInterval : Optional Natural+  , escape : Bool+```++For example, a simple clock plugin can be created as follows:++```dhall+let clocks : Source =+  { updateInterval = Some 1000+  , command = ["date", "+%H:%M"]+  , input = ""+  , escape = True+  }+```++`updateInterval` specifies *minimum* update interval: new source command will not be spawned if a previous one is still running (this is done to avoid race conditions). Actual time intervals between source command invocations are adjusted to be as close to specified `updateInterval`s as possible. For example, if running a command takes 100ms and `updateInterval` is set to `1000`, the real delay between command's exit and startup will be 900ms. And if it takes more than 1000ms, then the real delay will be zero.++If `updateInterval` is not specified (i.e. set to `None Natural`), the command will run once. It may continue generating output indefinitely, line-by-line, or exit - in the latter case, the last line of the output will be shown forever.++Note that in most cases it's better to use `bash` or `bashWithBinaries` functions instead of constructing sources by hand.++### Variables++[Sources](#sources), [hooks](#hooks) and [clickable areas](#clickable-areas) can access and modify [scope-local](#scopes) variables, using `mkVariable`, `define`, `set` and `get` functions.++```dhall+let mkVariable : Text → Variable+let define : Variable → Text → Bar+let get : Variable → Shell+let set : Variable → Shell → Shell+```++The last two don't actually do anything with variables, they rather construct shell commands that do. `dzen-dhall` works like a template engine for bash scripts.++For example, let's see how a simple stateful counter can be implemented:++```dhall+let var = mkVariable "MyVariable"++in	join+  [ define var "0"+  -- ^ set a default value (optional)++  , ca+	Button.Left+	''+	shellVar=${get var}+	${set var "$(( shellVar - 1 ))"}+	''+	(text "-")+  -- ^ a button that decreases the value++  , bash 500+    ''+    echo " ${get var} "+    ''+  -- ^ a bar that prints the value++  , ca+	Button.Left+	''+	shellVar=${get var}+	${set var "$(( shellVar + 1 ))"}+	''+	(text "+")+  -- ^ a button that increases the value++  ]+```++[[view complete example]](test/dhall/configs/variables.dhall)++At run time, it will look like this: ![](img/counter.png).++### Scopes++Scopes are used for encapsulation. `dzen-dhall` guarantees that automata from different scopes are unable to communicate with each other, and that there are no variable collisions between scopes. Parent scopes are completely isolated from child scopes and vice versa.++For example, let's revisit our [counter example](#variables) from README section about variables.++What if we wanted multiple counters to be present on the screen at the same time? Just inserting many of them is not enough: they will be using the same variable.++But wrapping them into separate scopes helps:++```dhall+let counter =+	  join+	  [ define var "0"+	  , ca+		Button.Left+		''+		shellVar=${get var}+		${set var "\$(( shellVar - 1 ))"}+		''+		(text "-")+	  , bash 500 "echo \" ${get var} \""+	  , ca+		Button.Left+		''+		shellVar=${get var}+		${set var "\$(( shellVar + 1 ))"}+		''+		(text "+")+	  ]++in	join [ scope counter, scope counter ]+```++[[view complete example]](test/dhall/configs/scopes.dhall)++### Automata++Each [Bar](#bars) is essentialy a finite-state automaton. States are tagged by `Text` labels, and transitions are triggered by [events](#events) (very much like in some functional reactive programming frameworks). In the trivial case, a bar has only one state: you can think of any static `Bar` as of an automaton with a single state, the name of which is implicit.++A bar with more than one state can be defined by its state transition function (in a form of a list of transitions), a mapping from state labels to `Bar`s (`StateMap`), which specifies visual representation of the automaton for various states, and a special identifier (`Address`) used to query the state of the automaton from the outside world.++For example, this code snippet defines a bar that switches between two states, `ON` and `OFF`:++```dhall+let OFF : State = mkState ""+                       -- ^ Empty label means that this state is initial.+let ON : State = mkState "ON"++let Toggle : Event = mkEvent "Toggle"++let address : Address = mkAddress "MY_AUTOMATON"++let stateTransitionTable+	: List Transition+	= [ mkTransition Toggle ON OFF, mkTransition Toggle OFF ON ]++-- Defines which output to render depending on the state:+let stateMap : StateMap Bar+	= [ { state = OFF, bar = text "Switcher is OFF" }+	  , { state = ON,  bar = text "Switcher is ON" }+	  ]++-- A clickable area that reacts to left-clicks by emitting `Toggle` events:+in	ca+	Button.Left+	(emit Toggle)+	(automaton address stateTransitionTable stateMap)+```++#### [State maps](dhall/src/StateMap.dhall)++`StateMap`s are used to define mappings from states to bars, i.e. they determine what to show depending on the state.++```dhall+let StateMap : Type → Type = λ(Bar : Type) → List { state : Text, bar : Bar }++in  StateMap+```++Note that `StateMap` is parametrized by the `Bar` type.++Also note that unlike in traditional reactive frameworks, current state of an automaton only determines which `Bar` is *shown*, not *present in the tree*. See [this section](#deduplication) for more context.++#### [Events](dhall/src/Event.dhall)++Events can be emitted from within [hooks](#hooks), [sources](#sources) and [clickable areas](#clickable-areas). The only way to react to some event is to use an automaton.++```dhall+let mkEvent : Text → Event++let emit : Event → Shell+```++#### [Hooks](dhall/src/Hook.dhall)++Hooks allow to execute arbitrary commands before state transitions of automata. When a hook exits with non-zero code, it prevents its corresponding state transition from happening. So, generally, hooks should only contain commands that exit fast, to prevent excessive delays.++Relevant bindings include:++```dhall+let Hook+	: Type+	= { command :+		  List Text+	  , input :+		  Text+	  }++let mkBashHook+	: Shell → Hook++let addHook+	: Hook → Transition → Transition++let getEvent : Shell++let getCurrentState : Shell = utils.getCurrentState++let getNextState : Shell = utils.getNextState+```++For example, The following hook will succeed only if a certain file exists:++```dhall+let myHook : Hook =+  { command = "bash"+  , input = "[ -f ~/some-file ]"+  }+```++Hooks can also [emit events](#events) themselves (this may lead to event storm, so the user should be really careful).++A special value, `getEvent`, allows to get the name of the event that triggered the hook. Similarly, `getCurrentState` and `getNextState` contain values from the corresponding row of a state transition table.++For example, a hook that inspects current event and both states can be added to all transitions of a state transition table from the [automata example](#automata):++```dhall+let withInspect+	: Transition → Transition+	= addHook (mkBashHook "notify-send \"${getEvent}: ${getCurrentState} -> ${getNextState}\"")++let stateTransitionTable+	: List Transition+	= prelude.List.map+	  Transition+	  Transition+      -- ^ Type parameters like these are always explicit in Dhall+	  withInspect+	  [ mkTransition Toggle ON OFF, mkTransition Toggle OFF ON ]+```++[[view complete example]](test/dhall/configs/getEvent.dhall)++### Assertions++Startup-time assertions allow to make sure that some condition is true before proceeding to the execution. It is possible to assert that some binary is in `$PATH` or that some arbitrary shell command exits successfully:++```dhall+let Assertion = < BinaryInPath : Text | SuccessfulExit : Text >+```++A `message` will be printed to the console on assertion failure. Assertions, when used wisely, greatly reduce debugging time.++For example, this assertion fails if there's no `something` binary in `$PATH`:++```dhall+check+  "Did you miss something?"+  (Assertion.BinaryInPath "something")+```++And this assertion fails on weekends:++```dhall+check+  "Not going to work!"+  (Assertion.SuccessfulExit "[[ \$(date +%u) -lt 6 ]]")+```++[[view complete example]](test/dhall/configs/assertions.dhall)++## Naming conventions++These conventions are enforced by `dzen-dhall` as an attempt to lower cognitive noise for users and plugin maintainers.++- [Event](#events) names and [variables](#variables) should be written camel-cased, first letter capitalized: `TimeHasCome`, `ButtonClicked`, etc.+- [Automata](#automata) addresses should contain only capital letters, numbers and `_`.++## Troubleshooting++This section is dedicated to fixing problems with your `dzen-dhall` configurations.++### Getting more info about errors++Pass `--explain` flag to turn on verbose error reporting.++### Marquee jittering++Jittering may appear if the value of `fontWidth` field in your settings is inadequate. It can be fixed by specifying the width manually:++```dhall+[ { bar = ...+  , settings = defaults.settings ⫽ { fontWidth = 10 }+  }+]+```++After a few guesses, you should be able to get rid of jittering.++Another possible source of this problem is a non-monospace font being used. Non-monospace fonts are not supported and will never be.++### Embedding shell scripts in Dhall++The most straightforward way is to use [`./file.sh as Text` construct](https://github.com/dhall-lang/dhall-lang/wiki/Cheatsheet#programming) to embed a file as `Text` literal into the configuration. However, it is not possible when creating reusable plugins, since it is a requirement that each plugin is encapsulated in a single file, and using string interpolation with `as Text` is impossible too.++So, the following rules apply:++1. Use `\` to escape `${` `}` in a single-line (`"`-quoted) string.++2. Use `''` to escape `${` `}` in a multiline (`''`-quoted) string. (That is, `''` serves as both an escape sequence and a quote symbol).++For example, bash array expansion expression `${arr[ ix ]}` should be written as `"\${arr[ ix ]}"` in a double-quoted string or as `'' ''${arr[ ix ]} ''` in a multiline string.++See [the specification](https://github.com/dhall-lang/dhall-lang/blob/master/standard/multiline.md) for details.++### Running multiple `dzen2`s simultaneously++It is possible to do so by adding another `Bar` (some code duplication is hardly avoidable) and adding another entry to the configuration list:++```dhall+mkConfigs+	  [ { bar = defaultBar, settings = defaults.settings }+	  , { bar =+		    anotherBar+		, settings =+			-- `-xs` dzen2 argument specifies monitor number:+			defaults.settings ⫽ { extraArgs = [ "-xs", "1" ] }+		}+	  ]+```++## Implementation details++Read this section if you want to understand how `dzen-dhall` works. It is not required if you want to just use the program.++### Data encoding++Dhall does not support recursive ADTs (which are obviously required to construct tree-like statusbar configurations), but there is a [trick](https://github.com/dhall-lang/dhall-lang/wiki/How-to-translate-recursive-code-to-Dhall) to bypass that, called [Boehm-Berarducci encoding](http://okmij.org/ftp/tagless-final/course/Boehm-Berarducci.html).++We use this method in a slightly modified variant: [`Carrier`](dhall/src/Carrier.dhall) type is introduced to hide all the constructors in a huge record.++Essentially, [our definition of `Bar`](dhall/src/Bar.dhall) is equivalent to something like the following, which is a direct Boehm-Berarducci encoding:++```dhall+let Bar =+      ∀(Bar : Type)+    → ∀(text : Text → Bar)+    → ∀(markup : Text → Bar)+    → ∀(join : List Bar → Bar)+    -- ... some constructors omitted+    → ∀(check : List Check → Bar)+    → Bar+```++During the stage of [config](dhall/config.dhall) processing, `Bar`s are converted to a type called [Plugin](dhall/src/Plugin.dhall), which is a list of [Token](dhall/src/Token.dhall)s (in fact, `List` is the only recursive data type in Dhall). These tokens can be marshalled into Haskell, and then [parsed back](src/DzenDhall/Parser.hs) into a tree structure ([DzenDhall.Data.Bar](src/DzenDhall/Data.hs)).++After that, `dzen-dhall` [spawns some threads](src/DzenDhall/App/StartingUp.hs) for each output source and processes the outputs as specified in the configuration.++### Deduplication++This is a really tricky part: identical-by-definition sources or automata within the same scope are always treated as a single one, no matter how many times they appear in a `Bar` tree.++A simplest example that makes deduplication observable can be found [here](test/dhall/configs/deduplication.dhall).++Deduplication was introduced to handle gracefully the situation where we have an automaton with a `StateMap` of multiple states, some of which contain the same sources and/or automata. Do we want to create these duplicating things for each possible state? Of course, not: this is like saying no to performance from the start. The chosen solution was to just remove these duplicates from runtime.++The reason why we have to deal with this problem at all (while normal reactive frameworks don't have to) is because all sources in a `StateMap` are being run at the same time in background (no matter in which state the automaton is), but the user is only able to observe the output corresponding to exactly one state. This may seem strange, but in fact this approach has its own benefits. For example, output is always available immediately after a state change. And the implementation is much simpler, because there is no need to kill output sources and launch them anew.++If you want "normal" behavior, it's not hard to define an automaton that does not contain sources in its `StateMap` at all, and define a single output source that queries the state of this automaton and switches between various outputs. Of course, you may ask, "what if I want to render complex markup that changes depending on the state?". The answer is that you just have to put your automaton back in a `StateMap` wherever you want it to appear, possibly duplicating it multiple times in various contexts - and at runtime it will be deduplicated!
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import qualified DzenDhall++main :: IO ()+main = DzenDhall.main
+ dhall/config.dhall view
@@ -0,0 +1,163 @@+let prelude = ./prelude/package.dhall+let types = ./types/package.dhall+let utils = ./utils/package.dhall++-- * Types++let AbsolutePosition = types.AbsolutePosition+let Address = types.Address+let Assertion = types.Assertion+let Bar = types.Bar+let Button = types.Button+let Carrier = types.Carrier+let Check = types.Check+let Color = types.Color+let Configuration = types.Configuration+let Direction = types.Direction+let Event = types.Event+let Fade = types.Fade+let Hook = types.Hook+let Image = types.Image+let Marquee = types.Marquee+let Padding = types.Padding+let Plugin = types.Plugin+let Position = types.Position+let Settings = types.Settings+let Shell = types.Shell+let Slider = types.Slider+let Source = types.Source+let State = types.State+let StateMap = types.StateMap+let Transition = types.Transition+let Variable = types.Variable+let VerticalDirection = types.VerticalDirection++-- * Utility functions++let mkAddress : Text → Address = utils.mkAddress+let mkEvent : Text → Event = utils.mkEvent+let mkState : Text → State = utils.mkState+let mkVariable : Text → Variable = utils.mkVariable++let showAddress : Address → Text = utils.showAddress+let showEvent : Event → Text = utils.showEvent+let showState : State → Text = utils.showState+let showVariable : Variable → Text = utils.showVariable++let mkBashHook : Shell → Hook = utils.mkBashHook+let addHook : Hook → Transition → Transition = utils.addHook++let mkFade : VerticalDirection → Natural → Natural → Fade = utils.mkFade+let mkSlider : Fade → Fade → Natural → Slider = utils.mkSlider+let mkMarquee : Natural → Natural → Bool → Marquee = utils.mkMarquee++let mkTransition : Event → State → State → Transition = utils.mkTransition+let mkTransitions : Event → List State → State → Transition = utils.mkTransitions++let emit : Event → Shell = utils.emit+let get : Variable → Shell = utils.get+let getEvent : Shell = utils.getEvent+let getCurrentState : Shell = utils.getCurrentState+let getNextState : Shell = utils.getNextState+let query : Address → Shell = utils.query+let set : Variable → Shell → Shell = utils.set++let defaults = utils.defaults++let bar+	: Bar+	=   λ(Bar : Type)+	  → λ(cr : Carrier Bar)+	  → -- Text primitives:+		let text : Text → Bar = cr.text+		let markup : Text → Bar = cr.markup++		-- Combining multiple `Bar`s into one:+		let join : List Bar → Bar = cr.join++		-- Primitives of Dzen markup language:+		let fg : Color → Bar → Bar = cr.fg+		let bg : Color → Bar → Bar = cr.bg+		let i : Image → Bar = cr.i+		let r : Natural → Natural → Bar = cr.r+		let ro : Natural → Natural → Bar = cr.ro+		let c : Natural → Bar = cr.c+		let co : Natural → Bar = cr.co+		let p : Position → Bar → Bar = cr.p+		let pa : AbsolutePosition → Bar → Bar = cr.pa+		let ca : Button → Shell → Bar → Bar = cr.ca+		let ib : Bar → Bar = cr.ib++		-- Animations:+		let slider : Slider → List Bar → Bar = cr.slider+		let marquee : Marquee → Bar → Bar = cr.marquee++		-- Other:+		let pad : Natural → Padding → Bar → Bar = cr.pad+		let trim : Natural → Direction → Bar → Bar = cr.trim+		let source : Source → Bar = cr.source+		let plug : Plugin → Bar = cr.plug+		let automaton+			: Address → List Transition → StateMap Bar → Bar+			= cr.automaton+		let check : Text → Assertion → Bar = cr.check+		let scope : Bar → Bar = cr.scope+		let define : Variable → Text → Bar = cr.define++		-- Utilities:+		let bash : Natural → Shell → Bar = utils.mkBash Bar cr+		let bashWithBinaries+			: List Text → Natural → Shell → Bar+			= utils.mkBashWithBinaries Bar cr+		let reader : Variable → Natural → Bar = utils.mkReader Bar cr+		let separateBy : Bar → List Bar → Bar = utils.mkSeparateBy Bar cr+		let separate : List Bar → Bar = separateBy (text " | ")++		-- Pre-defined bars+		let memoryUsage+			: Bar+			= bashWithBinaries+			  [ "free", "grep", "echo", "awk" ]+			  5000+			  ''+			  TMP=`free -b | grep 'Mem'`+			  TotalMem=`echo "$TMP" | awk '{ print $2; }'`+			  UsedMem=`echo "$TMP" | awk '{ print $3; }'`+			  echo "$((UsedMem * 100 / TotalMem))"+			  ''++		let swapUsage+			: Bar+			= bashWithBinaries+			  [ "free", "grep", "echo", "awk" ]+			  5000+			  ''+			  TMP=`free -b | grep 'Swap'`+			  TotalSwap=`echo "$TMP" | awk '{ print $2; }'`+			  UsedSwap=`echo "$TMP" | awk '{ print $3; }'`+			  echo "$((UsedSwap * 100 / TotalSwap))"+			  ''++		let date+			: Bar+			= bashWithBinaries [ "date" ] 1000 "date +'%d.%m.%Y'"++		let time+			: Bar+			= bashWithBinaries [ "date" ] 1000 "date +'%H:%M'"++		let accent : Bar → Bar = fg "white"++		in    -- Your bar definition starts below.++			  separate+			  [ join [ text "Mem: ", accent memoryUsage, text "%" ]+			  , join [ text "Swap: ", accent swapUsage, text "%" ]+			  , join [ date, text " ", accent time ]++			  -- You can add new plugins right here.++			  ]+			: Bar++in  utils.mkConfigs [ { bar = bar, settings = defaults.settings } ] : List Configuration
+ dhall/prelude/Bool/package.dhall view
@@ -0,0 +1,25 @@+{ and =+      ./and sha256:0b2114fa33cd76652e4360f012bc082718944fe4c5b28c975483178f8d9b0a6d+    ? ./and+, build =+      ./build sha256:add7cb9acacac705410088d876a7e4488e046a7aded304f06c51accffd7f1b7b+    ? ./build+, even =+      ./even sha256:72a05ee550636a3acb768360fa51ba0db0326763e0cf1ceb737f0f3607fc0fe5+    ? ./even+, fold =+      ./fold sha256:39f60baf3950268c2e849e91dc6279ee41cd6b81892d54020d4fcd2ce30a96ae+    ? ./fold+, not =+      ./not sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4+    ? ./not+, odd =+      ./odd sha256:6360fca3a745de32bd186cc7b71487a6398cd47d5119064eae491872c41d1999+    ? ./odd+, or =+      ./or sha256:5c50738e84e1c4fed8343ebd57608500e1b61ac1f502aa52d6d6edb5c20b99e4+    ? ./or+, show =+      ./show sha256:f85f6d2d921c37a2122cb2e2f8a0170e305b699debd0e6df5ef3370d806b5f61+    ? ./show+}
+ dhall/prelude/Double/package.dhall view
@@ -0,0 +1,4 @@+{ show =+      ./show sha256:ae645813cc4d8505a265df4d7564c95482f62bb3e07fc81681959599b6cee04f+    ? ./show+}
+ dhall/prelude/Function/package.dhall view
@@ -0,0 +1,4 @@+{ compose =+      ./compose sha256:65ad8bbea530b3d8968785a7cf4a9a7976b67059aa15e3b61fcba600a40ae013+    ? ./compose+}
+ dhall/prelude/Integer/package.dhall view
@@ -0,0 +1,7 @@+{ show =+      ./show sha256:ecf8b0594cd5181bc45d3b7ea0d44d3ba9ad5dac6ec17bb8968beb65f4b1baa9+    ? ./show+, toDouble =+      ./toDouble sha256:77bc5d635dc4d952f37cc96f2a681d5ac503b4e8b21fc00055b1946adb5beda7+    ? ./toDouble+}
+ dhall/prelude/JSON/package.dhall view
@@ -0,0 +1,28 @@+{ keyText =+      ./keyText sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc+    ? ./keyText+, keyValue =+      ./keyValue sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c+    ? ./keyValue+, string =+      ./string sha256:7a8ac435d30a96092d72889f3d48eabf7cba47ecf553fd6bc07a79fdf473e8d2+    ? ./string+, number =+      ./number sha256:534745568065ae19d2b0fe1d09eeb071e9717d0f392187eb0bc95f386b018bec+    ? ./number+, object =+      ./object sha256:a4e047cf157c3971b026b3942a87d474c85950d9b9654f8ebc8631740abf75a9+    ? ./object+, array =+      ./array sha256:3a4c06cf135f4c80619e48c0808f6600d19782705bc59ee7c27cfc2e0f097eb7+    ? ./array+, bool =+      ./bool sha256:018d29f030b45d642aba6bb81bf2c19a7bf183684612ce7a2c8afd2099783c48+    ? ./bool+, null =+      ./null sha256:52c1d45ab2ca54875b444bfb1afdea497c8c9b0652e5044fafd8b16d97f4b78d+    ? ./null+, render =+      ./render sha256:81f5a84efbb35211b1556838e86d17ed497912cf765bfa4ab76708b21e5371f1+    ? ./render+}
+ dhall/prelude/List/package.dhall view
@@ -0,0 +1,58 @@+{ all =+      ./all sha256:7ac5bb6f77e9ffe9e2356d90968d39764a9a32f75980206e6b12f815bb83dd15+    ? ./all+, any =+      ./any sha256:b8e9e13b25e799f342a81f6eda4075906eb1a19dfdcb10a0ca25925eba4033b8+    ? ./any+, build =+      ./build sha256:8cf73fc1e115cfcb79bb9cd490bfcbd45c824e93c57a0e64c86c0c72e9ebbe42+    ? ./build+, concat =+      ./concat sha256:54e43278be13276e03bd1afa89e562e94a0a006377ebea7db14c7562b0de292b+    ? ./concat+, concatMap =+      ./concatMap sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64+    ? ./concatMap+, filter =+      ./filter sha256:8ebfede5bbfe09675f246c33eb83964880ac615c4b1be8d856076fdbc4b26ba6+    ? ./filter+, fold =+      ./fold sha256:10bb945c25ab3943bd9df5a32e633cbfae112b7d3af38591784687e436a8d814+    ? ./fold+, generate =+      ./generate sha256:78ff1ad96c08b88a8263eea7bc8381c078225cfcb759c496f792edb5a5e0b1a4+    ? ./generate+, head =+      ./head sha256:0d2e65ba0aea908377e46d22020dc3ad970284f4ee4eb8e6b8c51e53038c0026+    ? ./head+, indexed =+      ./indexed sha256:58bb44457fa81adf26f5123c1b2e8bef0c5aa22dac5fa5ebdfb7da84563b027f+    ? ./indexed+, iterate =+      ./iterate sha256:e4999ccce190a2e2a6ab9cb188e3af6c40df474087827153005293f11bfe1d26+    ? ./iterate+, last =+      ./last sha256:741226b741af152a1638491cdff7f3aa74baf080ada2e63429483f3d195a984d+    ? ./last+, length =+      ./length sha256:42c6812c7a9e3c6e6fad88f77c5b3849503964e071cb784e22c38c888a401461+    ? ./length+, map =+      ./map sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680+    ? ./map+, null =+      ./null sha256:2338e39637e9a50d66ae1482c0ed559bbcc11e9442bfca8f8c176bbcd9c4fc80+    ? ./null+, replicate =+      ./replicate sha256:d4250b45278f2d692302489ac3e78280acb238d27541c837ce46911ff3baa347+    ? ./replicate+, reverse =+      ./reverse sha256:ad99d224d61852de6696da5a7d04c98dbe676fe67d5e4ef4f19e9aaa27006e9d+    ? ./reverse+, shifted =+      ./shifted sha256:54fb22c7e952ebce1cfc0fcdd33ce4cfa817bff9d6564af268dea6685f8b5dfe+    ? ./shifted+, unzip =+      ./unzip sha256:4d6003e9e683a289fe33f4c90f958eb1e08ea0bbb474210fcd90d1885c9660e9+    ? ./unzip+}
+ dhall/prelude/Map/package.dhall view
@@ -0,0 +1,10 @@+{ keys =+      ./keys sha256:d13ec34e6acf7c349d82272ef09a37c7bdf37f0dab489e9df47a1ff215d9f5e7+    ? ./keys+, map =+      ./map sha256:23e09b0b9f08649797dfe1ca39755d5e1c7cad2d0944bdd36c7a0bf804bde8d0+    ? ./map+, values =+      ./values sha256:ae02cfb06a9307cbecc06130e84fd0c7b96b7f1f11648961e1b030ec00940be8+    ? ./values+}
+ dhall/prelude/Natural/package.dhall view
@@ -0,0 +1,34 @@+{ build =+      ./build sha256:e7e25e6c4f1d8e573606ed1bef725396ac2de5c68f7c5d329ffc5822085b984c+    ? ./build+, enumerate =+      ./enumerate sha256:0cf083980a752b21ce0df9fc2222a4c139f50909e2353576e26a191002aa1ce3+    ? ./enumerate+, even =+      ./even sha256:b85b8b56892dfef881e1c0e79eade0b949528f792aac0ea42432b315ede4ee66+    ? ./even+, fold =+      ./fold sha256:fd01c931e585a8f5fd049af7b076b862ea164f1813b34800c7616a49e549ee06+    ? ./fold+, isZero =+      ./isZero sha256:1be98236800ed2d5cff44f16ca02b34b0c37dfa239d9e0d63d9d2c6eeae3d1d1+    ? ./isZero+, odd =+      ./odd sha256:ab3c729262c642ec1cdb72a81e910fcfaf2aea13e3961d0bf1bec83efea5aac5+    ? ./odd+, product =+      ./product sha256:e3e6fd76207875b81d39f79fdbc90b5e640444c04fb3d84c2c9326748f0b26e6+    ? ./product+, sum =+      ./sum sha256:33f7f4c3aff62e5ecf4848f964363133452d420dcde045784518fb59fa970037+    ? ./sum+, show =+      ./show sha256:684ed560ad86f438efdea229eca122c29e8e14f397ed32ec97148d578ca5aa21+    ? ./show+, toDouble =+      ./toDouble sha256:d5eb52143dcd35b46a6f0cdb2d3cbf31a14b6daeba56e29066f8e344c9fb6e81+    ? ./toDouble+, toInteger =+      ./toInteger sha256:160d2d278619f3da34a1f4f02e739a447e4f2aa5a2978c45b710515b41491e1f+    ? ./toInteger+}
+ dhall/prelude/Optional/package.dhall view
@@ -0,0 +1,40 @@+{ all =+      ./all sha256:b9b015fe8be14da940901aa1510ee1d5e205df37ee651c32ac975a799782c410+    ? ./all+, any =+      ./any sha256:0a637c0f2cc7d30b8f0bca021d2ee1ad1213fb9d9712c669b29feab66a590eaf+    ? ./any+, build =+      ./build sha256:f331299d1279cfb88dd25a5acfdd64130900991b6154239ad343a2883f6eb50c+    ? ./build+, concat =+      ./concat sha256:b49a3b7dc49eb83d150977caa5ae347be1cbbe14e3b6d0e07349bd2e5f707d69+    ? ./concat+, filter =+      ./filter sha256:b3d5e19a6cec592a76c12167a9e5e1e76649e776229d70a11c77b76cd29f617e+    ? ./filter+, fold =+      ./fold sha256:62139ff410ca84302acebe763a8a1794420dd472d907384c7fb80df2a2180302+    ? ./fold+, head =+      ./head sha256:b0b5d257294515f1de35f24fa83e54d7f1d5ebca9c3c1fc903a80ab40e19b3a6+    ? ./head+, last =+      ./last sha256:f839221a8a04adae6c501458eb264e7f4e375a1facb294cb80caacfd012a6765+    ? ./last+, length =+      ./length sha256:722a3754a411c053f006a32c506a6d1b14869c2ab799169df9cdac346edf07d3+    ? ./length+, map =+      ./map sha256:e7f44219250b89b094fbf9996e04b5daafc0902d864113420072ae60706ac73d+    ? ./map+, null =+      ./null sha256:efc43103e49b56c5bf089db8e0365bbfc455b8a2f0dc6ee5727a3586f85969fd+    ? ./null+, toList =+      ./toList sha256:390fe99619e9a25e71a253a2b33011f9e5fa26a7d990795205543d1edd72ce5b+    ? ./toList+, unzip =+      ./unzip sha256:7b517bc2a8a4dbec044c6bea5e059cafde5a0cb1d3a5e7d13d346c9327a00f30+    ? ./unzip+}
+ dhall/prelude/Text/package.dhall view
@@ -0,0 +1,16 @@+{ concat =+      ./concat sha256:731265b0288e8a905ecff95c97333ee2db614c39d69f1514cb8eed9259745fc0+    ? ./concat+, concatMap =+      ./concatMap sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f+    ? ./concatMap+, concatMapSep =+      ./concatMapSep sha256:c272aca80a607bc5963d1fcb38819e7e0d3e72ac4d02b1183b1afb6a91340840+    ? ./concatMapSep+, concatSep =+      ./concatSep sha256:e4401d69918c61b92a4c0288f7d60a6560ca99726138ed8ebc58dca2cd205e58+    ? ./concatSep+, show =+      ./show sha256:c9dc5de3e5f32872dbda57166804865e5e80785abe358ff61f1d8ac45f1f4784+    ? ./show+}
+ dhall/prelude/XML/package.dhall view
@@ -0,0 +1,19 @@+{ attribute =+      ./attribute sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc+    ? ./attribute+, render =+      ./render sha256:8d034f7f97cded14a96147565d489be840e5678480d175b962b2600d85a3230e+    ? ./render+, element =+      ./element sha256:e0b948053c8cd8ccca9c39244d89e3f42db43d222531c18151551dfc75208b4b+    ? ./element+, leaf =+      ./leaf sha256:107cb75d0355e7f13dcd5ec3bf30cdd2604ba4ebd1373b0faa8929910ba344a1+    ? ./leaf+, text =+      ./text sha256:c83cd721d32d7dc28c04ce429c0cb22812639e572637ec348578a58ffb68844f+    ? ./text+, emptyAttributes =+      ./emptyAttributes sha256:11b86e2d3f3c75d47a1d580213d2a03fd2c36d64f3e9b6381de0ba23472f64d5+    ? ./emptyAttributes+}
+ dhall/prelude/package.dhall view
@@ -0,0 +1,34 @@+{ Bool =+      ./Bool/package.dhall sha256:7ee950e7c2142be5923f76d00263e536b71d96cb9c190d7743c1679501ddeb0a+    ? ./Bool/package.dhall+, Double =+      ./Double/package.dhall sha256:b8d20ab3216083622ae371fb42a6732bc67bb2d66e84989c8ddba7556a336cf7+    ? ./Double/package.dhall+, Function =+      ./Function/package.dhall sha256:74c3822b98b9d37f9f820af8e1a7ee790bcfac03050eabd45af4a255fb93e026+    ? ./Function/package.dhall+, Integer =+      ./Integer/package.dhall sha256:eb464566d3192dd16ce915a9bd874aaaad612d5c69beb356e5b7d2e0c4949dcf+    ? ./Integer/package.dhall+, List =+      ./List/package.dhall sha256:108be3af5ebd465f7091039f2216c433e65ae5d25556a9a71786dd84d33ef49a+    ? ./List/package.dhall+, Map =+      ./Map/package.dhall sha256:07cc274220c8bdb2c1a0c2d00d90bc1447e73e0ad2e1d72b89773e923f77e71e+    ? ./Map/package.dhall+, Natural =+      ./Natural/package.dhall sha256:fe08155c3a04500df847ca94d013ecd3dfc73ab5c136109b2414fce3ec42b63a+    ? ./Natural/package.dhall+, Optional =+      ./Optional/package.dhall sha256:36a366af67a3c26cd5d196e095d3023f18953c5b5db3a03956fa554609e5442a+    ? ./Optional/package.dhall+, JSON =+      ./JSON/package.dhall sha256:34a613c89df3f314c606a813f592d1a09fedb3e5f5e63fcc0ae9c88245e8bdad+    ? ./JSON/package.dhall+, Text =+      ./Text/package.dhall sha256:3b6ed813caf2388b91056d625c6b958b72009f85a6af262d4a7b935b18caf62b+    ? ./Text/package.dhall+, XML =+      ./XML/package.dhall sha256:abace25be73c3ba823abfba92bb3742a0454d521804a5d19ab5dfbf966473a5d+    ? ./XML/package.dhall+}
+ dhall/types/AbsolutePosition.dhall view
@@ -0,0 +1,3 @@+let AbsolutePosition : Type = { x : Integer, y : Integer }++in  AbsolutePosition
+ dhall/types/Address.dhall view
@@ -0,0 +1,8 @@+{- `Address` is just a tagged ("newtyped", in Haskell terminology) piece of text.++Tagging is used to catch more errors during type checking, by preventing+unification with `Text` values of other domains.++`Address` values are meant to be constructed using `utils.mkAddress`.+-}+let Address : Type = < Address : Text > in Address
+ dhall/types/Assertion.dhall view
@@ -0,0 +1,1 @@+let Assertion = < BinaryInPath : Text | SuccessfulExit : Text > in Assertion
+ dhall/types/Bar.dhall view
@@ -0,0 +1,13 @@+{- A Boehm-Berarducci encoding for dzen2 bars.++Can be decoded to any type by providing "constructor functions" for each case.++For example, ./mkPlugin.dhall converts `Bar` to `Plugin`, which is a synonym for+ `List Token`.+-}++let Carrier = ./Carrier.dhall++let Bar = ∀(Bar : Type) → Carrier Bar → Bar++in  Bar
+ dhall/types/Button.dhall view
@@ -0,0 +1,2 @@+let Button = < Left | Middle | Right | ScrollUp | ScrollDown | ScrollLeft | ScrollRight >+in Button
+ dhall/types/Carrier.dhall view
@@ -0,0 +1,90 @@+let AbsolutePosition = ./AbsolutePosition.dhall++let Address = ./Address.dhall++let Assertion = ./Assertion.dhall++let Button = ./Button.dhall++let Color = ./Color.dhall++let Check = ./Check.dhall++let Direction = ./Direction.dhall++let Hook = ./Hook.dhall++let Image = ./Image.dhall++let Marquee = ./Marquee.dhall++let Padding = ./Padding.dhall++let Plugin = ./Plugin.dhall++let Position = ./Position.dhall++let Slider = ./Slider.dhall++let Source = ./Source.dhall++let StateMap = ./StateMap.dhall++let Transition = ./Transition.dhall++let Variable = ./Variable.dhall++let Carrier+	: ∀(Bar : Type) → Type+	=   λ(Bar : Type)+	  → { text :+			Text → Bar+		, markup :+			Text → Bar+		, join :+			List Bar → Bar+		, fg :+			Color → Bar → Bar+		, bg :+			Color → Bar → Bar+		, i :+			Image → Bar+		, r :+			Natural → Natural → Bar+		, ro :+			Natural → Natural → Bar+		, c :+			Natural → Bar+		, co :+			Natural → Bar+		, p :+			Position → Bar → Bar+		, pa :+			AbsolutePosition → Bar → Bar+		, ca :+			Button → Text → Bar → Bar+		, ib :+			Bar → Bar+		, slider :+			Slider → List Bar → Bar+		, marquee :+			Marquee → Bar → Bar+		, pad :+			Natural → Padding → Bar → Bar+		, trim :+			Natural → Direction → Bar → Bar+		, source :+			Source → Bar+		, plug :+			Plugin → Bar+		, automaton :+			Address → List Transition → StateMap Bar → Bar+		, check :+			Text → Assertion → Bar+		, define :+			Variable → Text → Bar+		, scope :+			Bar → Bar+		}++in  Carrier
+ dhall/types/Check.dhall view
@@ -0,0 +1,5 @@+let Assertion = ./Assertion.dhall++let Check : Type = { message : Text, assertion : Assertion }++in  Check
+ dhall/types/ClosingTag.dhall view
@@ -0,0 +1,1 @@+< Closing >
+ dhall/types/Color.dhall view
@@ -0,0 +1,1 @@+Text
+ dhall/types/Configuration.dhall view
@@ -0,0 +1,5 @@+let Plugin = ./Plugin.dhall++let Settings = ./Settings.dhall++in  { bar : Plugin, settings : Settings }
+ dhall/types/Direction.dhall view
@@ -0,0 +1,1 @@+let Direction = < Left | Right > in Direction
+ dhall/types/Event.dhall view
@@ -0,0 +1,8 @@+{- `Event` is just a tagged ("newtyped", in Haskell terminology) piece of text.++Tagging is used to catch more errors during type checking, by preventing+unification with `Text` values of other domains.++`Event` values are meant to be constructed using `utils.mkEvent`.+-}+let Event = < Event : Text > in Event
+ dhall/types/Fade.dhall view
@@ -0,0 +1,6 @@+let VerticalDirection = ./VerticalDirection.dhall++let Fade =+	  { direction : VerticalDirection, frameCount : Natural, height : Natural }++in  Fade
+ dhall/types/Hook.dhall view
@@ -0,0 +1,9 @@+let Hook+	: Type+	= { command :+		  List Text+	  , input :+		  Text+	  }++in  Hook
+ dhall/types/Image.dhall view
@@ -0,0 +1,1 @@+let Image : Type = Text in Image
+ dhall/types/Marquee.dhall view
@@ -0,0 +1,1 @@+{ framesPerCharacter : Natural, width : Natural, shouldWrap : Bool }
+ dhall/types/OpeningTag.dhall view
@@ -0,0 +1,49 @@+let AbsolutePosition = ./AbsolutePosition.dhall++let Address = ./Address.dhall++let Button = ./Button.dhall++let Color = ./Color.dhall++let Direction = ./Direction.dhall++let Hook = ./Hook.dhall++let Marquee = ./Marquee.dhall++let Padding = ./Padding.dhall++let Position = ./Position.dhall++let Slider = ./Slider.dhall++let State = ./State.dhall++let Transition = ./Transition.dhall++in  < Marquee :+		Marquee+	| Slider :+		Slider+	| FG :+		Color+	| BG :+		Color+	| P :+		Position+	| PA :+		AbsolutePosition+	| CA :+		{ button : Button, command : Text }+	| IB+	| Padding :+		{ width : Natural, padding : Padding }+	| Trim :+		{ width : Natural, direction : Direction }+	| Automaton :+		{ stt : List Transition, address : Address }+	| StateMapKey :+		State+	| Scope+	>
+ dhall/types/Padding.dhall view
@@ -0,0 +1,1 @@+let Padding : Type = < Left | Right | Sides > in Padding
+ dhall/types/Plugin.dhall view
@@ -0,0 +1,1 @@+List ./Token.dhall
+ dhall/types/PluginMeta.dhall view
@@ -0,0 +1,20 @@+let PluginMeta =+	  { name :+		  Text+	  , author :+		  Text+	  , email :+		  Optional Text+	  , homepage :+		  Optional Text+	  , upstream :+		  Optional Text+	  , description :+		  Text+	  , usage :+		  Text+	  , apiVersion :+		  Natural+	  }++in  PluginMeta
+ dhall/types/Position.dhall view
@@ -0,0 +1,15 @@+let Position+	: Type+	= < XY :+		  { x : Integer, y : Integer }+	  | _RESET_Y+	  | _LOCK_X+	  | _UNLOCK_X+	  | _LEFT+	  | _RIGHT+	  | _TOP+	  | _CENTER+	  | _BOTTOM+	  >++in  Position
+ dhall/types/Settings.dhall view
@@ -0,0 +1,11 @@+{ monitor :+	Natural+, extraArgs :+	List Text+, updateInterval :+	Natural+, font :+	Optional Text+, fontWidth :+	Natural+}
+ dhall/types/Shell.dhall view
@@ -0,0 +1,7 @@+{- A type synonym for `Text` values that are used as shell scripts.++Unfortunately, `Shell`, unlike `State` or `Address`, can't be newtyped, because+we need to use string interpolation with it.+-}++let Shell : Type = Text in Shell
+ dhall/types/Slider.dhall view
@@ -0,0 +1,7 @@+let VerticalDirection = ./VerticalDirection.dhall++let Fade = ./Fade.dhall++let Slider = { fadeIn : Fade, fadeOut : Fade, delay : Natural }++in  Slider
+ dhall/types/Source.dhall view
@@ -0,0 +1,9 @@+{ command :+	List Text+, input :+	Text+, updateInterval :+	Optional Natural+, escape :+	Bool+}
+ dhall/types/State.dhall view
@@ -0,0 +1,8 @@+{- `State` is just a tagged ("newtyped", in Haskell terminology) piece of text.++Tagging is used to catch more errors during type checking, by preventing+unification with `Text` values of other domains.++`State` values are meant to be constructed using `utils.mkState`.+-}+let State = < State : Text > in State
+ dhall/types/StateMap.dhall view
@@ -0,0 +1,5 @@+let State = ./State.dhall++let StateMap : Type → Type = λ(Bar : Type) → List { state : State, bar : Bar }++in  StateMap
+ dhall/types/Token.dhall view
@@ -0,0 +1,25 @@+< Open :+	./OpeningTag.dhall+| Markup :+	Text+| Source :+	./Source.dhall+| Txt :+	Text+| Separator+| I :+	./Image.dhall+| R :+	{ w : Natural, h : Natural }+| RO :+	{ w : Natural, h : Natural }+| C :+	Natural+| CO :+	Natural+| Check :+	./Check.dhall+| Define :+	{ name : Text, value : Text }+| Close+>
+ dhall/types/Transition.dhall view
@@ -0,0 +1,11 @@+let Event = ./Event.dhall++let State = ./State.dhall++let Hook = ./Hook.dhall++let Transition+	: Type+	= { events : List Event, from : List State, to : State, hooks : List Hook }++in  Transition
+ dhall/types/Variable.dhall view
@@ -0,0 +1,8 @@+{- `Variable` is just a tagged ("newtyped", in Haskell terminology) piece of text.++Tagging is used to catch more errors during type checking, by preventing+unification with `Text` values of other domains.++`Variable` values are meant to be constructed using `utils.mkVariable`.+-}+let Variable : Type = < Variable : Text > in Variable
+ dhall/types/VerticalDirection.dhall view
@@ -0,0 +1,1 @@+let VerticalDirection = < Up | Down > in VerticalDirection
+ dhall/types/package.dhall view
@@ -0,0 +1,57 @@+{ AbsolutePosition =+	./AbsolutePosition.dhall+, Address =+	./Address.dhall+, Assertion =+	./Assertion.dhall+, Bar =+	./Bar.dhall+, Button =+	./Button.dhall+, Carrier =+	./Carrier.dhall+, Check =+	./Check.dhall+, Color =+	./Color.dhall+, Configuration =+	./Configuration.dhall+, Direction =+	./Direction.dhall+, Event =+	./Event.dhall+, Fade =+	./Fade.dhall+, Hook =+	./Hook.dhall+, Image =+	./Image.dhall+, Marquee =+	./Marquee.dhall+, Padding =+	./Padding.dhall+, Plugin =+	./Plugin.dhall+, PluginMeta =+	./PluginMeta.dhall+, Position =+	./Position.dhall+, Settings =+	./Settings.dhall+, Shell =+	./Shell.dhall+, Slider =+	./Slider.dhall+, Source =+	./Source.dhall+, State =+	./State.dhall+, StateMap =+	./StateMap.dhall+, Transition =+	./Transition.dhall+, Variable =+	./Variable.dhall+, VerticalDirection =+	./VerticalDirection.dhall+}
+ dhall/utils/addHook.dhall view
@@ -0,0 +1,13 @@+let types = ../types/package.dhall++let Transition = types.Transition++let Hook = types.Hook++let addHook+	: Hook → Transition → Transition+	=   λ(hook : Hook)+	  → λ(transition : Transition)+	  → transition ⫽ { hooks = [ hook ] # transition.hooks }++in  addHook
+ dhall/utils/defaults.dhall view
@@ -0,0 +1,69 @@+{- Well-chosen default values for various types. -}+let types = ../types/package.dhall++let Settings = types.Settings++let Button = types.Button++let VerticalDirection = types.VerticalDirection++let Fade = types.Fade++let Slider = types.Slider++let Marquee = types.Marquee++let Source = types.Source++let fade+	: Fade+	= { direction = VerticalDirection.Up, frameCount = 5, height = 10 }++let slider : Slider = { fadeIn = fade, fadeOut = fade, delay = 5000 }++let settings+	: Settings+	= { monitor =+		  0+	  , extraArgs =+		  [ "-ta", "l" ] : List Text+	  , updateInterval =+		  250+	  , font =+		  Some "-*-monospace-medium-r-*-*-14-*-*-*-*-*-*-*"+	  , fontWidth =+		  8+	  }++let source+	: Source+	= { command =+		  [ "bash" ]+	  , input =+		  ""+	  , updateInterval =+		  Some 1000+	  , escape =+		  True+	  }++let button : Button = Button.Left++let marquee : Marquee = { framesPerCharacter = 8, width = 32, shouldWrap = False }++let defaults =+	  { settings =+		  settings+	  , fade =+		  fade+	  , slider =+		  slider+	  , source =+		  source+	  , button =+		  button+	  , marquee =+		  marquee+	  }++in  defaults
+ dhall/utils/emit.dhall view
@@ -0,0 +1,9 @@+let Event = ../types/Event.dhall++let Shell = ../types/Shell.dhall++let showEvent = ./showEvent.dhall++let emitEvent : Event → Shell = λ(event : Event) → "\$EMIT ${showEvent event}"++in  emitEvent
+ dhall/utils/get.dhall view
@@ -0,0 +1,7 @@+let Variable = ../types/Variable.dhall++let showVariable = ./showVariable.dhall++let get = λ(name : Variable) → "`\$GET ${showVariable name}`"++in  get
+ dhall/utils/getCurrentState.dhall view
@@ -0,0 +1,5 @@+let Shell = ../types/Shell.dhall++let getCurrentState : Shell = "\"\$CURRENT_STATE\""++in  getCurrentState
+ dhall/utils/getEvent.dhall view
@@ -0,0 +1,5 @@+let Shell = ../types/Shell.dhall++let getEvent : Shell = "\"\$EVENT\""++in  getEvent
+ dhall/utils/getNextState.dhall view
@@ -0,0 +1,5 @@+let Shell = ../types/Shell.dhall++let getNextState : Shell = "\"\$NEXT_STATE\""++in  getNextState
+ dhall/utils/intersperse.dhall view
@@ -0,0 +1,30 @@+{- The intersperse function takes an element and a list and `intersperses' that element between the elements of the list. For example,++```+intersperse Natural 0 [ 1, 2, 3, 4 ] = [ 1, 0, 2, 0, 3, 0, 4 ]+```+-}+let List/null = ../prelude/List/null++let List/intersperse+	: ∀(e : Type) → e → List e → List e+	=   λ(e : Type)+	  → λ(separator : e)+	  → λ(list : List e)+	  → let cons =+				λ(element : e)+			  → λ(continue : List e → List e)+			  → λ(step : List e)+			  → continue+				(       if List/null e step++				  then  [ element ]++				  else  step # [ separator, element ]+				)++		let nil = λ(x : List e) → x++		in  List/fold e list (List e → List e) cons nil ([] : List e)++in  List/intersperse
+ dhall/utils/mkAddress.dhall view
@@ -0,0 +1,5 @@+let Address = ../types/Address.dhall++let mkAddress : Text → Address = λ(address : Text) → Address.Address address++in  mkAddress
+ dhall/utils/mkBash.dhall view
@@ -0,0 +1,22 @@+{- This function creates a Source that runs a given bash script with specified update interval.+-}++let types = ../types/package.dhall++let mkBash =+		λ(Bar : Type)+	  → λ(carrier : types.Carrier Bar)+	  → λ(interval : Natural)+	  → λ(input : Text)+	  → carrier.source+		{ command =+			[ "bash" ]+		, input =+			input+		, updateInterval =+			Some interval+		, escape =+			True+		}++in  mkBash
+ dhall/utils/mkBashHook.dhall view
@@ -0,0 +1,9 @@+let Hook = ../types/Hook.dhall++let Shell = ../types/Shell.dhall++let mkBashHook+	: Shell → Hook+	= λ(shell : Shell) → { command = [ "bash" ], input = shell } : Hook++in  mkBashHook
+ dhall/utils/mkBashWithBinaries.dhall view
@@ -0,0 +1,35 @@+{- This function creates a Source that runs a given bash script with specified update interval.++Additionally, it asserts that given executables are in PATH.+-}++let prelude = ../prelude/package.dhall++let types = ../types/package.dhall++let Assertion = types.Assertion++let Carrier = types.Carrier++let mkBash = ./mkBash.dhall++let mkBashWithBinaries =+		λ(Bar : Type)+	  → λ(carrier : Carrier Bar)+	  → λ(binaries : List Text)+	  → λ(interval : Natural)+	  → λ(input : Text)+	  → carrier.join+		[ carrier.join+		  ( prelude.List.map+			Text+			Bar+			(   λ(binary : Text)+			  → carrier.check "" (Assertion.BinaryInPath binary)+			)+			binaries+		  )+		, mkBash Bar carrier interval input+		]++in  mkBashWithBinaries
+ dhall/utils/mkConfigs.dhall view
@@ -0,0 +1,25 @@+{- Converts 'Bar' to 'Plugin' using 'mkPlugin' in a list of 'Configuration's.+-}++let prelude = ../prelude/package.dhall++let types = ../types/package.dhall++let Bar = types.Bar++let Configuration = types.Configuration++let Settings = types.Settings++let ConfigEntry = { bar : Bar, settings : Settings }++let mkPlugin = ./mkPlugin.dhall++let mkConfigs+	: List ConfigEntry → List Configuration+	= prelude.List.map+	  ConfigEntry+	  Configuration+	  (λ(entry : ConfigEntry) → entry ⫽ { bar = mkPlugin entry.bar })++in  mkConfigs
+ dhall/utils/mkEvent.dhall view
@@ -0,0 +1,5 @@+let Event = ../types/Event.dhall++let mkEvent : Text → Event = λ(address : Text) → Event.Event address++in  mkEvent
+ dhall/utils/mkFade.dhall view
@@ -0,0 +1,12 @@+let Fade = ../types/Fade.dhall++let VerticalDirection = ../types/VerticalDirection.dhall++let mkFade+	: VerticalDirection → Natural → Natural → Fade+	=   λ(direction : VerticalDirection)+	  → λ(frameCount : Natural)+	  → λ(height : Natural)+	  → { direction = direction, frameCount = frameCount, height = height }++in  mkFade
+ dhall/utils/mkMarquee.dhall view
@@ -0,0 +1,16 @@+let Marquee = ../types/Marquee.dhall++let mkMarquee+	: Natural → Natural → Bool → Marquee+	=   λ(framesPerCharacter : Natural)+	  → λ(width : Natural)+	  → λ(shouldWrap : Bool)+	  → { framesPerCharacter =+			framesPerCharacter+		, width =+			width+		, shouldWrap =+			shouldWrap+		}++in  mkMarquee
+ dhall/utils/mkPlugin.dhall view
@@ -0,0 +1,145 @@+{- `Bar` to `Plugin` conversion. -}++let types = ../types/package.dhall++let prelude = ../prelude/package.dhall++let AbsolutePosition = types.AbsolutePosition++let Address = types.Address++let Assertion = types.Assertion++let Bar = types.Bar++let Button = types.Button++let Carrier = types.Carrier++let Check = types.Check++let Color = types.Color++let Direction = types.Direction++let Hook = types.Hook++let Image = types.Image++let Marquee = types.Marquee++let OpeningTag = ../types/OpeningTag.dhall++let Padding = types.Padding++let Plugin = types.Plugin++let Position = types.Position++let Slider = types.Slider++let Source = types.Source++let State = types.State++let StateMap = types.StateMap++let Transition = types.Transition++let Token = ../types/Token.dhall++let Variable = ../types/Variable.dhall++let enclose =+		λ(openingTag : OpeningTag)+	  → λ(child : Plugin)+	  → [ Token.Open openingTag ] # child # [ Token.Close ]++let List/intersperse = ./intersperse.dhall++let showVariable = ./showVariable.dhall++let carrier+	: Carrier Plugin+	= { text =+		  λ(text : Text) → [ Token.Txt text ]+	  , markup =+		  λ(text : Text) → [ Token.Markup text ]+	  , join =+		  λ(children : List Plugin) → prelude.List.concat Token children+	  , fg =+		  λ(color : Color) → enclose (OpeningTag.FG color)+	  , bg =+		  λ(color : Color) → enclose (OpeningTag.BG color)+	  , i =+		  λ(image : Image) → [ Token.I image ]+	  , r =+		  λ(w : Natural) → λ(h : Natural) → [ Token.R { w = w, h = h } ]+	  , ro =+		  λ(w : Natural) → λ(h : Natural) → [ Token.RO { w = w, h = h } ]+	  , c =+		  λ(radius : Natural) → [ Token.C radius ]+	  , co =+		  λ(radius : Natural) → [ Token.CO radius ]+	  , p =+		  λ(position : Position) → enclose (OpeningTag.P position)+	  , pa =+		  λ(position : AbsolutePosition) → enclose (OpeningTag.PA position)+	  , ca =+			λ(button : Button)+		  → λ(command : Text)+		  → enclose (OpeningTag.CA { button = button, command = command })+	  , ib =+		  enclose OpeningTag.IB+	  , slider =+			λ(slider : Slider)+		  → λ(children : List Plugin)+		  → enclose+			(OpeningTag.Slider slider)+			( prelude.List.concat+			  Token+			  (List/intersperse Plugin [ Token.Separator ] children)+			)+	  , marquee =+		  λ(marquee : Marquee) → enclose (OpeningTag.Marquee marquee)+	  , pad =+			λ(width : Natural)+		  → λ(padding : Padding)+		  → enclose (OpeningTag.Padding { width = width, padding = padding })+	  , trim =+			λ(width : Natural)+		  → λ(direction : Direction)+		  → enclose (OpeningTag.Trim { width = width, direction = direction })+	  , source =+		  λ(source : Source) → [ Token.Source source ]+	  , plug =+		  λ(p : Plugin) → p+	  , automaton =+			λ(address : Address)+		  → λ(stt : List Transition)+		  → λ(stateMap : StateMap Plugin)+		  → enclose+			(OpeningTag.Automaton { stt = stt, address = address })+			( prelude.List.concatMap+			  { state : State, bar : Plugin }+			  Token+			  (   λ(row : { state : State, bar : Plugin })+				→ enclose (OpeningTag.StateMapKey row.state) row.bar+			  )+			  stateMap+			)+	  , check =+			λ(message : Text)+		  → λ(assertion : Assertion)+		  → [ Token.Check { message = message, assertion = assertion } ]+	  , define =+			λ(variable : Variable)+		  → λ(value : Text)+		  → [ Token.Define { name = showVariable variable, value = value } ]+	  , scope =+		  enclose OpeningTag.Scope+	  }++let mkPlugin : Bar → Plugin = λ(constructor : Bar) → constructor Plugin carrier++in  mkPlugin
+ dhall/utils/mkReader.dhall view
@@ -0,0 +1,44 @@+{- A function that constructs a Bar that contains a source that reads a given+   variable repeatedly, with a specified interval (in milliseconds).++The following pieces of code are equivalent:++```dhall+bash 500+    ''+    echo "${get var}"+    ''+```++```dhall+reader var 500+```++-}+let types = ../types/package.dhall++let Variable = types.Variable++let Carrier = types.Carrier++let Bar = types.Bar++let showVariable = ./showVariable.dhall++let mkReader =+		λ(Bar : Type)+	  → λ(cr : Carrier Bar)+	  → λ(var : Variable)+	  → λ(updateInterval : Natural)+	  → cr.source+		{ command =+			[ "bash" ]+		, input =+			"\$GET ${showVariable var}"+		, updateInterval =+			Some updateInterval+		, escape =+			True+		}++in  mkReader
+ dhall/utils/mkSeparateBy.dhall view
@@ -0,0 +1,10 @@+let types = ../types/package.dhall++let mkSeparateBy =+		λ(Bar : Type)+	  → λ(carrier : types.Carrier Bar)+	  → λ(sep : Bar)+	  → λ(list : List Bar)+	  → carrier.join (./intersperse.dhall Bar sep list)++in  mkSeparateBy
+ dhall/utils/mkSlider.dhall view
@@ -0,0 +1,12 @@+let Fade = ../types/Fade.dhall++let Slider = ../types/Slider.dhall++let mkSlider+	: Fade → Fade → Natural → Slider+	=   λ(fadeIn : Fade)+	  → λ(fadeOut : Fade)+	  → λ(delay : Natural)+	  → { fadeIn = fadeIn, fadeOut = fadeOut, delay = delay }++in  mkSlider
+ dhall/utils/mkState.dhall view
@@ -0,0 +1,5 @@+let State = ../types/State.dhall++let mkState : Text → State = λ(name : Text) → State.State name++in  mkState
+ dhall/utils/mkTransition.dhall view
@@ -0,0 +1,16 @@+let Event = ../types/Event.dhall++let State = ../types/State.dhall++let Hook = ../types/Hook.dhall++let Transition = ../types/Transition.dhall++let mkTransition+	: Event → State → State → Transition+	=   λ(event : Event)+	  → λ(from : State)+	  → λ(to : State)+	  → { hooks = [] : List Hook, events = [ event ], from = [ from ], to = to }++in  mkTransition
+ dhall/utils/mkTransitions.dhall view
@@ -0,0 +1,17 @@+{- A variant of mkTransition that allows to specify a list of `from` States. -}+let Event = ../types/Event.dhall++let State = ../types/State.dhall++let Hook = ../types/Hook.dhall++let Transition = ../types/Transition.dhall++let mkTransitions+	: Event → List State → State → Transition+	=   λ(event : Event)+	  → λ(from : List State)+	  → λ(to : State)+	  → { hooks = [] : List Hook, events = [ event ], from = from, to = to }++in  mkTransitions
+ dhall/utils/mkVariable.dhall view
@@ -0,0 +1,5 @@+let Variable = ../types/Variable.dhall++let mkVariable : Text → Variable = λ(address : Text) → Variable.Variable address++in  mkVariable
+ dhall/utils/package.dhall view
@@ -0,0 +1,61 @@+{ addHook =+	./addHook.dhall+, defaults =+	./defaults.dhall+, intersperse =+	./intersperse.dhall+, mkAddress =+	./mkAddress.dhall+, mkPlugin =+	./mkPlugin.dhall+, mkConfigs =+	./mkConfigs.dhall+, mkSeparateBy =+	./mkSeparateBy.dhall+, mkState =+	./mkState.dhall+, mkVariable =+	./mkVariable.dhall+, mkEvent =+	./mkEvent.dhall+, mkBash =+	./mkBash.dhall+, mkBashWithBinaries =+	./mkBashWithBinaries.dhall+, mkBashHook =+	./mkBashHook.dhall+, mkFade =+	./mkFade.dhall+, mkTransition =+	./mkTransition.dhall+, mkTransitions =+	./mkTransitions.dhall+, mkSlider =+	./mkSlider.dhall+, mkMarquee =+	./mkMarquee.dhall+, showAddress =+	./showAddress.dhall+, showEvent =+	./showEvent.dhall+, showState =+	./showState.dhall+, showVariable =+	./showVariable.dhall+, emit =+	./emit.dhall+, get =+	./get.dhall+, getEvent =+	./getEvent.dhall+, getCurrentState =+	./getCurrentState.dhall+, getNextState =+	./getNextState.dhall+, mkReader =+	./mkReader.dhall+, set =+	./set.dhall+, query =+	./query.dhall+}
+ dhall/utils/query.dhall view
@@ -0,0 +1,7 @@+let Address = ../types/Address.dhall++let showAddress = ./showAddress.dhall++let query = λ(name : Address) → "`\$GET STATE_${showAddress name}`"++in  query
+ dhall/utils/set.dhall view
@@ -0,0 +1,11 @@+let Variable = ../types/Variable.dhall++let showVariable = ./showVariable.dhall++let Shell = ../types/Shell.dhall++let set+	: Variable → Text → Shell+	= λ(name : Variable) → λ(value : Text) → "\$SET ${showVariable name} \"${value}\""++in  set
+ dhall/utils/showAddress.dhall view
@@ -0,0 +1,7 @@+let Address = ../types/Address.dhall++let showAddress+	: Address → Text+	= λ(address : Address) → merge { Address = λ(text : Text) → text } address++in  showAddress
+ dhall/utils/showEvent.dhall view
@@ -0,0 +1,7 @@+let Event = ../types/Event.dhall++let showEvent+	: Event → Text+	= λ(event : Event) → merge { Event = λ(name : Text) → name } event++in  showEvent
+ dhall/utils/showState.dhall view
@@ -0,0 +1,7 @@+let State = ../types/State.dhall++let showState+	: State → Text+	= λ(state : State) → merge { State = λ(x : Text) → x } state++in  showState
+ dhall/utils/showVariable.dhall view
@@ -0,0 +1,9 @@+let Variable = ../types/Variable.dhall++let Shell = ../types/Shell.dhall++let showVariable+	: Variable → Shell+	= λ(variable : Variable) → merge { Variable = λ(text : Text) → text } variable++in  showVariable
+ dzen-dhall.cabal view
@@ -0,0 +1,218 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 2cb0b71974259161f90b36853a7c56de12745bb2f70424c10cae5b6fb20ea1ed++name:           dzen-dhall+version:        1.0.0+synopsis:       Configure dzen2 bars in Dhall language+description:    Configure dzen2 bars in Dhall language+homepage:       https://github.com/dzen-dhall/dzen-dhall#readme+bug-reports:    https://github.com/dzen-dhall/dzen-dhall/issues+author:         Kalnitsky Vladimir <klntsky@gmail.com>+maintainer:     Kalnitsky Vladimir <klntsky@gmail.com>+license:        BSD-3-Clause+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    CHANGELOG.md+    README.md+    dhall/config.dhall+    dhall/prelude/Bool/package.dhall+    dhall/prelude/Double/package.dhall+    dhall/prelude/Function/package.dhall+    dhall/prelude/Integer/package.dhall+    dhall/prelude/JSON/package.dhall+    dhall/prelude/List/package.dhall+    dhall/prelude/Map/package.dhall+    dhall/prelude/Natural/package.dhall+    dhall/prelude/Optional/package.dhall+    dhall/prelude/package.dhall+    dhall/prelude/Text/package.dhall+    dhall/prelude/XML/package.dhall+    dhall/types/AbsolutePosition.dhall+    dhall/types/Address.dhall+    dhall/types/Assertion.dhall+    dhall/types/Bar.dhall+    dhall/types/Button.dhall+    dhall/types/Carrier.dhall+    dhall/types/Check.dhall+    dhall/types/ClosingTag.dhall+    dhall/types/Color.dhall+    dhall/types/Configuration.dhall+    dhall/types/Direction.dhall+    dhall/types/Event.dhall+    dhall/types/Fade.dhall+    dhall/types/Hook.dhall+    dhall/types/Image.dhall+    dhall/types/Marquee.dhall+    dhall/types/OpeningTag.dhall+    dhall/types/package.dhall+    dhall/types/Padding.dhall+    dhall/types/Plugin.dhall+    dhall/types/PluginMeta.dhall+    dhall/types/Position.dhall+    dhall/types/Settings.dhall+    dhall/types/Shell.dhall+    dhall/types/Slider.dhall+    dhall/types/Source.dhall+    dhall/types/State.dhall+    dhall/types/StateMap.dhall+    dhall/types/Token.dhall+    dhall/types/Transition.dhall+    dhall/types/Variable.dhall+    dhall/types/VerticalDirection.dhall+    dhall/utils/addHook.dhall+    dhall/utils/defaults.dhall+    dhall/utils/emit.dhall+    dhall/utils/get.dhall+    dhall/utils/getCurrentState.dhall+    dhall/utils/getEvent.dhall+    dhall/utils/getNextState.dhall+    dhall/utils/intersperse.dhall+    dhall/utils/mkAddress.dhall+    dhall/utils/mkBash.dhall+    dhall/utils/mkBashHook.dhall+    dhall/utils/mkBashWithBinaries.dhall+    dhall/utils/mkConfigs.dhall+    dhall/utils/mkEvent.dhall+    dhall/utils/mkFade.dhall+    dhall/utils/mkMarquee.dhall+    dhall/utils/mkPlugin.dhall+    dhall/utils/mkReader.dhall+    dhall/utils/mkSeparateBy.dhall+    dhall/utils/mkSlider.dhall+    dhall/utils/mkState.dhall+    dhall/utils/mkTransition.dhall+    dhall/utils/mkTransitions.dhall+    dhall/utils/mkVariable.dhall+    dhall/utils/package.dhall+    dhall/utils/query.dhall+    dhall/utils/set.dhall+    dhall/utils/showAddress.dhall+    dhall/utils/showEvent.dhall+    dhall/utils/showState.dhall+    dhall/utils/showVariable.dhall++source-repository head+  type: git+  location: https://github.com/dzen-dhall/dzen-dhall++library+  exposed-modules:+      DzenDhall+      DzenDhall.AST+      DzenDhall.AST.Render+      DzenDhall.Animation.Marquee+      DzenDhall.Animation.Slider+      DzenDhall.App+      DzenDhall.App.Run+      DzenDhall.App.StartingUp+      DzenDhall.App.Forked+      DzenDhall.Arguments+      DzenDhall.Config+      DzenDhall.Commands.Validate+      DzenDhall.Commands.Plug+      DzenDhall.Data+      DzenDhall.Event+      DzenDhall.Extra+      DzenDhall.Parser+      DzenDhall.Runtime+      DzenDhall.Runtime.Data+      DzenDhall.Templates+      DzenDhall.Validation+  other-modules:+      DzenDhall.Commands.Unplug+      Paths_dzen_dhall+  autogen-modules:+      Paths_dzen_dhall+  hs-source-dirs:+      src+  default-extensions: DeriveFunctor DeriveGeneric FlexibleContexts GeneralizedNewtypeDeriving LambdaCase MultiWayIf NamedFieldPuns OverloadedStrings RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections FlexibleInstances BlockArguments+  ghc-options: -Wall+  build-depends:+      ansi-terminal+    , base >=4.12 && <5+    , bytestring+    , dhall ==1.25.0+    , directory+    , file-embed-lzma+    , filepath+    , hashable+    , hourglass+    , http-conduit+    , http-types+    , megaparsec+    , microlens+    , microlens-th+    , network-uri+    , optparse-applicative+    , parsec+    , parsers+    , pipes+    , prettyprinter+    , prettyprinter-ansi-terminal+    , process+    , random+    , text+    , transformers+    , unix+    , unordered-containers+    , utf8-string+    , vector+  default-language: Haskell2010++executable dzen-dhall+  main-is: Main.hs+  other-modules:+      Paths_dzen_dhall+  hs-source-dirs:+      app+  ghc-options: -Wall -threaded+  build-depends:+      base+    , dzen-dhall+  default-language: Haskell2010++test-suite tasty+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      DzenDhall.Test.Animation.Marquee+      DzenDhall.Test.Arguments+      DzenDhall.Test.AST+      DzenDhall.Test.AST.Render+      DzenDhall.Test.Config+      DzenDhall.Test.Event+      DzenDhall.Test.Parser+      DzenDhall.Test.Plug+      Paths_dzen_dhall+  hs-source-dirs:+      test+  default-extensions: DeriveFunctor DeriveGeneric FlexibleContexts GeneralizedNewtypeDeriving LambdaCase MultiWayIf NamedFieldPuns OverloadedStrings RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections FlexibleInstances BlockArguments+  ghc-options: -Wall+  build-depends:+      HUnit+    , QuickCheck+    , base+    , dhall ==1.25.0+    , dzen-dhall+    , filepath+    , generic-random+    , hspec+    , microlens+    , network-uri+    , optparse-applicative+    , parsec+    , tasty+    , tasty-hspec+    , tasty-hunit+    , tasty-quickcheck+    , template-haskell+    , text+    , unordered-containers+    , vector+  default-language: Haskell2010
+ src/DzenDhall.hs view
@@ -0,0 +1,46 @@+module DzenDhall where++import           DzenDhall.App+import           DzenDhall.App.Run (useConfigurations)+import           DzenDhall.Arguments+import           DzenDhall.Commands.Plug+import           DzenDhall.Commands.Unplug+import           DzenDhall.Commands.Validate+import           DzenDhall.Runtime+import           DzenDhall.Extra (waitForever)++import           Lens.Micro+import           Options.Applicative (execParser)+import qualified GHC.IO.Encoding+import qualified System.IO+++main :: IO ()+main = do++  GHC.IO.Encoding.setLocaleEncoding System.IO.utf8++  arguments <- execParser argumentsParser+  case arguments ^. mbCommand of+    Nothing -> do+      runtime <- readRuntime arguments+      runApp runtime () $ do+        useConfigurations+        liftIO waitForever++    Just Init -> do+      initCommand arguments++    Just (Plug commandArgs) -> do+      runtime <- readRuntime arguments+      runApp runtime () $+        plugCommand commandArgs++    Just (Unplug commandArgs) -> do+      runtime <- readRuntime arguments+      runApp runtime () $+        unplugCommand commandArgs++    Just (Validate commandArgs) -> do+      runtime <- readRuntime arguments+      runApp runtime () (validateCommand commandArgs)
+ src/DzenDhall/AST.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE TemplateHaskell #-}+module DzenDhall.AST where++import           DzenDhall.Config+import           DzenDhall.Data++import           Data.Text (Text)+import qualified Data.Text+import           GHC.Generics++data AST =+  -- | Text.+  ASTText Text |+  -- | Branching+  ASTs AST AST |+  -- | Some property that does not change the visible size of the inner AST.+  ASTProp Property AST |+  -- | Some shape (@^r@, @^i@, @^co@, etc.)+  ASTShape Shape |+  ASTPadding Int Padding AST |+  EmptyAST+  deriving (Eq, Show, Generic)++instance Semigroup AST where+  EmptyAST <> a = a+  a <> EmptyAST = a+  a <> b = ASTs a b+++instance Monoid AST where+  mempty = EmptyAST+  mappend = (<>)+  mconcat [] = EmptyAST+  mconcat [x] = x+  mconcat (x:xs) = ASTs x (mconcat xs)++-- | Represents (possibly partial) result of 'splitAST' computation.+data Split a+  = EmptyL a -- ^ a split with empty LHS tree.+  | EmptyR a Int -- ^ a split that has no RHS tree.+  | Twain a a Int -- ^ a split with left side's length guaranteed to be equal to the given number (third constructor's argument).+  deriving (Show, Eq, Functor)++-- | Get progress (width of LHS) of a 'Split', @O(1)@.+getProgress :: Split a -> Int+getProgress (EmptyR _ n) = n+getProgress (Twain _ _ n) = n+getProgress (EmptyL _) = 0++-- | Join results of two (maybe partial) splits.+--+-- Example:+-- @+-- -- read as "incomplete split with empty RHS and some LHS l of length n+-- -- joined together with a complete split with LHS 'a' of length n' and some+-- -- RHS 'b' is a complete split with LHS equal to (l <> a) with length (n + n')+-- -- and RHS equal to 'b'".+-- EmptyR l n =>> Twain a b n'+--   = Twain (l <> a) b (n + n')+-- @+(=>>) :: Semigroup a => Split a -> Split a -> Split a+EmptyL l =>> EmptyL r+  = EmptyL (l <> r)+EmptyL l =>> EmptyR l' _+  = EmptyL (l <> l')+EmptyL l =>> Twain a b _+  = EmptyL (l <> a <> b)++EmptyR l n =>> EmptyL r+  = Twain l r n+EmptyR l n =>> EmptyR r n'+  = EmptyR (l <> r) (n + n')+EmptyR l n =>> Twain a b n'+  = Twain (l <> a) b (n + n')++Twain l r n =>> EmptyL r'+  = Twain l (r <> r') n+Twain l r n =>> EmptyR r' _+  = Twain l (r <> r') n+Twain l r n =>> Twain l' r' _+  = Twain l (r <> l' <> r') n++-- | Like 'Data.List.splitAt', but for 'AST's.+split :: Int -> AST -> (AST, AST)+split n ast = case splitAST n ast of+  EmptyR l _ -> (l, mempty)+  EmptyL r   -> (mempty, r)+  Twain a b _ -> (a, b)++-- | Split tree at the given position.+splitAST :: Int -> AST -> Split AST+splitAST 0 ast        = EmptyL ast+splitAST _ EmptyAST   = EmptyR EmptyAST 0+splitAST n t@(ASTText text)+  | l > n     = Twain (ASTText (Data.Text.take n text))+                      (ASTText (Data.Text.drop n text))+                      n+  | otherwise = EmptyR t l+  where l = Data.Text.length text+splitAST n (ASTs l r) =+  let res = splitAST n l in+    res =>> splitAST (n - getProgress res) r+splitAST n (ASTProp c t) = fmap (ASTProp c) (splitAST n t)+splitAST n (ASTPadding width padding child) =+  splitAST n (spaces leftPadding <> child <> spaces rightPadding)+    where+      (leftPadding, rightPadding) = paddingWidths padding $ width - astWidth child+      spaces :: Int -> AST+      spaces 0 = EmptyAST+      spaces w = ASTText $ Data.Text.justifyRight w ' ' ""+splitAST _n res@(ASTShape _) =+  EmptyR res 1 -- TODO++paddingWidths :: Padding -> Int -> (Int, Int)+paddingWidths PLeft  w = (w, 0)+paddingWidths PRight w = (0, w)+paddingWidths PSides w+  | w `mod` 2 == 0 = (w `div` 2, w `div` 2)+  | otherwise = (w `div` 2, w `div` 2 + 1)++astWidth :: AST -> Int+astWidth (ASTText txt) = Data.Text.length txt+astWidth (ASTs a b) = astWidth a + astWidth b+astWidth (ASTProp _ a) = astWidth a+astWidth (ASTPadding width _padding child) =+  max (astWidth child) width+astWidth (ASTShape _shape) = 1 -- TODO+astWidth EmptyAST = 0
+ src/DzenDhall/AST/Render.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE TemplateHaskell #-}+-- | Everything needed to convert an 'AST' to 'Text'.+module DzenDhall.AST.Render where++import           DzenDhall.AST+import           DzenDhall.Config+import           DzenDhall.Data+import           DzenDhall.Extra++import           Control.Monad.Trans.Class+import           Control.Monad.Trans.State+import           Control.Monad.Trans.Writer+import           Data.Maybe+import           Control.Monad+import           Data.Text (Text)+import           Lens.Micro+import           Lens.Micro.TH+import qualified Data.Text++-- | Stacks are used to backtrack various dzen markup language tags.+--+-- Dzen itself does not perform backtracking, thus, for example, the letter @"c"@+-- in @^fg(red)a^fg(green)b^fg()c^fg()@ will not be colorized,+-- but 'render' definition for 'AST' mitigates this flaw.+--+-- For example,+--+-- @+-- runRender $+--   ASTProp (FG $ Color "red")+--     (ASTs (ASTs (ASTText "a")+--                 (ASTProp (FG $ Color "green")+--                   (ASTText "b")))+--           (ASTText "c"))+-- @+--+-- will be rendered as @^fg(red)a^fg(green)b^fg(red)c^fg()@+-- (so that @"c"@ will be red).+data RenderState+  = RenderState+  { _bgStack :: [Color]+  , _fgStack :: [Color]+  , _ibStack :: [IgnoreBackground]+  }++-- | A flag that indicates that background should be ignored (analogous to @^ib()@ dzen markup command).+data IgnoreBackground = IgnoreBackground++makeLenses ''RenderState++type Stack a = Lens' RenderState [a]++type Render = StateT RenderState (Writer Text)++runRender :: Renderable a => a -> Text+runRender a = snd $ runWriter (runStateT (render a) $ RenderState [] [] [])++class Renderable a where+  render :: a -> Render ()++instance Renderable IgnoreBackground where+  render IgnoreBackground = write "1"++instance Renderable Color where+  render = write . \case+    Color color -> color++instance Renderable Button where+  render = write . \case+    MouseLeft        -> "1"+    MouseMiddle      -> "2"+    MouseRight       -> "3"+    MouseScrollUp    -> "4"+    MouseScrollDown  -> "5"+    MouseScrollLeft  -> "6"+    MouseScrollRight -> "7"++instance Renderable Event where+  render (Event event) = write event++instance Renderable ClickableArea where+  render ca = do+    render $ ca ^. caButton+    write ","+    write $ ca ^. caCommand++instance Renderable AbsolutePosition where+  render position =+    write $ showPack (position ^. apX) <> ";" <> showPack (position ^. apY)++instance Renderable Shape where+  render = write . \case+    I path -> "^i("  <> path       <> ")"+    R w h  -> "^r("  <> showPack w <> "x" <> showPack h <> ")"+    RO w h -> "^ro(" <> showPack w <> "x" <> showPack h <> ")"+    C r    -> "^c("  <> showPack r <> ")"+    CO r   -> "^co(" <> showPack r <> ")"++instance Renderable AST where+  render EmptyAST =+    pure ()+  render (ASTText text) =+    write text+  render (ASTs a b) =+    (<>) <$> render a <*> render b+  render (ASTProp (FG color) ast) =+    usingStackWithTag fgStack "fg" color ast+  render (ASTProp (BG color) ast) =+    usingStackWithTag bgStack "bg" color ast+  render (ASTProp IB ast) =+    usingStackWithTag ibStack "ib" IgnoreBackground ast+  render (ASTProp (CA ca) ast) = do+    write "^ca("+    render ca+    write ")"+    render ast+    write "^ca()"+  render (ASTProp (PA position) ast) = do+    write "^pa("+    render position+    write ")"+    render ast+  render (ASTProp (P position) ast) = do+    write open+    render ast+    write close+    where+      (open, close) =+        case position of+          XY (x, y)  ->+            ( "^p(" <> showPack x    <> ";" <> showPack y    <> ")"+            , "^p(" <> showPack (-x) <> ";" <> showPack (-y) <> ")"+            )+          P_RESET_Y  -> ("^p()",                  "")+          P_LOCK_X   -> ("^p(_LOCK_X)",           "")+          P_UNLOCK_X -> ("^p(_UNLOCK_X)",         "")+          P_LEFT     -> ("^p(_LOCK_X)^p(_LEFT)",  "^p(_UNLOCK_X)")+          P_RIGHT    -> ("^p(_LOCK_X)^p(_RIGHT)", "^p(_UNLOCK_X)")+          P_TOP      -> ("^p(_TOP)",              "^p()")+          P_CENTER   -> ("^p(_CENTER)",           "^p()")+          P_BOTTOM   -> ("^p(_BOTTOM)",           "^p()")+  render (ASTShape shape) = render shape+  render (ASTPadding width padding ast) = do+    write $ mkPadding leftPadding+    render ast+    write $ mkPadding rightPadding+    where+      mkPadding w = Data.Text.justifyRight w ' ' ""+      (leftPadding, rightPadding) = paddingWidths padding width++-- * Helper functions++write :: Text -> Render ()+write = lift . tell++-- | @^fg()@, @^bg()@ and @^ib()@ are rendered using the same algorithm.+usingStackWithTag :: Renderable a => Stack a -> Text -> a -> AST -> Render ()+usingStackWithTag stack tag value ast = do+    push stack value+    write $ "^" <> tag <> "("+    render value+    write ")"+    render ast+    void $ pop stack+    renew stack tag++pop :: Stack a -> Render (Maybe a)+pop stack = do+  st <- get+  put $ st & stack %~ (fromMaybe [] . safeTail)+  pure $ safeHead $ st ^. stack++push :: Stack a -> a -> Render ()+push stack value = modify (& stack %~ (value :))++renew :: Renderable a => Stack a -> Text -> Render ()+renew stack tag = do+  mbOld <- pop stack+  write $ "^" <> tag <> "("+  case mbOld of+    Just old -> do+      render old+      push stack old+    Nothing -> pure ()+  write ")"
+ src/DzenDhall/Animation/Marquee.hs view
@@ -0,0 +1,62 @@+module DzenDhall.Animation.Marquee where++import           DzenDhall.AST+import           DzenDhall.Config+import           DzenDhall.Data+import qualified DzenDhall.Extra as Extra++import           Data.Function (fix)+import           Lens.Micro++run :: Int -> Marquee -> AST -> Int -> AST+run fontWidth settings ast frameCounter =+  let framesPerChar = settings ^. mqFramesPerChar+      desiredWidth  = settings ^. mqWidth+      shouldWrap    = settings ^. mqShouldWrap++      realWidth     = astWidth ast+      difference    = realWidth - desiredWidth in++  if | difference <= 0 && not shouldWrap ->+         -- Pad AST+         let padding = ASTText (Extra.spaces (- difference)) in+           ASTs ast padding++     | otherwise ->+         -- Select a part of an "infinite" version of AST.+         let shifted = snd $+               DzenDhall.AST.split+               -- `framesPerChar` is checked for zero when marshalling.+               ((frameCounter `div` framesPerChar) `mod` realWidth)+               (fix (ASTs ast))+             trimmed = fst $+               DzenDhall.AST.split desiredWidth shifted in+           if | framesPerChar == 1 -> trimmed+              | otherwise ->+                let pxShift = calculatePxShift frameCounter fontWidth framesPerChar in+                  addPxShift pxShift trimmed+++-- | Calculate shift in pixels.+calculatePxShift+  :: Int+  -- ^ Number of current frame+  -> Int+  -- ^ Character width+  -> Int+  -- ^ How many frames per character?+  -> Int+  -- ^ Shift in pixels+calculatePxShift frameCounter fontWidth framesPerChar =+  let shift = frameCounter `mod` framesPerChar in+    fontWidth - (fontWidth * shift) `div` framesPerChar+++-- | Add sub-character shift to the AST and compensate it+addPxShift+  :: Int+  -- ^ Shift in pixels+  -> AST+  -> AST+addPxShift pxShift =+  ASTProp (P (XY (pxShift, 0)))
+ src/DzenDhall/Animation/Slider.hs view
@@ -0,0 +1,90 @@+module DzenDhall.Animation.Slider where++import DzenDhall.Config+import DzenDhall.AST+import DzenDhall.Data+import DzenDhall.Extra++import Data.Vector (Vector, (!), null, length)+import Lens.Micro++-- | There are three stages of the animation in a cycle:+--+-- 1. Fading in+-- 2. Delay+-- 3. Fading out+run+  :: Slider+  -> Int+  -- ^ Frame number+  -> Vector AST+  -- ^ Vector of possible ASTs (only one of them will be selected)+  -> AST+run _      _     asts+  | Data.Vector.null asts = mempty+-- Short-circuit if `fadeFrameCount`s are all set to zero.+run slider frame asts+  | slider ^. fadeIn  . fadeFrameCount == 0 &&+    slider ^. fadeOut . fadeFrameCount == 0 =+      let astIx       = (frame `div` positive (slider ^. sliderDelay))+                        `mod` Data.Vector.length asts+      in asts ! astIx+run slider frame asts =+  -- Calculate total frame counts for each 3 stages:+  let inFrameCount    = positive $ slider ^. fadeIn  . fadeFrameCount+      delayFrameCount =            slider ^. sliderDelay+      outFrameCount   = positive $ slider ^. fadeOut . fadeFrameCount++      -- Find how many frames total in a cycle+      totalFrames     = positive $+        inFrameCount + delayFrameCount + outFrameCount++      -- Find currenlty selected AST index+      astIx           = (frame `div` totalFrames) `mod` Data.Vector.length asts++      -- Select visible AST+      ast             = asts ! astIx++      -- Find in which frame we are, starting from the beginning of the+      -- animation cycle.+      frameNumber     = frame `mod` totalFrames++      -- Calculate frame number in a cycle from which stage 3 starts+      outStartFrame   = inFrameCount + delayFrameCount++      -- Find out, on which of the three stages we are:+      --+      -- For 1st & 3rd stages, calculate frame number relative to the first+      -- frame of each stage.+      yShift =+        if | frameNumber <= inFrameCount+             -- For the first stage, `relativeFrameNumber` is just `frameNumber` -+             -- - we are starting from 0.+             -> renderFade (slider ^.fadeIn) frameNumber inFrameCount+           | frameNumber < outStartFrame+             -> 0+           | otherwise+             -- For the third stage, `relativeFrameNumber` equals to how many frames+             -- are remaining+             -> renderFade (slider ^. fadeOut) (totalFrames - frameNumber) outFrameCount+  in+    ASTProp (P (XY (0, yShift))) ast+++renderFade+  :: Fade+  -> Int+  -- ^ Number of the current frame+  -> Int+  -- ^ Total frame count in a stage+  -> Int+renderFade fade relativeFrameNumber frameCount =+  let height = fade ^. fadePixelHeight+      dk = direction (fade ^. fadeDirection)+  in+    dk * (height - height * relativeFrameNumber `div` frameCount)+++direction :: VerticalDirection -> Int+direction VUp = -1+direction _   = 1
+ src/DzenDhall/App.hs view
@@ -0,0 +1,207 @@+{-# LANGUAGE TypeFamilies #-}+-- | An 'App' monad with its operations.+module DzenDhall.App where++import DzenDhall.Runtime.Data+import DzenDhall.Config+import DzenDhall.Arguments+import DzenDhall.Extra++import           Control.Monad.Trans.Class+import qualified Control.Monad.Trans.Reader as Reader+import           Control.Monad.Trans.Reader (ReaderT)+import qualified Control.Monad.Trans.State as State+import           Control.Monad.Trans.State (StateT)+import qualified Data.HashMap.Strict as H+import           Data.Hourglass+import           Data.Void+import           Data.Maybe+import           Data.Text (Text)+import qualified Data.Text+import qualified Data.Text.IO+import qualified Dhall+import           Lens.Micro+import           Control.Concurrent+import           Control.Exception+import           Control.Monad+import           System.Exit+import           System.Random+import           System.Directory+import           System.FilePath ((</>))+import           Time.System+++-- * App execution stages+--+-- $executionStages+--+-- Three newtypes below are used as tags to show in which stage of execution the+-- app currently is.++-- | At this stage, 'App' performs config validation, runs startup/initalization,+-- and forks threads that later update bar outputs.+--+-- See also: 'DzenDhall.App.Run'.+newtype Common     = Common     Void++-- | At this stage, the app initializes 'Source's and launches event listeners+-- that read their corresponding named pipes and handle automata state transitions.+--+-- See also: 'DzenDhall.App.StartingUp'.+newtype StartingUp = StartingUp Void++-- | At this stage, the app only updates bar outputs.+--+-- See also: 'DzenDhall.App.Forked'.+newtype Forked     = Forked     Void++-- | Maps app execution stages to app states.+type family StateOf a++type instance StateOf Common     = ()+type instance StateOf StartingUp = StartupState+type instance StateOf Forked     = BarRuntime++-- | 'Runtime' is read-only; mutable state type depends on the current stage of execution of the 'App'.+newtype App stage a = App { unApp :: StateT (StateOf stage) (ReaderT Runtime IO) a }+  deriving (Functor, Applicative, Monad)++runApp :: Runtime -> StateOf stage -> App stage a -> IO a+runApp rt st app = Reader.runReaderT (State.evalStateT (unApp app) st) rt++liftIO :: IO a -> App stage a+liftIO = App . lift . lift++get :: App stage (StateOf stage)+get = App State.get++put :: StateOf stage -> App stage ()+put = App . State.put++modify :: (StateOf stage -> StateOf stage) -> App stage ()+modify f = get >>= put . f++getRuntime :: App stage Runtime+getRuntime = App $ lift Reader.ask++getNonce :: App StartingUp Int+getNonce = do+  modify $ ssNonce +~ 1+  get <&> (^. ssNonce)++liftStartingUp :: App StartingUp a -> BarSettings -> App Common a+liftStartingUp (App app) barSettings = do+++  rtDir <- fmap (</> "dzen-dhall-rt") $ liftIO $+    getTemporaryDirectory `catch` \(_e :: IOException) -> getCurrentDirectory++  tmpDir <- (rtDir </>) <$> randomSuffix++  let+    namedPipe          = tmpDir </> "controller"+    emitterFile        = tmpDir </> "emitter"+    getterFile         = tmpDir </> "getter"+    setterFile         = tmpDir </> "setter"+    variableFilePrefix = tmpDir </> "variables/"+    imagePathPrefix    = tmpDir </> "images/"++  liftIO do+    createDirectoryIfMissing True tmpDir+    createDirectoryIfMissing True variableFilePrefix+    createDirectoryIfMissing True imagePathPrefix++  let initialStartupState =+        StartupState+        mempty "scope"+        barSettings+        0+        H.empty+        H.empty+        []+        []+        H.empty+        mempty+        namedPipe+        emitterFile+        getterFile+        setterFile+        variableFilePrefix+        imagePathPrefix++  App . lift $ State.evalStateT app initialStartupState++runAppForked :: BarRuntime -> App Forked () -> App Common ()+runAppForked barRuntime app = do+  rt <- getRuntime+  liftIO $ void $ forkIO $ runApp rt barRuntime app++forkApp :: App stage () -> App stage ()+forkApp app = do+  rt <- getRuntime+  st <- get+  void $ liftIO $+    forkIO $ runApp rt st app++exit :: Int -> Text -> App stage a+exit exitCode message = liftIO $ do+  unless (Data.Text.null message) $+    Data.Text.IO.putStrLn message+  exitWith $ ExitFailure exitCode++randomSuffix :: App stage String+randomSuffix =+  liftIO $ take 10 . randomRs ('a','z') <$> newStdGen++checkBinary :: String -> App stage Bool+checkBinary = fmap isJust . liftIO . findExecutable++echoLines :: [Text] -> App stage ()+echoLines = mapM_ echo++echo :: Text -> App stage ()+echo = liftIO . Data.Text.IO.putStrLn++highlight :: Text -> App stage Text+highlight text = do+  supportsANSI <- getRuntime <&> (^. rtSupportsANSI)+  pure $+    if supportsANSI then+      "\027[1;33m" <> text <> "\027[0m"+    else+      text++explained :: IO a -> App stage a+explained io = do+  shouldExplain <- getRuntime <&> (\args -> args ^. rtArguments . explain)+  liftIO $ case shouldExplain of+             Explain -> Dhall.detailed io+             DontExplain -> io++timely :: Int -> App stage () -> App stage ()+timely interval task = do++  initialTime <- liftIO $ timeCurrentP++  void $ flip State.runStateT initialTime $ forever $ do++    lastTime <- State.get++    let nextTime =+          addElapsedP lastTime $+          ElapsedP 0 $ NanoSeconds $+          fromIntegral interval * 1000++    State.put nextTime++    lift $ do+      task++      now <- liftIO timeCurrentP++      let delay =+            case timeDiffP nextTime now of+              (Seconds sec, NanoSeconds nsec) ->+                sec * 1000000 + nsec `div` 1000++      liftIO $ threadDelay $ fromIntegral delay
+ src/DzenDhall/App/Forked.hs view
@@ -0,0 +1,28 @@+module DzenDhall.App.Forked where++import           DzenDhall.AST.Render+import           DzenDhall.App+import           DzenDhall.App.StartingUp+import           DzenDhall.Config+import           DzenDhall.Data+import           DzenDhall.Runtime.Data++import           Lens.Micro+import qualified Data.Text.IO+++-- | Update a given 'Bar' forever, trying to do it in a timely manner.+updateForever+  :: Bar Initialized+  -> App Forked ()+updateForever bar = do++  barRuntime <- get++  let barSettings = barRuntime ^. brConfiguration ^. cfgBarSettings++  forkApp do+    timely (barSettings ^. bsUpdateInterval) do+      output <- runRender <$> collectSources bar+      liftIO $ Data.Text.IO.hPutStrLn (barRuntime ^. brHandle) output+      modify $ brFrameCounter +~ 1
+ src/DzenDhall/App/Run.hs view
@@ -0,0 +1,67 @@+module DzenDhall.App.Run where++import           DzenDhall.App as App+import           DzenDhall.App.StartingUp+import           DzenDhall.App.Forked+import           DzenDhall.Config+import           DzenDhall.Data+import           DzenDhall.Event+import           DzenDhall.Extra+import           DzenDhall.Runtime.Data+import qualified DzenDhall.Validation as Validation+import qualified DzenDhall.Parser as Parser++import           Control.Monad+import           Lens.Micro+import           Lens.Micro.Extras+import           System.Exit++-- | Parses 'Bar's. For each 'Configuration' spawns its own dzen binary,+-- source threads and automata handlers.+useConfigurations :: App Common ()+useConfigurations = do+  checkDzen2Executable++  runtime <- App.getRuntime++  forM_ (view rtConfigurations runtime) \cfg -> do++    (errors, barTokens) <- liftIO $+      Validation.run $ cfg ^. cfgBarTokens++    unless (null errors) $+      App.exit 3 $ Validation.report errors++    withEither+      (Parser.runBarParser barTokens)+      (invalidTokens barTokens) $+      \(bar :: Bar Marshalled) -> do+        let barSettings = cfg ^. cfgBarSettings++        (bar', subscriptions, barRuntime, clickableAreas) <-+          liftStartingUp (startUp cfg bar) barSettings++        runAppForked barRuntime (launchEventListener subscriptions clickableAreas)++        runAppForked barRuntime (updateForever bar')+++checkDzen2Executable :: App stage ()+checkDzen2Executable = do+  runtime <- getRuntime+  liftIO $+    checkExecutables [runtime ^. rtDzenBinary] >>= mapM_+    (\executable -> do+        putStrLn $+          "Executable not in PATH: " <> executable <>+          ". See --dzen-binary argument."+        exitWith $ ExitFailure 1)+++invalidTokens :: Show a => [Token] -> a -> App Common ()+invalidTokens barTokens err = do+  App.exit 3 $ fromLines+    [ "Internal error when parsing configuration, debug info: " <> showPack barTokens+    , "Error: " <> showPack err+    , "Please report as bug."+    ]
+ src/DzenDhall/App/StartingUp.hs view
@@ -0,0 +1,499 @@+module DzenDhall.App.StartingUp where++import           DzenDhall.AST+import           DzenDhall.App as App+import           DzenDhall.Arguments+import           DzenDhall.Config+import           DzenDhall.Data+import           DzenDhall.Extra+import           DzenDhall.Runtime.Data+import qualified DzenDhall.Animation.Marquee as Marquee+import qualified DzenDhall.Animation.Slider as Slider++import           Control.Arrow+import           Control.Applicative+import           Control.Monad+import           Data.IORef+import           Data.Maybe+import           Data.Text (Text)+import           GHC.IO.Handle+import           Lens.Micro+import           Lens.Micro.Extras+import           System.Environment+import           System.Posix.Files+import           System.Process+import qualified Data.HashMap.Strict as H+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified System.IO+import qualified Pipes.Prelude as P+import qualified Pipes as P+++startUp+  :: Configuration+  -> Bar Marshalled+  -> App StartingUp (Bar Initialized, Subscriptions, BarRuntime, ClickableAreas)+startUp cfg bar = do+  barRuntime  <- mkBarRuntime cfg+  bar'        <- initialize bar++  state       <- get++  environment <- liftIO getEnvironment++  forM_ (state ^. ssSourceQueue) $+    \(source, outputRef, cacheRef, scope) -> do+      mkThread environment barRuntime source outputRef cacheRef scope++  forM_ (state ^. ssVariableDefinitions) $+    \(scope, name, value) -> do++      let fileName =+            state ^. ssVariableFilePrefix <>+            T.unpack scope <>+            "-v-" <>+            T.unpack name++      liftIO $ do+        T.writeFile fileName value+        setFileMode fileName $+          ownerReadMode  `unionFileModes`+          groupReadMode  `unionFileModes`+          ownerWriteMode `unionFileModes`+          groupWriteMode++  forM_ (H.toList $ state ^. ssImages) $+    \(imageContents, imageId) -> liftIO $ do+      T.writeFile+        (state ^. ssImagePathPrefix <> T.unpack imageId <> ".xbm") imageContents++  pure (bar', state ^. ssSubscriptions, barRuntime, state ^. ssClickableAreas)+++mkBarRuntime+  :: Configuration+  -> App StartingUp BarRuntime+mkBarRuntime cfg = do+  runtime <- getRuntime+  state   <- get++  let dzenBinary  = runtime ^. rtDzenBinary+      barSettings = cfg ^. cfgBarSettings++      extraArgs  = barSettings ^. bsExtraArgs+      fontArgs   = maybe [] (\font -> ["-fn", font]) $ barSettings ^. bsFont+      args       = fontArgs <> extraArgs++      namedPipe          = state ^. ssNamedPipe+      emitterFile        = state ^. ssEmitterFile+      getterFile         = state ^. ssGetterFile+      setterFile         = state ^. ssSetterFile+      variableFilePrefix = state ^. ssVariableFilePrefix++  liftIO $+    createNamedPipe namedPipe (ownerReadMode `unionFileModes` ownerWriteMode)++  liftIO $ do+    forM_ [ ( [ "#!/usr/bin/env bash"+              , "SCOPE=\"$1\""+              , "EVENT=\"$2\""+              , "echo event:\"$EVENT\"@\"$SCOPE\" >> " <>+                T.pack namedPipe+              ],+              emitterFile+            )++          , ( [ "#!/usr/bin/env bash"+              , "SCOPE=\"$1\""+              , "VAR=\"$2\""+              , "cat \"" <> T.pack variableFilePrefix <> "$SCOPE-v-$VAR\""+              ]+            , getterFile+            )++          , ( [ "#!/usr/bin/env bash"+              , "SCOPE=\"$1\""+              , "VAR=\"$2\""+              , "VALUE=\"$3\""+              , "echo \"$VALUE\" > " <>+                T.pack variableFilePrefix <> "\"$SCOPE-v-$VAR\""+              ]+            , setterFile+            )+          ] $++      \(codeLines, file) -> do++        T.writeFile file $ fromLines codeLines+        setFileMode file $+          ownerExecuteMode `unionFileModes`+          groupExecuteMode `unionFileModes`+          ownerReadMode    `unionFileModes`+          groupReadMode++  handle <- case runtime ^. rtArguments ^. stdoutFlag of++    ToStdout -> pure System.IO.stdout++    ToDzen -> do+      (mb_stdin, mb_stdout, _, _) <- liftIO $+        createProcess $+          (proc (runtime ^. rtDzenBinary) args)+            { std_out = CreatePipe+            , std_in  = CreatePipe }++      case (mb_stdin, mb_stdout) of+        (Just stdin, Just stdout) -> liftIO $ do+          hSetEncoding  stdin  System.IO.utf8+          hSetEncoding  stdout System.IO.utf8+          hSetBuffering stdin  LineBuffering+          hSetBuffering stdout LineBuffering+          pure stdin+        _ -> App.exit 4 $+          "Couldn't open IO handles for dzen binary " <>+          showPack dzenBinary++  pure $ BarRuntime cfg 0 namedPipe emitterFile getterFile setterFile handle+++-- | During initialization, IORefs for source outputs and caches are created.+-- Also, new threads for each unique source is created. These threads then+-- update the outputs.+initialize+  :: Bar Marshalled+  -> App StartingUp (Bar Initialized)+initialize (BarSource source@Source{escape}) = do++  state <- get++  -- We don't want to spawn separate threads for identical `Source`s within+  -- the same scope.+  -- A HashMap is used to cache all references to sources and prevent+  -- duplication when possible.+  -- Note that identical sources from distinct scopes are intentionally allowed:+  -- we don't want separate scopes to affect each other's behavior.++  let mbCached = H.lookup (state ^. ssScopeName, source) (state ^. ssSourceCache)++      createRefs :: App StartingUp (IORef Text, Cache)+      createRefs = do+        (outputRef, cacheRef) <- liftIO $+          liftA2 (,) (newIORef "") (newIORef Nothing)+        modify $ ssSourceQueue <>~+          [(source, outputRef, cacheRef, state ^. ssScopeName)]+        pure (outputRef, cacheRef)++  (outputRef, cacheRef) <- maybe createRefs pure mbCached++  pure $ BarSource $ SourceHandle outputRef cacheRef escape++initialize (BarMarquee i p) =+  BarMarquee i <$> initialize p+initialize (BarSlider slider children) = do+  barSettings <- (^. ssBarSettings) <$> get++  -- Convert delay of a slider from microseconds to frames.+  let updateInterval = barSettings ^. bsUpdateInterval+      slider' = slider & sliderDelay %~ (\x -> x * 1000 `div` positive updateInterval)++  BarSlider slider' <$> mapM initialize children++initialize (BarAutomaton address rawSTT rawStateMap) = do+  state <- get++  let scope = state ^. ssScopeName++      mbCached = H.lookup (scope, address) (state ^. ssAutomataCache)++      newBarRef = do+        let initialState = ""++        -- Add current scope to the state transition table.+        let stt = STT+                . H.fromList+                . map (first (_scope .~ state ^. ssScopeName))+                . H.toList+                . unSTT+                $ rawSTT++        -- Create a reference to the current state+        stateRef :: IORef Text <- liftIO $ newIORef initialState++        -- Initialize all children+        stateMap :: H.HashMap Text (Bar Initialized) <- mapM initialize rawStateMap++        -- Create a reference to the current Bar (so that collectSources will not need to+        -- look up the correct Bar in stateMap).+        barRef :: IORef (Bar Initialized) <- liftIO $+          newIORef $ fromMaybe mempty (H.lookup initialState stateMap)++        let subscription = [ AutomatonSubscription address stt stateMap stateRef barRef ]++        -- Bind new subscription to the scope.+        modify $ ssSubscriptions %~ H.insertWith (++) scope subscription++        -- Cache this automaton+        let cacheEntry = (barRef, rawSTT, rawStateMap)++        modify $ ssAutomataCache %~ H.insert (scope, address) cacheEntry++        pure cacheEntry++  (barRef, cachedSTT, cachedStateMap) <- maybe newBarRef pure mbCached++  -- Eventually this should be moved to `Validation.hs`. We need a complete+  -- `Bar` tree available to perform this check, but `Validation.hs` only works+  -- with tokens at the moment of writing.+  when (cachedSTT /= rawSTT || cachedStateMap /= rawStateMap) do+    exit 1 $+      fromLines [ "Automata adresses must be unique per scope!"+                , "Found distinct automata definitions for address " <> address+                ]++  pure $ BarAutomaton address () barRef++initialize (BarScope child) = do+  counter <- getNonce+  oldScopeName <- (^. ssScopeName) <$> get+  modify $ ssScopeName <>~ ("-" <> showPack counter)+  child' <- initialize child+  modify $ ssScopeName .~ oldScopeName+  pure child'++initialize (BarProp (CA ca) child) = do++  identifier <- getNonce+  namedPipe  <- get <&> (^. ssNamedPipe)+  scope      <- get <&> (^. ssScopeName)++  let command =+        "echo click:" <> showPack identifier <>+        "@" <> scope <> " >> " <>+        T.pack namedPipe++  modify $ ssClickableAreas %~ H.insert identifier (ca ^. caCommand)++  BarProp (CA (ca & caCommand .~ command)) <$> initialize child++initialize (BarProp prop p) =+  BarProp prop <$> initialize p+initialize (BarDefine var) = do++  scope <- get <&> (^. ssScopeName)++  modify $+    ssVariableDefinitions %~+    ((scope, var ^. varName, var ^. varValue) :)++  pure mempty+initialize (BarPad width padding p) =+  BarPad width padding <$> initialize p+initialize (BarTrim width direction p) =+  BarTrim width direction <$> initialize p+initialize (Bars ps) =+  Bars <$> mapM initialize ps+initialize (BarShape (I image))+  | isImageContents image = do++      images          <- get <&> (^. ssImages)+      imagePathPrefix <- get <&> (^. ssImagePathPrefix)++      imageId <- case H.lookup image images of+                   Just imageId ->+                     pure imageId+                   Nothing -> do+                     imageId <- showPack <$> getNonce+                     modify $ ssImages %~ H.insert image imageId+                     pure imageId++      pure $ BarShape $ I $ T.pack imagePathPrefix <> imageId <> ".xbm"++initialize (BarShape shape) =+  pure $ BarShape shape+initialize (BarMarkup text) =+  pure $ BarMarkup text+initialize (BarText text) =+  pure $ BarText text++isImageContents :: Text -> Bool+isImageContents =+  T.isInfixOf "#define"++-- | Run source process either once or forever, depending on source settings.+mkThread+  :: [(String, String)]+  -> BarRuntime+  -> Source+  -> IORef Text+  -> Cache+  -> Text+  -> App StartingUp ()+mkThread _ _ Source { command = [] } outputRef cacheRef _scope = do+  let message = "dzen-dhall error: no command specified"+  liftIO $ do+    writeIORef cacheRef $ Just message+    writeIORef outputRef message+mkThread+  environment+  barRuntime+  Source { updateInterval+         , command = (binary : args)+         , input }+  outputRef+  cacheRef+  scope = do++  let emitter =+        barRuntime ^. brEmitterScript <> " " <> T.unpack scope+      getter =+        barRuntime ^. brGetterScript  <> " " <> T.unpack scope+      setter =+        barRuntime ^. brSetterScript  <> " " <> T.unpack scope++      sourceProcess =+        (proc binary args) { std_out = CreatePipe+                           , std_in  = CreatePipe+                           , std_err = CreatePipe+                           , env = Just $+                             [ ("EMIT", emitter)+                             , ("GET",  getter)+                             , ("SET",  setter)+                             ] <>+                             environment+                           }++  forkApp+    case updateInterval of++      -- If update interval is specified, loop forever.+      Just interval -> do+        timely interval $ liftIO do+          runSourceProcess sourceProcess outputRef cacheRef input++      -- If update interval is not specified, run the source once.+      Nothing ->+        liftIO $+          runSourceProcess sourceProcess outputRef cacheRef input+++-- | Creates a process, subscribes to its stdout handle and updates the output ref.+runSourceProcess+  :: CreateProcess+  -> IORef Text+  -> Cache+  -> Text+  -> IO ()+runSourceProcess cp outputRef cacheRef input = do+  (mb_stdin_hdl, mb_stdout_hdl, mb_stderr_hdl, ph) <- createProcess cp++  case (mb_stdin_hdl, mb_stdout_hdl, mb_stderr_hdl) of+    (Just stdin, Just stdout, _) -> do+      hSetEncoding  stdin  System.IO.utf8+      hSetEncoding  stdout System.IO.utf8+      hSetBuffering stdin  LineBuffering+      hSetBuffering stdout LineBuffering++      T.hPutStrLn stdin input+      hClose stdin++      P.runEffect do+        P.for (P.fromHandle stdout) \line -> P.lift do++          -- Drop cache+          writeIORef cacheRef Nothing+          writeIORef outputRef (T.pack line)++      void $ waitForProcess ph++    _ -> do+      putStrLn "dzen-dhall error: Couldn't open IO handle(s)"+++-- | Reads outputs of 'SourceHandle's and puts them into an AST.+collectSources+  :: Bar Initialized+  -> App Forked AST+collectSources (BarSource handle) = liftIO do+  let outputRef  = handle ^. shOutputRef+      cacheRef   = handle ^. shCacheRef+      escape     = handle ^. shEscape++  cache <- readIORef cacheRef+  case cache of+    Just escaped ->+      pure $ ASTText escaped+    Nothing -> do+      raw <- readIORef outputRef+      let escaped = escapeMarkup escape raw+      writeIORef cacheRef (Just escaped)+      pure $ ASTText escaped++collectSources (BarMarquee marquee p) = do++  ast          <- collectSources p+  frameCounter <- view brFrameCounter <$> App.get+  fontWidth    <- App.get <&> (^. brConfiguration . cfgBarSettings . bsFontWidth)+  pure $ Marquee.run fontWidth marquee ast frameCounter++collectSources (BarSlider slider ss) = do++  frameCounter <- view brFrameCounter <$> App.get+  asts         <- mapM collectSources ss+  pure $ Slider.run slider frameCounter asts++collectSources (BarAutomaton _ _ ref) = do++  bar          <- liftIO (readIORef ref)+  collectSources bar++collectSources (BarScope child) = do+  collectSources child++collectSources (BarPad width padding child) = do+  ASTPadding width padding <$> collectSources child++collectSources (BarTrim width direction child) = do+  ast <- collectSources child+  case direction of+    DRight ->+      pure $ fst $ split width ast+    DLeft -> do+      let actualWidth = astWidth ast+      pure $ snd $ split (abs $ actualWidth - width) ast++collectSources (BarShape shape) = do+  pure $ ASTShape shape++collectSources (BarProp prop child)+  = ASTProp prop <$> collectSources child+collectSources  (BarDefine _prop)+  = pure mempty+collectSources (Bars ps)+  = mconcat <$> mapM collectSources ps+collectSources (BarText text)+  = pure $ ASTText text+collectSources (BarMarkup text)+  = pure $ ASTText text+++-- | Escape @^@ characters.+escapeMarkup+  :: Bool+  -> Text+  -> Text+escapeMarkup escape =+  (if escape+   then T.replace "^" "^^"+   else id)++allButtons :: [Button]+allButtons =+  [ MouseLeft+  , MouseMiddle+  , MouseRight+  , MouseScrollUp+  , MouseScrollDown+  , MouseScrollLeft+  , MouseScrollRight+  ]
+ src/DzenDhall/Arguments.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE TemplateHaskell #-}+-- | Arguments data and parser.+module DzenDhall.Arguments where++import           Options.Applicative+import           Data.Semigroup ((<>))+import           Lens.Micro.TH++-- * Flags++data Explain+  = Explain | DontExplain+  deriving (Show, Eq)++-- | Whether to skip confirmation when running `plug` command.+data ConfirmPlug+  = Confirm | DontConfirm+  deriving (Show, Eq)++data StdoutFlag+  = ToDzen | ToStdout+  deriving (Show, Eq)++data SkipAssertions+  = SkipAssertions | DontSkip+  deriving (Show, Eq)++-- * Main data++data PlugCommand+  = PlugCommand { source :: String+                , confirm :: ConfirmPlug+                }+  deriving (Show, Eq)++newtype UnplugCommand+  = UnplugCommand String+  deriving (Show, Eq)++data ValidateCommand+  = ValidateCommand { skipAssertions :: SkipAssertions+                    }+  deriving (Show, Eq)++data Command+  = Init+  | Plug PlugCommand+  | Unplug UnplugCommand+  | Validate ValidateCommand+  deriving (Show, Eq)++data Arguments+  = Arguments+  { _mbConfigDir :: Maybe String+  , _mbDzenBinary :: Maybe String+  , _stdoutFlag :: StdoutFlag+  , _mbCommand  :: Maybe Command+  , _explain :: Explain+  }+  deriving (Show, Eq)++makeLenses ''Arguments++argParser :: Parser Arguments+argParser = Arguments+  <$> optional+      ( strOption+      $ long "config-dir"+     <> metavar "DIRECTORY"+     <> help "Config directory, used to store your config.dhall and some dhall source code. Default value is $XDG_CONFIG_HOME/dzen-dhall/"+      )++  <*> optional+      ( strOption+      $ long "dzen-binary"+     <> metavar "FILE"+     <> help "Path to Dzen executable. By default, 'dzen2' binary from $PATH will be used."+      )++  <*> flag ToDzen ToStdout+      ( long "stdout"+     <> help "Write output to stdout."+      )++  <*> optional+      (+        hsubparser+        ( command "init"+          ( info+            ( pure Init )+            ( progDesc "Write default configuration files to configuration directory." )+          )+       <> command "plug"+          ( info+            ( Plug <$> plugCommandParser )+            ( progDesc "Install a plugin to the `plugins` directory. Acceptable formats: `name`, `github-username/repository`, a file name or URL." )+            )+       <> command "unplug"+          ( info+            ( Unplug <$> unplugCommandParser )+            ( progDesc "Remove a plugin from plugins directory." )+          )+       <> command "validate"+          ( info+            ( Validate <$> validateCommandParser )+            ( progDesc "Validate the configuration without running it." )+          )+        )+      )++  <*> flag DontExplain Explain+      ( long "explain"+     <> help "Explain error messages in more detail."+      )+++plugCommandParser :: Parser PlugCommand+plugCommandParser =+  PlugCommand <$> argument str (metavar "PLUGIN SOURCE")+              <*> flag Confirm DontConfirm+                  ( long "yes"+                 <> help "Skip manual code review and confirmation."+                  )++unplugCommandParser :: Parser UnplugCommand+unplugCommandParser =+  UnplugCommand <$> argument str (metavar "PLUGIN NAME")++validateCommandParser :: Parser ValidateCommand+validateCommandParser =+  ValidateCommand <$> flag SkipAssertions DontSkip+                      ( long "include-assertions"+                     <> short 'a'+                     <> help "Validate assertions too (this will result in running executable code)."+                      )++argumentsParser :: ParserInfo Arguments+argumentsParser = info (argParser <**> helper)+             ( fullDesc+            <> progDesc "Configure dzen2 bars in Dhall language." )
+ src/DzenDhall/Commands/Plug.hs view
@@ -0,0 +1,334 @@+module DzenDhall.Commands.Plug where++import           DzenDhall.App+import           DzenDhall.Config+import           DzenDhall.Extra+import           DzenDhall.Runtime.Data+import           DzenDhall.Arguments (PlugCommand (..), ConfirmPlug(..))++import           Control.Applicative+import           Control.Exception hiding (try)+import           Control.Monad+import           Control.Monad.Trans.Except+import           Data.Either+import           Data.Maybe+import           Data.Text (Text)+import           Dhall+import           Dhall.Core+import           Lens.Micro+import           Network.HTTP.Client.Conduit+import           Network.HTTP.Simple+import           Network.HTTP.Types+import           Network.URI+import           Prelude+import           System.Directory+import           System.Exit+import           System.FilePath ((</>))+import qualified Data.ByteString.UTF8                      as BSU+import qualified Data.Text                                 as T+import qualified Data.Text.Encoding                        as STE+import qualified Data.Text.IO+import qualified Data.Text.Prettyprint.Doc                 as Pretty+import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty.Terminal+import qualified Dhall.Parser                              as Dhall+import qualified Dhall.Pretty+import qualified Dhall.Pretty                              as Pretty+import qualified System.IO+import qualified Text.Megaparsec                           as MP+import qualified Text.Parsec                               as P+++plugCommand :: PlugCommand -> App Common ()+plugCommand (PlugCommand spec shouldConfirm) = do++  withEither (parseSourceSpec spec) invalidSourceSpec+    \sourceSpec -> do+      rawContents <- liftIO $+        getPluginContents sourceSpec++      withMaybe (parsePlugin rawContents) (invalidFile rawContents)+        \expr -> do++          eiMeta <- readPluginMeta sourceSpec rawContents++          withEither eiMeta invalidMeta+            \meta -> do++              let pluginName = meta ^. pmName++              checkIfPluginFileExists pluginName++              when (shouldConfirm == Confirm) do+                suggestReviewing expr++                askConfirmation++              writePluginFile pluginName rawContents++              printUsage meta+++data PluginSourceSpec+  = FromGithub+  -- ^ Load from Github by username and repository+    { userName   :: String+    , repository :: String+    , revision   :: String+    }+  | FromOrg { name     :: String+            , revision :: String+            }+  -- ^ Load from @https://github.com/dzen-dhall/plugins@ by name.+  | FromURL URI+  -- ^ Load from URL+  | FromFile FilePath+  deriving (Eq, Show)+++askConfirmation :: App Common ()+askConfirmation = do++  echo =<< highlight "Are you sure you want to install this plugin? (Y/n)"++  response <- liftIO getLine+  unless (isYes response) $+    exit 1 "Aborting."+++suggestReviewing :: Expr Dhall.Src Import -> App Common ()+suggestReviewing expr = do+  echo =<< highlight "Please review the plugin code:"+  echo ""++  let expr' =+        Dhall.Pretty.prettyCharacterSet Dhall.Pretty.Unicode expr++  supportsANSI <- getRuntime <&> (^. rtSupportsANSI)++  liftIO $+    if supportsANSI+    then+      Pretty.Terminal.renderIO+      System.IO.stdout+      (fmap Pretty.annToAnsiStyle (Pretty.layoutSmart Pretty.layoutOpts expr'))+    else+      Pretty.Terminal.renderIO+      System.IO.stdout+      (Pretty.layoutSmart Pretty.layoutOpts (Pretty.unAnnotate expr'))++  echo ""+  echo =<< highlight "Please review the code above."+++printUsage :: PluginMeta -> App Common ()+printUsage meta = do+  msg <- highlight $+    "New plugin \"" <> meta ^. pmName <> "\" can now be used as follows:"+  echoLines [ msg+            , ""+            , ""+            , meta ^. pmUsage+            ]+++invalidSourceSpec :: P.ParseError -> App Common ()+invalidSourceSpec err =+  exit 1 $ fromLines+  [ "Invalid plugin source specification:"+  , ""+  , showPack err+  ]+++invalidFile :: Text -> App Common ()+invalidFile rawContents =+  exit 2 $ fromLines+  [ "Error: not a valid Dhall file:"+  , ""+  , rawContents+  ]+++httpHandler :: HttpException -> IO a+httpHandler exception = do+  Data.Text.IO.putStrLn "Exception occured while trying to load plugin source:"+  case exception of+    HttpExceptionRequest _request (StatusCodeException response _) -> do+      let status  = getResponseStatus response+          code    = getResponseStatusCode response+          message = BSU.toString $ statusMessage status+      putStrLn $ "Error: " <> show code <> ", " <> message++    _ -> print exception+  exitWith $ ExitFailure 1+++parseSourceSpec :: String -> Either P.ParseError PluginSourceSpec+parseSourceSpec spec = P.runParser sourceSpecParser () spec spec+  where++    sourceSpecParser :: P.Parsec String () PluginSourceSpec+    sourceSpecParser = ( P.try fromURL+                     <|> P.try fromGithub+                     <|> P.try fromOrg+                     <|> P.try fromFile+                       ) <* P.eof++    fromURL :: P.Parsec String () PluginSourceSpec+    fromURL = do+      anything <- P.many1 (P.satisfy (const True))+      case parseURI anything of+        Just uri -> pure $ FromURL uri+        Nothing -> P.unexpected "Not a URI"++    fromGithub :: P.Parsec String () PluginSourceSpec+    fromGithub = do+      userName <- saneIdentifier+      void $ P.char '/'+      repository <- saneIdentifier+      revision <- revisionParser+      pure $ FromGithub {..}++    fromOrg :: P.Parsec String () PluginSourceSpec+    fromOrg = do+      name <- saneIdentifier+      revision <- revisionParser+      pure $ FromOrg {..}++    fromFile :: P.Parsec String () PluginSourceSpec+    fromFile = do+      FromFile <$>+        liftM2 (:) (P.char '.' <|> P.char '/') (P.many1 $ P.satisfy (const True))++    revisionParser = P.option "master" do+      void $ P.char '@'+      P.many1 (P.alphaNum <|> P.char '-' <|> P.char '_' <|> P.char '.')+++saneIdentifier :: P.Parsec String () String+saneIdentifier = P.many1 (P.alphaNum <|> P.char '-' <|> P.char '_')+++getPluginSource :: PluginSourceSpec -> String+getPluginSource FromGithub{userName, repository, revision} =+  "https://raw.githubusercontent.com/" <> userName+  <> "/" <> repository+  <> "/" <> revision+  <> "/plugin.dhall"+getPluginSource (FromOrg { name, revision }) =+  "https://raw.githubusercontent.com/dzen-dhall/plugins/" <> revision+  <> "/" <> name+  <> "/plugin.dhall"+getPluginSource (FromURL url) = do+  uriToString id url ""+getPluginSource (FromFile filePath) =+  filePath+++getPluginContents :: PluginSourceSpec -> IO Text+getPluginContents (FromFile filePath)  =+  Data.Text.IO.readFile filePath+getPluginContents other =+  getPluginContentsFromURL $ getPluginSource other+++-- | Load plugin from URL and validate it by parsing.+getPluginContentsFromURL :: String -> IO Text+getPluginContentsFromURL url = handle httpHandler do++  req <- parseUrlThrow url+  res <- httpBS req++  let body     = getResponseBody res+      contents = STE.decodeUtf8 body++  pure contents+++-- | Try parsing a file.+parsePlugin :: Text -> Maybe (Expr Dhall.Src Import)+parsePlugin =+  MP.parseMaybe (Dhall.unParser Dhall.expr)+++data MetaValidationError+  = NoParse+  | InvalidPluginName Text+++instance Show MetaValidationError where+  show NoParse =+    "No parse. This plugin is either malformed or was written for another API version. (current API version: " <> show apiVersion <> ")"++  show (InvalidPluginName pluginName) =+    "Plugin name must be a valid Dhall identifier: " <> T.unpack pluginName+++invalidMeta :: MetaValidationError -> App stage ()+invalidMeta err = do+  exit 2 (showPack err)+++-- | Try to load plugin meta by inserting a plugin into the current environment+-- (using 'inputWithSettings').+readPluginMeta :: PluginSourceSpec -> Text -> App Common (Either MetaValidationError PluginMeta)+readPluginMeta sourceSpec contents = do+  dhallDir <- getRuntime <&> (^. rtConfigDir)++  -- A dirty hack - we just access the `meta` field, discarding `main`+  -- so that there is no need to deal with its type.+  let metaBody      = "(" <> contents <> ").meta"+      inputSettings =+        defaultInputSettings &+        rootDirectory .~ (dhallDir </> "plugins") &+        sourceName    .~ getPluginSource sourceSpec+++  -- TODO: convert exception to `NoParse`+  meta <- explained $ inputWithSettings inputSettings pluginMetaType metaBody++  let name          = meta ^. pmName+      parseResult   = P.runParser saneIdentifier () "Plugin name" (T.unpack name)++  liftIO $ runExceptT do++    -- TODO: add more validations++    unless (isRight parseResult) do+      throwE (InvalidPluginName name)++    pure meta+++checkIfPluginFileExists :: Text -> App Common ()+checkIfPluginFileExists pluginName = do+  (pluginsDir, pluginFile) <- getPluginPaths pluginName++  dirExists <- liftIO $ doesDirectoryExist pluginsDir++  unless dirExists do+    exit 1 $+      "Directory " <> T.pack pluginsDir <> " does not exist! Run `dzen-dhall init` first."++  fileExists <- liftIO $ doesFileExist pluginFile++  when fileExists do+    exit 1 $+      "File " <> T.pack pluginFile <> " already exists."+++writePluginFile :: Text -> Text -> App Common ()+writePluginFile pluginName contents = do+  pluginFile <- snd <$> getPluginPaths pluginName+  liftIO $ Data.Text.IO.writeFile pluginFile contents+++-- | Given a plugin name, get the file of the plugin and locate the plugins directory.+getPluginPaths :: Text -> App Common (String, String)+getPluginPaths pluginName = do+  dhallDir <- getRuntime <&> (^. rtConfigDir)++  let pluginsDir = dhallDir </> "plugins"+      pluginFile = pluginsDir </> T.unpack pluginName <> ".dhall"++  pure (pluginsDir, pluginFile)
+ src/DzenDhall/Commands/Unplug.hs view
@@ -0,0 +1,54 @@+module DzenDhall.Commands.Unplug where++import           DzenDhall.App+import           DzenDhall.Extra+import           DzenDhall.Arguments+import qualified DzenDhall.Commands.Plug as Plug++import           Control.Applicative+import           Control.Monad+import           Data.Text (Text)+import           Prelude+import           System.Directory (removeFile)+import qualified Data.Text as T+import qualified Text.Parsec as P+++unplugCommand :: UnplugCommand -> App Common ()+unplugCommand (UnplugCommand argument) = do++  let parseResult =+        T.pack <$> P.runParser Plug.saneIdentifier () "Plugin name" argument++  withEither parseResult+    invalidPluginName+    \pluginName -> do++      Plug.checkIfPluginFileExists pluginName++      echo =<< highlight "Are you sure you want to remove this plugin? (Y/n)"++      response <- liftIO getLine++      unless (isYes response) do+        exit 1 "Aborting."++      deletePluginFile pluginName++      echo =<< highlight+        "Success! You should delete all references of this plugin from your config file."+++invalidPluginName :: P.ParseError -> App Common ()+invalidPluginName err =+  exit 1 $ fromLines+  [ "Invalid plugin name"+  , ""+  , showPack err+  ]+++deletePluginFile :: Text -> App Common ()+deletePluginFile pluginName = do+  pluginFile <- snd <$> Plug.getPluginPaths pluginName+  liftIO $ removeFile pluginFile
+ src/DzenDhall/Commands/Validate.hs view
@@ -0,0 +1,49 @@+module DzenDhall.Commands.Validate where++import           DzenDhall.App+import           DzenDhall.App as App+import           DzenDhall.Arguments+import           DzenDhall.Config+import           DzenDhall.Extra+import           DzenDhall.Runtime.Data+import qualified DzenDhall.Parser as Parser+import qualified DzenDhall.Validation as Validation++import           Control.Monad+import           Lens.Micro+import           Lens.Micro.Extras++validateCommand :: ValidateCommand -> App Common ()+validateCommand (ValidateCommand skipAssertions) = do+  runtime <- App.getRuntime++  forM_ (view rtConfigurations runtime) \cfg -> do++    let barTokens = cfg ^. cfgBarTokens++    when (skipAssertions == DontSkip) do+      assertionErrors <- liftIO do+        Validation.checkAssertions barTokens++      unless (null assertionErrors) do+        App.exit 3 $ Validation.report assertionErrors++    let errors = Validation.validate barTokens++    unless (null errors) do+      App.exit 3 $ Validation.report errors++    let parseResult =+          Parser.runBarParser $+          Validation.filterOutAssertions barTokens++    whenLeft parseResult+      (exitWithError barTokens)++exitWithError :: Show a => [Token] -> a -> App Common b+exitWithError barTokens err =+  App.exit 3 $ fromLines+  [ "Internal error when parsing configuration, debug info: " <> showPack barTokens+  , "Error: " <> showPack err+  , "Please report as bug."+  ]
+ src/DzenDhall/Config.hs view
@@ -0,0 +1,463 @@+{-# LANGUAGE TemplateHaskell #-}+-- | Data types for marshalling dhall configs into Haskell.+module DzenDhall.Config where++import qualified Data.HashMap.Strict as H+import           Data.Hashable+import           Data.Text (Text)+import           Dhall+import           Lens.Micro.TH+import           Lens.Micro (Lens', _1)++import           DzenDhall.Extra+++type AutomatonState = Text++stateType :: Type AutomatonState+stateType = union $ constructor "State" strictText++type AutomatonAddress = Text++automatonAddressType :: Type AutomatonAddress+automatonAddressType = union $ constructor "Address" strictText++type Scope            = Text+type VariableName     = Text+type Value            = Text+type ImageContents    = Text+type ImageId          = Text++data Marquee+  = Marquee+  { _mqFramesPerChar :: Int+  , _mqWidth         :: Int+  , _mqShouldWrap      :: Bool+  }+  deriving (Show, Eq, Generic)++makeLenses ''Marquee++marqueeType :: Type Marquee+marqueeType = record $+  Marquee <$> field "framesPerCharacter" (positive    . fromIntegral <$> natural)+          <*> field "width"              (nonNegative . fromIntegral <$> natural)+          <*> field "shouldWrap"         bool++data Direction+  = DLeft | DRight+  deriving (Show, Eq, Generic)++directionType :: Type Direction+directionType = union+  $  (DLeft  <$ constructor "Left"   unit)+  <> (DRight <$ constructor "Right" unit)++data VerticalDirection+  = VUp | VDown+  deriving (Show, Eq, Generic)++verticalDirectionType :: Type VerticalDirection+verticalDirectionType = union+  $  (VUp   <$ constructor "Up"   unit)+  <> (VDown <$ constructor "Down" unit)++data Assertion+  = BinaryInPath Text+  | SuccessfulExit Text+  deriving (Show, Eq, Generic)++assertionType :: Type Assertion+assertionType = union+  $  (BinaryInPath    <$> constructor "BinaryInPath" strictText)+  <> (SuccessfulExit  <$> constructor "SuccessfulExit"  strictText)++data Check+  = Check { _chMessage :: Text+          , _chAssertion :: Assertion+          }+  deriving (Show, Eq, Generic)++makeLenses ''Check++checkType :: Type Check+checkType = record $+  Check <$> field "message"   strictText+        <*> field "assertion" assertionType++data Button+  = MouseLeft+  | MouseMiddle+  | MouseRight+  | MouseScrollUp+  | MouseScrollDown+  | MouseScrollLeft+  | MouseScrollRight+  deriving (Show, Eq, Ord, Generic)++instance Hashable Button++buttonType :: Type Button+buttonType = union+  $  (MouseLeft        <$ constructor "Left"        unit)+  <> (MouseMiddle      <$ constructor "Middle"      unit)+  <> (MouseRight       <$ constructor "Right"       unit)+  <> (MouseScrollUp    <$ constructor "ScrollUp"    unit)+  <> (MouseScrollDown  <$ constructor "ScrollDown"  unit)+  <> (MouseScrollLeft  <$ constructor "ScrollLeft"  unit)+  <> (MouseScrollRight <$ constructor "ScrollRight" unit)++newtype Event+  = Event Text+  deriving (Show, Eq, Ord, Generic)++instance Hashable Event++eventType :: Type Event+eventType = union $ (Event <$> constructor "Event" strictText)++data Fade+  = Fade+  { _fadeDirection   :: VerticalDirection+  , _fadeFrameCount  :: Int+  , _fadePixelHeight :: Int+  }+  deriving (Show, Eq, Generic)++makeLenses ''Fade++fadeType :: Type Fade+fadeType = record $+  Fade <$> field "direction"  verticalDirectionType+       <*> field "frameCount" (fromIntegral <$> natural)+       <*> field "height"     (fromIntegral <$> natural)++data Slider+  = Slider+  { _fadeIn      :: Fade+  , _fadeOut     :: Fade+  , _sliderDelay :: Int++  }+  deriving (Show, Eq, Generic)++makeLenses ''Slider++sliderType :: Type Slider+sliderType = record $+  Slider <$> field "fadeIn"  fadeType+         <*> field "fadeOut" fadeType+         <*> field "delay"   (fromIntegral <$> natural)++data Hook+  = Hook+  { _hookCommand          :: [Text]+  , _hookInput            :: Text+  }+  deriving (Show, Eq, Generic)++makeLenses ''Hook++hookType :: Type Hook+hookType = record $+  Hook <$> field "command"          (list strictText)+       <*> field "input"            strictText++newtype StateTransitionTable+  = STT { unSTT :: H.HashMap (Scope, Event, AutomatonState) (AutomatonState, [Hook])+        }+  deriving (Show, Eq, Generic)++stateTransitionTableType :: Type StateTransitionTable+stateTransitionTableType = STT . H.fromList . concatMap collect <$> list+  ( record+    ( pack5 <$> field "events" (list eventType)+            <*> field "from"   (list stateType)+            <*> field "to"     stateType+            <*> field "hooks"  (list hookType)+    )+  )+  where+    pack5 events froms to hooks = (events, froms, to, hooks)++    collect (events, froms, to, hooks) =++      [ (("", event, from), (to, hooks))+      --        ^ scope is left uninitialized. It will be added later+      | event <- events+      , from <- froms+      ]++_scope :: Lens' (Scope, Event, AutomatonState) Scope+_scope = _1++newtype Color = Color Text+  deriving (Show, Eq, Generic)++colorType :: Type Color+colorType = Color <$> strictText++data AbsolutePosition+  = AbsolutePosition { _apX :: Int, _apY :: Int }+  deriving (Show, Eq, Generic)++makeLenses ''AbsolutePosition++absolutePositionType :: Type AbsolutePosition+absolutePositionType = record $+  AbsolutePosition <$> field "x" (fromIntegral <$> integer)+                   <*> field "y" (fromIntegral <$> integer)+++{- | Specify position that will be passed to @^p()@. -}+data Position =+  -- | @^p(+-X;+-Y)@      - move X pixels to the right or left and Y pixels up or down of the current+  --                      position (on the X and Y axis).+  XY (Int, Int) |+  -- | @^p()@             - Reset the Y position to its default.+  P_RESET_Y |+  -- | @_LOCK_X@          - Lock the current X position, useful if you want to align things vertically+  P_LOCK_X |+  -- | @_UNLOCK_X@        - Unlock the X position+  P_UNLOCK_X |+  -- | @_LEFT@            - Move current x-position to the left edge+  P_LEFT |+  -- | @_RIGHT@           - Move current x-position to the right edge+  P_RIGHT |+  -- | @_TOP@             - Move current y-position to the top edge+  P_TOP |+  -- | @_CENTER@          - Move current x-position to the center of the window+  P_CENTER |+  -- | @_BOTTOM@          - Move current y-position to the bottom edge+  P_BOTTOM+  deriving (Show, Eq, Generic)++positionType :: Type Position+positionType = union+  $  (XY           <$> constructor "XY"        xy)+  <> (P_RESET_Y    <$  constructor "_RESET_Y"  unit)+  <> (P_LOCK_X     <$  constructor "_LOCK_X"   unit)+  <> (P_UNLOCK_X   <$  constructor "_UNLOCK_X" unit)+  <> (P_LEFT       <$  constructor "_LEFT"     unit)+  <> (P_RIGHT      <$  constructor "_RIGHT"    unit)+  <> (P_TOP        <$  constructor "_TOP"      unit)+  <> (P_CENTER     <$  constructor "_CENTER"   unit)+  <> (P_BOTTOM     <$  constructor "_BOTTOM"   unit)+  where+    xy = record ((,) <$> (fromIntegral <$> field "x" integer)+                     <*> (fromIntegral <$> field "y" integer))+data ClickableArea+  = ClickableArea { _caButton :: Button+                  , _caCommand :: Text+                  }+  deriving (Show, Eq, Generic)++makeLenses ''ClickableArea++clickableAreaType :: Type ClickableArea+clickableAreaType = record $+  ClickableArea <$> field "button"  buttonType+                <*> field "command" strictText++data Padding+  = PLeft+  | PRight+  | PSides+  deriving (Show, Eq, Generic)++paddingType :: Type Padding+paddingType = union+  $  (PLeft  <$ constructor "Left"  unit)+  <> (PRight <$ constructor "Right" unit)+  <> (PSides <$ constructor "Sides" unit)++data OpeningTag+  = OMarquee     Marquee+  | OSlider      Slider+  | OFG          Color+  | OBG          Color+  | OP           Position+  | OPA          AbsolutePosition+  | OCA          ClickableArea+  | OIB+  | OPadding     Int  Padding+  | OTrim        Int  Direction+  | OAutomaton   AutomatonAddress StateTransitionTable+  | OStateMapKey Text+  | OScope+  deriving (Show, Eq, Generic)++openingTagType :: Type OpeningTag+openingTagType = union+  $  (OMarquee     <$> constructor "Marquee"     marqueeType)+  <> (OSlider      <$> constructor "Slider"      sliderType)+  <> (OFG          <$> constructor "FG"          colorType)+  <> (OBG          <$> constructor "BG"          colorType)+  <> (OP           <$> constructor "P"           positionType)+  <> (OPA          <$> constructor "PA"          absolutePositionType)+  <> (OCA          <$> constructor "CA"          clickableAreaType)+  <> (OIB          <$  constructor "IB"          unit)++  <> (uncurry OPadding   <$> constructor "Padding"+       ( record $ (,) <$> field "width"   (fromIntegral <$> natural)+                      <*> field "padding" paddingType+       )+     )++  <> (uncurry OTrim      <$> constructor "Trim"+       ( record $ (,) <$> field "width"     (fromIntegral <$> natural)+                      <*> field "direction" directionType+       )+     )++  <> (uncurry OAutomaton <$> constructor "Automaton"+       ( record $ (,) <$> field "address"  automatonAddressType+                      <*> field "stt"      stateTransitionTableType+       )+     )++  <> (OStateMapKey <$> constructor "StateMapKey" stateType)+  <> (OScope       <$  constructor "Scope"       unit)++data BarSettings+  = BarSettings+  { _bsMonitor :: Int+  -- ^ Xinerama monitor number+  , _bsExtraArgs     :: [String]+  -- ^ Extra args to pass to dzen binary+  , _bsUpdateInterval :: Int+  -- ^ In microseconds+  , _bsFont           :: Maybe String+  -- ^ Font in XLFD format+  , _bsFontWidth      :: Int+  }+  deriving (Show, Eq, Generic)++makeLenses ''BarSettings++barSettingsType :: Type BarSettings+barSettingsType = record $+  BarSettings <$> field "monitor"        (fromIntegral <$> natural)+              <*> field "extraArgs"      (list string)+              <*> field "updateInterval" ((* 1000) . fromIntegral <$> natural)+              <*> field "font"           (Dhall.maybe string)+              <*> field "fontWidth"      (fromIntegral <$> natural)+++data ShapeSize+  = ShapeSize { _shapeSizeW :: Int, _shapeSizeH :: Int }+  deriving (Show, Eq, Generic)++makeLenses ''ShapeSize++shapeSizeType :: Type ShapeSize+shapeSizeType = record $+  ShapeSize <$> field "w" (fromIntegral <$> natural)+            <*> field "h" (fromIntegral <$> natural)++data Variable+  = Variable { _varName  :: Text+             , _varValue :: Text+             }+  deriving (Show, Eq, Generic)++makeLenses ''Variable++variableType :: Type Variable+variableType = record $+  Variable <$> field "name"  strictText+           <*> field "value" strictText++data Token+  = TokOpen OpeningTag+  | TokClose+  | TokSeparator+  | TokTxt Text+  | TokSource Source+  | TokMarkup Text+  | TokI Text+  | TokR ShapeSize+  | TokRO ShapeSize+  | TokC Int+  | TokCO Int+  | TokCheck Check+  | TokDefine Variable+  deriving (Show, Eq, Generic)++tokenType :: Type Token+tokenType = union+  $  (TokOpen      <$> constructor "Open"      openingTagType)+  <> (TokClose     <$  constructor "Close"     unit)+  <> (TokSeparator <$  constructor "Separator" unit)+  <> (TokTxt       <$> constructor "Txt"       strictText)+  <> (TokSource    <$> constructor "Source"    sourceSettingsType)+  <> (TokMarkup    <$> constructor "Markup"    strictText)+  <> (TokI         <$> constructor "I"         strictText)+  <> (TokR         <$> constructor "R"         shapeSizeType)+  <> (TokRO        <$> constructor "RO"        shapeSizeType)+  <> (TokC         <$> constructor "C"         (fromIntegral <$> natural))+  <> (TokCO        <$> constructor "CO"        (fromIntegral <$> natural))+  <> (TokCheck     <$> constructor "Check"     checkType)+  <> (TokDefine    <$> constructor "Define"    variableType)++stateMapType :: Type (H.HashMap Text [Token])+stateMapType = H.fromList <$>+  list (record $+         (,) <$> field "state" strictText+             <*> field "bar"   (list tokenType))++data Source+  = Source+  { updateInterval :: Maybe Int+  -- ^ In microseconds+  , command        :: [String]+  , input          :: Text+  , escape         :: Bool+  } deriving (Show, Eq, Generic)++instance Hashable Source++sourceSettingsType :: Type Source+sourceSettingsType = record $+  Source <$> field "updateInterval" (Dhall.maybe $ (* 1000) . fromIntegral <$> natural)+         <*> field "command"        (list string)+         <*> field "input"          strictText+         <*> field "escape"         bool++data Configuration = Configuration+  { _cfgBarTokens   :: [Token]+  , _cfgBarSettings :: BarSettings+  }+  deriving (Show, Eq, Generic)++makeLenses ''Configuration++configurationType :: Type Configuration+configurationType = record $+  Configuration <$> field "bar"      (list tokenType)+                <*> field "settings" barSettingsType++data PluginMeta = PluginMeta+  { _pmName             :: Text+  , _pmAuthor           :: Text+  , _pmEmail            :: Maybe Text+  , _pmHomePage         :: Maybe Text+  , _pmUpstream         :: Maybe Text+  , _pmDescription      :: Text+  , _pmUsage            :: Text+  , _pmApiVersion       :: Int+  }+  deriving (Show, Eq, Generic)++makeLenses ''PluginMeta++pluginMetaType :: Type PluginMeta+pluginMetaType = record $+  PluginMeta <$> field "name"             strictText+             <*> field "author"           strictText+             <*> field "email"            (Dhall.maybe strictText)+             <*> field "homepage"         (Dhall.maybe strictText)+             <*> field "upstream"         (Dhall.maybe strictText)+             <*> field "description"      strictText+             <*> field "usage"            strictText+             <*> field "apiVersion"       (fromIntegral <$> natural)
+ src/DzenDhall/Data.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+module DzenDhall.Data where++import           Data.IORef+import           Data.Text (Text)+import           Data.Vector+import           Data.Void+import           DzenDhall.Config+import           GHC.Generics+import           Lens.Micro.TH+import qualified Data.HashMap.Strict as H++type Cache = IORef (Maybe Text)++data SourceHandle+  = SourceHandle+  { _shOutputRef :: IORef Text+  , _shCacheRef :: Cache+  , _shEscape :: Bool+  }++makeLenses ''SourceHandle++data Bar id+  = BarAutomaton Text (StateTransitionTableX id) (AutomataRefX id (Bar id))+  | BarPad Int Padding (Bar id)+  | BarTrim Int Direction (Bar id)+  | BarMarquee Marquee (Bar id)+  | BarProp Property (Bar id)+  | BarMarkup Text+  | BarScope (Bar id)+  | BarShape Shape+  | BarSlider Slider (Vector (Bar id))+  | BarSource (SourceRefX id)+  | BarText Text+  | BarDefine Variable+  | Bars [Bar id]+  deriving (Generic)++type family AutomataRefX          id :: * -> *+type family StateTransitionTableX id+type family SourceRefX            id++newtype Initialized = Initialized Void+newtype Marshalled  = Marshalled  Void++type instance AutomataRefX          Marshalled = H.HashMap Text+type instance StateTransitionTableX Marshalled = StateTransitionTable+type instance SourceRefX            Marshalled = Source++type instance AutomataRefX          Initialized = IORef+type instance StateTransitionTableX Initialized = ()+type instance SourceRefX            Initialized = SourceHandle++deriving instance Show (Bar Marshalled)+deriving instance Eq   (Bar Marshalled)++instance Semigroup (Bar id) where+  a <> b = Bars [a, b]++instance Monoid (Bar id) where+  mempty = Bars []++data Property+  = BG Color+  | IB+  | FG Color+  | CA ClickableArea+  | P Position+  | PA AbsolutePosition+  deriving (Eq, Show, Generic)++type Handler = Text+type ImagePath = Text++data Shape+  = I ImagePath+  | R Int Int+  | RO Int Int+  | C Int+  | CO Int+  deriving (Eq, Show, Generic)
+ src/DzenDhall/Event.hs view
@@ -0,0 +1,260 @@+module DzenDhall.Event where++import           DzenDhall.AST.Render (runRender)+import           DzenDhall.App+import           DzenDhall.Config+import           DzenDhall.Extra+import           DzenDhall.Runtime.Data++import           Control.Concurrent+import           Control.Exception+import           Control.Monad+import           Control.Monad.Trans.Class+import           Control.Monad.Trans.Maybe+import           Data.IORef+import           Data.Maybe+import           Data.Text (Text)+import           Data.Void+import           Lens.Micro+import           Pipes hiding (liftIO)+import           System.Environment+import           System.Exit+import           System.IO+import           System.Process+import           Text.Megaparsec+import           Text.Megaparsec.Char+import           Text.Read (readMaybe)+import qualified Data.HashMap.Strict as H+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Pipes.Prelude as P+++data PipeCommand+  = RoutedEvent Event Scope+  | Click Scope Int+  deriving (Eq, Show)++-- | Start reading lines from a named pipe used to route events.+-- On each event, try to parse it, and find which event subscriptions does the event affect.+launchEventListener :: Subscriptions -> ClickableAreas -> App Forked ()+launchEventListener subscriptions clickableAreas = do+  barRuntime <- get++  let+    namedPipe = barRuntime ^. brNamedPipe++    handler (e :: IOError) = do+      putStrLn $ "Couldn't open named pipe " <> namedPipe <> ": " <> displayException e+      exitWith (ExitFailure 1)++  environment <- liftIO getEnvironment+++  liftIO $ runEffect $ do++    fh <- lift $ handle handler $ do+      fh <- openFile namedPipe ReadWriteMode+      hSetBuffering fh LineBuffering+      pure fh++    for (P.fromHandle fh) \line -> do+      lift $ do++        case parsePipeCommand line of++          Just (RoutedEvent event scope) ->+            case H.lookup scope subscriptions of+              Just scopeSubscriptions -> do+                processSubscriptions barRuntime scope event scopeSubscriptions++              Nothing ->+                T.putStrLn $+                "Failed to find subscriptions for scope: " <> scope++          Just (Click scope identifier) -> do+            whenJust (H.lookup identifier clickableAreas) $+              \command -> do+                void $ forkIO $ do++                  let emitter =+                        barRuntime ^. brEmitterScript <> " " <> T.unpack scope+                      getter =+                        barRuntime ^. brGetterScript  <> " " <> T.unpack scope+                      setter =+                        barRuntime ^. brSetterScript  <> " " <> T.unpack scope++                  let process =+                        (shell $ T.unpack command)+                        { env = Just $+                          [ ("EMIT", emitter)+                          , ("GET",  getter)+                          , ("SET",  setter)+                          ] <>+                          environment+                        }++                  void $ readCreateProcess process ""++          Nothing ->+            putStrLn $ "Failed to parse routed event from string: " <> line+++processSubscriptions :: BarRuntime -> Scope -> Event -> [Subscription] -> IO ()+processSubscriptions barRuntime scope event subscriptions = do++  environment <- getEnvironment++  forM_ subscriptions \case++    AutomatonSubscription address stt stateMap stateRef barRef -> do++      currentState <- readIORef stateRef++      let+        transitions =+          unSTT stt :: H.HashMap (Scope, Event, Text) (Text, [Hook])+        mbNext =+          H.lookup (scope, event, currentState) transitions <|>+          -- Match "any" event.+          H.lookup (scope, Event "*", currentState) transitions++      whenJust mbNext \(nextState, hooks) -> void $ forkIO $ do++        let environment' =+              [ ( "EVENT"  , T.unpack $ runRender event)+              , ( "CURRENT_STATE", T.unpack currentState)+              , ( "NEXT_STATE"   , T.unpack nextState) ]+              <> environment++        mbUnit <- runMaybeT (runHooks environment' barRuntime scope hooks)++        case H.lookup nextState stateMap of++          Nothing -> do+            -- TODO: make this error static+            T.putStrLn $ "Didn't find state " <> showPack nextState+              <> " in the state map for " <> showPack address++          Just nextBar -> do+            -- Multiple state transitions are executed simultaneously.+            -- This is fine, we don't want to eliminate race conditions.+            -- Somethimes a transition is only added for its outside-world effects,+            -- and we can't distinguish between such a transition and a normal one.++            when (isJust mbUnit) $ do+              writeIORef barRef nextBar+              writeIORef stateRef nextState+              runStateVariableSetter barRuntime scope address nextState++-- | Set a variable named `STATE_address`+runStateVariableSetter :: BarRuntime -> Scope -> AutomatonAddress -> AutomatonState -> IO ()+runStateVariableSetter barRuntime scope address state = do+  let process = shell $+        barRuntime ^. brSetterScript <> " " <>+        T.unpack scope <>+        " STATE_" <> T.unpack address <> " " <>+        T.unpack state++  (exitCode, _stdOut, _stdErr) <- readCreateProcessWithExitCode process ""++  when (exitCode /= ExitSuccess) $+    putStrLn "Setter script exited unsuccessfully. Please report as bug."++runHooks+  :: [(String, String)]+  -> BarRuntime+  -> Scope+  -> [Hook]+  -> MaybeT IO ()+runHooks environment barRuntime scope hooks = do+  forM_ hooks \hook -> do++    let binary = T.unpack $+          head $ hook ^. hookCommand+          -- ^ this is safe, because we checked the list for emptiness+          -- during validation.+        args   = map T.unpack $+          tail $ hook ^. hookCommand+        input  = hook ^. hookInput++        emitter =+          barRuntime ^. brEmitterScript <> " " <> T.unpack scope+        getter =+          barRuntime ^. brGetterScript  <> " " <> T.unpack scope+        setter =+          barRuntime ^. brSetterScript  <> " " <> T.unpack scope++        process =+          (proc binary args) { std_out = CreatePipe+                             , std_in  = CreatePipe+                             , std_err = CreatePipe+                             , env = Just $+                               [ ("EMIT", emitter)+                               , ("SET",  setter)+                               , ("GET",  getter)+                               ] <> environment+                             }++    (exitCode, _stdOut, _stdErr) <- lift $+      readCreateProcessWithExitCode process (T.unpack input)+    when (exitCode /= ExitSuccess) $+      throwMaybe+++parsePipeCommand :: String -> Maybe PipeCommand+parsePipeCommand = parseMaybe (routedEventParser <|> clickParser)++type Parser = Parsec Void String++-- | E.g.+--+-- @+-- parseMaybe routedEventParser+--   "event:MouseLeft@some-scope" ==+--      Just (RoutedEvent (MouseEvent MouseLeft) "some-scope")+-- @+routedEventParser :: Parser PipeCommand+routedEventParser = do+  void $ string "event:"+  event <- Event <$> eventParser+  void $ char '@'+  scope <- scopeParser+  pure $ RoutedEvent event scope++buttonParser :: Parser Button+buttonParser =+  -- Names are for the user, numbers are used to actually render buttons before+  -- feeding the output to dzen.+      MouseLeft        <$ (string "MouseLeft"        <|> string "1")+  <|> MouseMiddle      <$ (string "MouseMiddle"      <|> string "2")+  <|> MouseRight       <$ (string "MouseRight"       <|> string "3")+  <|> MouseScrollUp    <$ (string "MouseScrollUp"    <|> string "4")+  <|> MouseScrollDown  <$ (string "MouseScrollDown"  <|> string "5")+  <|> MouseScrollLeft  <$ (string "MouseScrollLeft"  <|> string "6")+  <|> MouseScrollRight <$ (string "MouseScrollRight" <|> string "7")++automatonAddressParser :: Parser Text+automatonAddressParser = capitalized++eventParser :: Parser Text+eventParser = camelCased++capitalized :: Parser Text+capitalized = T.pack <$>+  liftM2 (:) upperChar (many (upperChar <|> digitChar <|> char '_'))++camelCased :: Parser Text+camelCased = T.pack <$>+  liftM2 (:) upperChar (many (alphaNumChar <|> char '_'))++scopeParser :: Parser Text+scopeParser = T.pack <$> some (alphaNumChar <|> char '-')++clickParser :: Parser PipeCommand+clickParser = do+  void $ string "click:"+  identifier <- some digitChar+  void $ string "@"+  scope <- scopeParser+  pure $ Click scope $ fromMaybe 0 $ readMaybe identifier
+ src/DzenDhall/Extra.hs view
@@ -0,0 +1,92 @@+module DzenDhall.Extra where++import           Control.Monad+import           Control.Monad.Trans.Maybe+import           Control.Monad.Trans.Except+import qualified Data.List+import           Data.Maybe (catMaybes)+import qualified Data.Text+import           Data.Text (Text)+import           Time.Types+import           System.Directory (findExecutable)+import           Control.Concurrent.MVar+import           Foreign.StablePtr+++nonNegative :: (Num a, Ord a) => a -> a+nonNegative x+  | x < 0 = 0+  | otherwise = x++positive :: Int -> Int+positive x+  | x < 1 = 1+  | otherwise = x++spaces :: Int -> Text+spaces w = Data.Text.justifyRight w ' ' ""++showPack :: Show a => a -> Text+showPack = Data.Text.pack . show++loopWhileM :: Monad m => m Bool -> m () -> m ()+loopWhileM pr act = do+    b <- pr+    when b do+      act+      loopWhileM pr act++whenJust :: (Monad m, Monoid b) => Maybe a -> (a -> m b) -> m b+whenJust = flip $ maybe (return mempty)++leftToJust :: Either a b -> Maybe a+leftToJust (Left a) = Just a+leftToJust _ = Nothing++withMaybe :: Maybe a -> b -> (a -> b) -> b+withMaybe mb b f = maybe b f mb++withEither :: Either a b -> (a -> c) -> (b -> c) -> c+withEither ei l r = either l r ei++whenLeft :: (Monad m, Monoid b) => Either a b -> (a -> m b) -> m b+whenLeft e f = whenJust (leftToJust e) f++safeHead :: [a] -> Maybe a+safeHead = fmap fst . Data.List.uncons++safeTail :: [a] -> Maybe [a]+safeTail = fmap snd . Data.List.uncons++fromLines :: [Text] -> Text+fromLines = Data.Text.intercalate "\n"++hush :: Either e a -> Maybe a+hush (Left _) = Nothing+hush (Right a) = Just a++throwMaybe :: Monad m => MaybeT m a+throwMaybe = exceptToMaybeT (throwE ())++-- This is a workaround,+-- see https://github.com/vincenthz/hs-hourglass/issues/32+addElapsedP :: ElapsedP -> ElapsedP -> ElapsedP+addElapsedP (ElapsedP e1 (NanoSeconds ns1)) (ElapsedP e2 (NanoSeconds ns2)) =+    let notNormalizedNS = ns1 + ns2+        (retainedNS, ns) = notNormalizedNS `divMod` 1000000000+    in  ElapsedP (e1 + e2 + (Elapsed $ Seconds retainedNS)) (NanoSeconds ns)++-- | Returns a list of executables that are not present in PATH.+checkExecutables :: [String] -> IO [String]+checkExecutables executables = do+  fmap catMaybes $ forM executables \executable ->+    maybe (Just executable) (const Nothing) <$> findExecutable executable++isYes :: String -> Bool+isYes response = response `elem` ["Y", "y", "Yes", "yes", ""]++waitForever :: IO ()+waitForever = do+  m <- newEmptyMVar+  _ <- newStablePtr m+  takeMVar m
+ src/DzenDhall/Parser.hs view
@@ -0,0 +1,163 @@+{-# OPTIONS -Wno-name-shadowing #-}+module DzenDhall.Parser where++import Data.Text+import DzenDhall.Config+import DzenDhall.Data+import Text.Parsec.Combinator+import Text.Parsec.Prim+import Text.Parsec+import qualified Data.HashMap.Strict as H+import qualified Data.Vector as V+import           Lens.Micro++type Parser a = Parsec Tokens () a++type Tokens = [DzenDhall.Config.Token]++-- | Used to tag bar elements that require a list of children.+-- These lists of children are parsed using 'sepBy' with 'TokSeparator' as a delimiter.+newtype Separatable = SepSlider Slider++-- | Used to tag bar elements that require a single child.+data Solid+  = SolidMarquee Marquee+  | SolidFG Color+  | SolidBG Color+  | SolidP Position+  | SolidPA AbsolutePosition+  | SolidCA ClickableArea+  | SolidIB+  | SolidPadding Int Padding+  | SolidTrim Int Direction+  | SolidScope++runBarParser :: Tokens -> Either ParseError (Bar Marshalled)+runBarParser = Text.Parsec.runParser bar () "Bar"++bar :: Parser (Bar Marshalled)+bar = topLevel <* eof++topLevel :: Parser (Bar Marshalled)+topLevel = fmap Bars $ many $+      BarMarkup <$> markup+  <|> BarText   <$> text+  <|> BarSource <$> source+  <|> BarShape  <$> shape+  <|> BarDefine <$> variable+  <|> wrapped+  <|> separated+  <|> automaton++separated :: Parser (Bar Marshalled)+separated = do+  tag <- separatable+  children <- topLevel `sepBy` separator+  closing+  pure $+    case tag of+      SepSlider slider -> BarSlider slider (V.fromList children)++wrapped :: Parser (Bar Marshalled)+wrapped = do+  tag      <- solid+  child <- topLevel+  closing+  pure $+    case tag of+      SolidMarquee settings -> BarMarquee  settings      child+      SolidFG color         -> BarProp     (FG color)    child+      SolidBG color         -> BarProp     (BG color)    child+      SolidP position       -> BarProp     (P position)  child+      SolidPA position      -> BarProp     (PA position) child+      SolidCA ca            -> BarProp     (CA ca)       child+      SolidIB               -> BarProp     IB            child+      SolidPadding width padding+                            -> BarPad width padding      child+      SolidTrim width direction+                            -> BarTrim width direction   child+      SolidScope            -> BarScope                  child++automaton :: Parser (Bar Marshalled)+automaton = do+  (address, stt) <- stateTransitionTable+  kvs <- many $ do+    smk <- stateMapKey+    bar <- topLevel+    closing+    pure (smk, bar)+  closing+  pure $ BarAutomaton address stt $ H.fromList kvs++stateTransitionTable :: Parser (Text, StateTransitionTable)+stateTransitionTable = withPreview \case+  TokOpen (OAutomaton address stt) -> Just (address, stt)+  _                                -> Nothing++stateMapKey :: Parser Text+stateMapKey = withPreview \case+  TokOpen (OStateMapKey key) -> Just key+  _                          -> Nothing++separatable :: Parser Separatable+separatable = withPreview \case+  TokOpen (OSlider slider) -> Just (SepSlider slider)+  _                        -> Nothing++separator :: Parser ()+separator = withPreview \case+  TokSeparator -> Just ()+  _            -> Nothing++solid :: Parser Solid+solid = withPreview \case+  TokOpen (OMarquee marquee) -> Just $ SolidMarquee marquee+  TokOpen (OFG color)        -> Just $ SolidFG color+  TokOpen (OBG color)        -> Just $ SolidBG color+  TokOpen (OP position)      -> Just $ SolidP position+  TokOpen (OPA position)     -> Just $ SolidPA position+  TokOpen (OCA area)         -> Just $ SolidCA area+  TokOpen OIB                -> Just $ SolidIB+  TokOpen (OPadding width padding)+                             -> Just $ SolidPadding width padding+  TokOpen (OTrim width direction)+                             -> Just $ SolidTrim width direction+  TokOpen OScope             -> Just $ SolidScope+  _                          -> Nothing++closing :: Parser ()+closing = withPreview \case+  TokClose -> Just ()+  _        -> Nothing++markup :: Parser Text+markup = withPreview \case+  TokMarkup txt -> Just txt+  _             -> Nothing++text :: Parser Text+text = withPreview \case+  TokTxt txt -> Just txt+  _          -> Nothing++source :: Parser Source+source = withPreview \case+  TokSource settings -> Just settings+  _                  -> Nothing++variable :: Parser Variable+variable = withPreview \case+  TokDefine variable -> Just variable+  _                  -> Nothing++shape :: Parser Shape+shape = withPreview \case+  TokI  image     -> Just $ I image+  TokR  shapeSize -> Just $ R  (shapeSize ^. shapeSizeW) (shapeSize ^. shapeSizeH)+  TokRO shapeSize -> Just $ RO (shapeSize ^. shapeSizeW) (shapeSize ^. shapeSizeH)+  TokC  radius    -> Just $ C  radius+  TokCO radius    -> Just $ CO radius+  _               -> Nothing++withPreview :: Stream s m t => Show t => (t -> Maybe a) -> ParsecT s u m a+withPreview = tokenPrim show (\pos _ _ -> pos)
+ src/DzenDhall/Runtime.hs view
@@ -0,0 +1,82 @@+module DzenDhall.Runtime where++import           DzenDhall.Arguments+import           DzenDhall.Runtime.Data+import           DzenDhall.Templates (staticFiles)+import           DzenDhall.Config hiding (Hook)++import           Control.Monad+import           Control.Arrow+import           Data.Maybe+import           Dhall hiding (maybe)+import           Lens.Micro+import           System.Directory+import           System.Exit (ExitCode(..), exitWith)+import           System.FilePath ((</>), takeDirectory)+import           System.Posix.Files+import qualified System.Console.ANSI+import qualified System.IO+import qualified Data.ByteString as BS+++-- Read runtime from configuration file, if possible.+readRuntime :: Arguments -> IO Runtime+readRuntime args = do+  let dzenBinary = fromMaybe "dzen2" (args ^. mbDzenBinary)++  configDir <- maybe (getXdgDirectory XdgConfig "dzen-dhall") pure (args ^. mbConfigDir)+  exists <- doesDirectoryExist configDir++  unless exists $ do+    putStrLn "Configuration directory does not exist, you should create it first by running `dzen-dhall init`."+    exitWith $ ExitFailure 2++  let configFile = configDir </> "config.dhall"++  putStrLn $ "Reading configuration from " <> configFile++  configurations :: [Configuration] <- do+    (if args ^. explain == Explain+     then detailed+     else id) $ inputFile (list configurationType) configFile++  supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout++  pure $ Runtime+    configDir+    configurations+    dzenBinary+    args+    supportsANSI+++-- | Create config directory and set file permissions.+initCommand :: Arguments -> IO ()+initCommand args = do+  configDir <- maybe (getXdgDirectory XdgConfig "dzen-dhall") pure (args ^. mbConfigDir)++  let pluginsDir = configDir </> "plugins"++  exists <- doesDirectoryExist configDir++  when exists $ do+    putStrLn $ "Configuration directory already exists: " <> configDir+    exitWith (ExitFailure 1)++  let mode400 = ownerReadMode+      mode600 = mode400 `unionFileModes` ownerWriteMode++  createDirectoryIfMissing True configDir+  createDirectoryIfMissing True pluginsDir++  forM_ (staticFiles <&> first (configDir <>)) \(file, contents) -> do+    createDirectoryIfMissing True (takeDirectory file)+    BS.writeFile file contents+    setFileMode file mode400++  let configFile = configDir </> "config.dhall"++  setFileMode configFile mode600++  putStrLn $ "Success! You can now view your configuration at " <> configFile+  putStrLn $ "Run dzen-dhall again to see it in action."
+ src/DzenDhall/Runtime/Data.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE TemplateHaskell #-}+module DzenDhall.Runtime.Data where++import           DzenDhall.Arguments+import           DzenDhall.Data+import           DzenDhall.Config hiding (Hook)++import           Data.IORef+import           Dhall hiding (maybe)+import           Lens.Micro.TH+import           System.IO+import qualified Data.HashMap.Strict as H++apiVersion :: Int+apiVersion = 1++data Runtime = Runtime+  { _rtConfigDir :: String+  , _rtConfigurations :: [Configuration]+  , _rtDzenBinary :: String+  , _rtArguments :: Arguments+  , _rtSupportsANSI :: Bool+  }+  deriving (Eq, Show)++makeLenses ''Runtime++-- | 'StateTransitionTable' is needed to know *how* to update,+-- @'IORef' ('Bar' 'Initialized')@ is needed to know *what* to update.+data Subscription+  = AutomatonSubscription+    AutomatonAddress+    StateTransitionTable+    (H.HashMap AutomatonState (Bar Initialized))+    (IORef AutomatonState)+    (IORef (Bar Initialized))++type Subscriptions = H.HashMap Scope [Subscription]++-- | A mapping from clickable area identifiers to script contents.+-- We maintain this mapping to allow using scripts containing `)` in @^ca@.+-- @dzen2@ doesn't allow this.+type ClickableAreas = H.HashMap Int Text++type AutomataCache+  = H.HashMap (Scope, AutomatonAddress)+    ( IORef (Bar Initialized)+    , StateTransitionTable+    , H.HashMap AutomatonState (Bar Marshalled)+    )++data StartupState+  = StartupState+  { _ssSubscriptions       :: Subscriptions+  , _ssScopeName           :: Scope+  , _ssBarSettings         :: BarSettings+  , _ssNonce               :: Int+  -- ^ Counter that is incremented each time it is requested (used as a source+  -- of unique identifiers). See also: 'DzenDhall.App.getCounter'+  , _ssSourceCache         :: H.HashMap (Text, Source) (IORef Text, Cache)+  , _ssAutomataCache       :: AutomataCache+  , _ssSourceQueue         :: [(Source, IORef Text, Cache, Text)]+  , _ssVariableDefinitions :: [(Scope, VariableName, Value)]+  , _ssImages              :: H.HashMap ImageContents ImageId+  -- ^ A queue containing ready-to-be-initialized `Source`s and their handles &+  -- scope names.+  -- This queue is needed because we want to create a `BarRuntime` before+  -- actually running the source processes (they depend on `brEmitterScript` value).+  , _ssClickableAreas      :: ClickableAreas+  -- ^ A mapping from clickable area identifiers to scripts+  , _ssNamedPipe           :: String+  , _ssEmitterFile         :: String+  , _ssGetterFile          :: String+  , _ssSetterFile          :: String+  , _ssVariableFilePrefix  :: String+  , _ssImagePathPrefix     :: String+  }++makeLenses ''StartupState++data BarRuntime = BarRuntime+  { _brConfiguration :: Configuration+  , _brFrameCounter :: Int+  , _brNamedPipe :: String+  -- ^ Named pipe to use as a communication channel for listening to mouse events+  , _brEmitterScript :: String+  -- ^ A script that can be used to emit events+  , _brGetterScript :: String+  , _brSetterScript :: String+  , _brHandle :: Handle+  -- ^ A handle to write to. The value is either stdin of a @dzen2@ process or+  -- 'System.IO.stdout', if @--stdout@ flag is passed.+  }+  deriving (Eq, Show)++makeLenses ''BarRuntime
+ src/DzenDhall/Templates.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TemplateHaskell #-}+module DzenDhall.Templates where++import FileEmbedLzma+import Data.ByteString++staticFiles :: [(FilePath, ByteString)]+staticFiles = $(embedRecursiveDir "dhall")
+ src/DzenDhall/Validation.hs view
@@ -0,0 +1,168 @@+-- | Functions for `config.dhall` validation.+module DzenDhall.Validation where++import           DzenDhall.Config+import           DzenDhall.Event+import           DzenDhall.Extra++import           Control.Monad+import           Data.Maybe+import           Data.Text (Text)+import           Data.Void+import           Lens.Micro+import           System.Directory (findExecutable)+import           System.Exit+import           System.Process+import           Text.Megaparsec hiding (Token, tokens)+import           Text.Megaparsec.Char+import qualified Data.HashMap.Strict as H+import qualified Data.Text+++type ParseErrors = Text.Megaparsec.ParseErrorBundle String Void+++data Error+  = InvalidAutomatonAddress ParseErrors Text+  | BinaryNotInPath Text Text+  | AssertionFailure Text Text+  | InvalidColor ParseErrors Text+  | InvalidHook+++run :: [Token] -> IO ([Error], [Token])+run tokens = do+  let errors = validate tokens+  assertionErrors <- checkAssertions tokens+  pure $ (errors <> assertionErrors, filterOutAssertions tokens)+++filterOutAssertions :: [Token] -> [Token]+filterOutAssertions = filter $ \case+  TokCheck _ -> False+  _          -> True+++validate :: [Token] -> [Error]+validate = reverse . go []+  where+    go acc [] = acc+    go acc (TokOpen (OAutomaton address stt) : rest) =+      let sttErrors =+            (concat $ H.elems (unSTT stt) <&> (^. _2)) >>=+            \(hook :: Hook) -> [ InvalidHook | null (hook ^. hookCommand)  ]+      in+        go (proceed InvalidAutomatonAddress automatonAddressParser address+            (sttErrors <> acc)) rest+    go acc (TokOpen (OFG (Color color)) : rest) =+      go (proceed InvalidColor colorParser color acc) rest+    go acc (TokOpen (OBG (Color color)) : rest) =+      go (proceed InvalidColor colorParser color acc) rest+    go acc (_ : rest) =+      go acc rest++    proceed cont parser what acc =+      case getError parser (Data.Text.unpack what) of+        Nothing -> acc+        Just err -> cont err what : acc++    colorParser =+      hex3 <|> hex6 <|> colorName+      where+        hex3 = do+          void $ char '#'+          void hexDigitChar+          void hexDigitChar+          void hexDigitChar+          pure ""++        hex6 = do+          void $ char '#'+          void hexDigitChar+          void hexDigitChar+          void hexDigitChar+          void hexDigitChar+          void hexDigitChar+          void hexDigitChar+          pure ""++        colorName = do+          void letterChar+          void $ many (alphaNumChar <|> spaceChar)+          pure ""+++checkAssertions :: [Token] -> IO [Error]+checkAssertions [] = pure []+checkAssertions (TokCheck check : xs) = do+  newErrors <-+    case check ^. chAssertion of+      BinaryInPath binary -> do+        mbPath <- findExecutable (Data.Text.unpack binary)+        pure [ BinaryNotInPath binary (check ^. chMessage) | isNothing mbPath ]+      SuccessfulExit code -> do+        let process = shell (Data.Text.unpack code)+        (exitCode, _, _) <- readCreateProcessWithExitCode process ""+        pure [ AssertionFailure code (check ^. chMessage) | exitCode /= ExitSuccess ]++  (newErrors ++) <$> checkAssertions xs++checkAssertions (_ : xs) = checkAssertions xs++-- | Check if the input is parseable by the parser.+getError :: Text.Megaparsec.Parsec Void String Text -> String -> Maybe (Text.Megaparsec.ParseErrorBundle String Void)+getError parser =+  leftToJust . Text.Megaparsec.parse (parser *> Text.Megaparsec.eof) ""+++-- | Pretty-print errors.+report :: [Error] -> Text+report [] = "No errors."+report errors = mappend header $ foldMap ((<> "\n\n") . reportError) errors+  where+    header = "Some errors encountered while trying to read the configuration:\n\n\n"++    namingConventions = "More info: https://github.com/dzen-dhall/dzen-dhall#naming-conventions"++    reportError :: Error -> Text+    reportError = \case++      InvalidAutomatonAddress err address -> fromLines+        [ "Invalid automaton address: " <> address+        , "Error: " <> Data.Text.pack (Text.Megaparsec.errorBundlePretty err)+        , namingConventions+        ]++      BinaryNotInPath binary message -> fromLines $+        [ "One of required binaries was not found in $PATH: " <> binary+        ] <>+        [ fromLines+          [ ""+          , "Message:"+          , ""+          , message+          ]+        | not (Data.Text.null message)+        ]++      AssertionFailure code message -> fromLines $+        [ "One of assertions failed:"+        , ""+        , code+        ] <>+        [ fromLines+          [ ""+          , "Message:"+          , ""+          , message+          ]+        | not (Data.Text.null message)+        ]++      InvalidColor err name -> fromLines+        [ "Invalid color value encountered: " <> name+        , "Error: " <> Data.Text.pack (Text.Megaparsec.errorBundlePretty err)+        ]++      InvalidHook ->+        "Detected a hook with empty command"
+ test/DzenDhall/Test/AST.hs view
@@ -0,0 +1,181 @@+{-# OPTIONS -Wno-name-shadowing -Wno-orphans #-}+{-# LANGUAGE TemplateHaskell #-}+module DzenDhall.Test.AST+  ( getTests+  )+where++import DzenDhall.AST+import DzenDhall.Config+import DzenDhall.Data++import           Control.Arrow+import           Data.Text hiding (split)+import           Test.Hspec+import           Test.Tasty+import           Test.Tasty.HUnit+import           Test.QuickCheck (CoArbitrary (..), Arbitrary (..), counterexample, withMaxSuccess, (===), (==>))+import qualified Test.QuickCheck as QC+import           Test.QuickCheck.Arbitrary ()+import           Generic.Random+import qualified Test.Tasty.QuickCheck as QC++txt :: Text -> AST+txt = ASTText++getTests :: TestTree+getTests =+  testGroup "AST"+  [ testGroup "DzenDhall.Data.split" $+    [ testCase "splits ASTText correctly" $ do+        let tree = txt (pack "123456")+        split 0 tree `shouldBe` (mempty, tree)+        split 1 tree `shouldBe` (txt "1",      txt "23456")+        split 2 tree `shouldBe` (txt "12",     txt "3456")+        split 3 tree `shouldBe` (txt "123",    txt "456")+        split 7 tree `shouldBe` (txt "123456", mempty)+        split 8 tree `shouldBe` (txt "123456", mempty)++    , testCase "splits branches correctly" $ do+        let tree = txt "abc" <> txt "def"+        split 0 tree `shouldBe` (mempty, tree)+        split 1 tree `shouldBe` (txt "a",      txt "bc" <> txt "def")+        split 2 tree `shouldBe` (txt "ab",     txt "c"  <> txt "def")+        split 3 tree `shouldBe` (txt "abc",    txt "def")++    , testCase "splits `ASTPadding` correctly" $ do+        let tree = ASTPadding 4 PRight (txt "a")+        split 0 tree `shouldBe` (mempty, tree)+        split 1 tree `shouldBe` (txt "a", txt "   ")+        split 2 tree `shouldBe` (txt "a" <> txt " ", txt "  ")+        split 3 tree `shouldBe` (txt "a" <> txt "  ", txt " ")+        split 4 tree `shouldBe` (txt "a" <> txt "   ", mempty)+        split 5 tree `shouldBe` (txt "a" <> txt "   ", mempty)++    , testCase "DzenDhall.Data.splitAST calculates consumed lengths correctly for Txt" $ do+        let tree = txt "123456"+        splitAST 0 tree `shouldBe` EmptyL tree+        splitAST 1 tree `shouldBe` Twain (txt "1") (txt "23456") 1+        splitAST 2 tree `shouldBe` Twain (txt "12") (txt "3456") 2+        splitAST 6 tree `shouldBe` EmptyR (txt "123456") 6+        splitAST 7 tree `shouldBe` EmptyR (txt "123456") 6++    , testCase "Calculates consumed lengths correctly for ASTs" $ do+        let tree = txt "123" <> txt "456"+        splitAST 0 tree `shouldBe` EmptyL tree+        splitAST 1 tree `shouldBe` Twain (txt "1") (txt "23" <> txt "456") 1+        splitAST 2 tree `shouldBe` Twain (txt "12") (txt "3" <> txt "456") 2+        splitAST 6 tree `shouldBe` EmptyR tree 6+        splitAST 7 tree `shouldBe` EmptyR tree 6++        let tree = txt "12" <> txt "34" <> txt "56"+        splitAST 0 tree `shouldBe` EmptyL tree+        splitAST 1 tree `shouldBe` Twain (txt "1")+                                         (txt "2" <> txt "34" <> txt "56")+                                         1+        splitAST 2 tree `shouldBe` Twain (txt "12")+                                         (txt "34" <> txt "56")+                                         2+        splitAST 3 tree `shouldBe` Twain (txt "12" <> txt "3")+                                         (txt "4" <> txt "56")+                                         3+        splitAST 4 tree `shouldBe` Twain (txt "12" <> txt "34")+                                         (txt "56")+                                         4+        splitAST 5 tree `shouldBe` Twain (txt "12" <> txt "34" <> txt "5")+                                         (txt "6")+                                         5+        splitAST 6 tree `shouldBe` EmptyR (txt "12" <> txt "34" <> txt "56") 6+        splitAST 7 tree `shouldBe` EmptyR (txt "12" <> txt "34" <> txt "56") 6++        let tree = (txt "12" <> txt "34") <> txt "56"+        splitAST 0 tree `shouldBe` EmptyL tree+        splitAST 1 tree `shouldBe` Twain (txt "1")+                                         ((txt "2" <> txt "34") <> txt "56")+                                         1+        splitAST 2 tree `shouldBe` Twain (txt "12")+                                         (txt "34" <> txt "56")+                                         2+        splitAST 3 tree `shouldBe` Twain (txt "12" <> txt "3")+                                         (txt "4" <> txt "56")+                                         3+        splitAST 4 tree `shouldBe` Twain (txt "12" <> txt "34")+                                         (txt "56")+                                         4+        splitAST 5 tree `shouldBe` Twain ((txt "12" <> txt "34") <> txt "5")+                                         (txt "6")+                                         5+        splitAST 6 tree `shouldBe` EmptyR ((txt "12" <> txt "34") <> txt "56") 6+        splitAST 7 tree `shouldBe` EmptyR ((txt "12" <> txt "34") <> txt "56") 6+    ]+  , testGroup "Generic tests"+    [ QC.testProperty "AST.split preserves lengths"+      prop_ast_split_preserves_widths+    , QC.testProperty "AST.split returns ASTs with correct lengths"+      prop_ast_split_returns_correct_lengths+    ]+  ]++prop_ast_split_preserves_widths :: AST -> Int -> QC.Property+prop_ast_split_preserves_widths ast position =+  withMaxSuccess 10000 $+  counterexample (show $ split position ast) $+  astWidth ast === (uncurry (+) $ astWidth *** astWidth $ split position ast)++prop_ast_split_returns_correct_lengths :: AST -> Int -> QC.Property+prop_ast_split_returns_correct_lengths ast position =+  withMaxSuccess 10000 $+  position >= 0 && astWidth ast >= position ==>+  counterexample (show $ split position ast) $+  astWidth (fst (split position ast)) === position++instance Arbitrary Text where+  arbitrary = Data.Text.pack <$> arbitrary++instance CoArbitrary Text where+  coarbitrary = coarbitrary . Data.Text.unpack++instance Arbitrary Color where+  arbitrary = genericArbitraryU++instance CoArbitrary Color++instance Arbitrary Button where+  arbitrary = genericArbitraryU++instance CoArbitrary Button++instance Arbitrary ClickableArea where+  arbitrary = genericArbitraryU++instance CoArbitrary ClickableArea++instance Arbitrary Position where+  arbitrary = genericArbitraryU++instance CoArbitrary Position++instance Arbitrary AbsolutePosition where+  arbitrary = genericArbitraryU++instance CoArbitrary AbsolutePosition++instance Arbitrary Property where+  arbitrary = genericArbitraryU++instance CoArbitrary Property++instance Arbitrary Shape where+  arbitrary = genericArbitraryU++instance CoArbitrary Shape++instance Arbitrary Padding where+  arbitrary = genericArbitraryU++instance CoArbitrary Padding++instance Arbitrary AST where+  arbitrary = genericArbitraryU++instance CoArbitrary AST
+ test/DzenDhall/Test/AST/Render.hs view
@@ -0,0 +1,54 @@+module DzenDhall.Test.AST.Render where++import DzenDhall.AST+import DzenDhall.AST.Render+import DzenDhall.Data+import DzenDhall.Config++import Test.Hspec+import Test.Tasty+import Test.Tasty.HUnit++asts :: [AST] -> AST+asts = foldr (<>) EmptyAST++getTests :: TestTree+getTests =+  testGroup "DzenDhall.AST.Render"+  [ testGroup "DzenDhall.AST.Render.runRender"+    [ testCase "renders nested colors correctly #0" $ do+        let tree =+              asts [ ASTProp (FG (Color "black")) $+                     ASTText "text"+                   , ASTText "..."+                   ]+        runRender tree `shouldBe` "^fg(black)text^fg()..."+    , testCase "renders nested colors correctly #1" $ do+        let tree =+              ASTProp (FG (Color "black")) $+              ASTProp (FG (Color "white")) $+              ASTText "text"+        runRender tree `shouldBe` "^fg(black)^fg(white)text^fg(black)^fg()"+    , testCase "renders nested colors correctly #2" $ do+        let tree =+              ASTProp (FG (Color "black")) $+              asts [ ASTProp (FG (Color "white")) $+                     ASTText "text1"+                   , ASTText "text1.1"+                   , ASTProp (FG (Color "red")) $+                     ASTText "text2"+                   , ASTText "text3"+                   ]+        runRender tree `shouldBe`+          "^fg(black)^fg(white)text1^fg(black)text1.1^fg(red)text2^fg(black)text3^fg()"++    , testCase "renders nested colors correctly #3" $ do+        let tree =+              ASTProp (FG (Color "red"))+              (ASTs (ASTs (ASTText "a")+                     (ASTProp (FG (Color "green"))+                      (ASTText "b")))+               (ASTText "c"))+        runRender tree `shouldBe` "^fg(red)a^fg(green)b^fg(red)c^fg()"+    ]+  ]
+ test/DzenDhall/Test/Animation/Marquee.hs view
@@ -0,0 +1,67 @@+module DzenDhall.Test.Animation.Marquee where++import           DzenDhall.AST+import           DzenDhall.Config+import qualified DzenDhall.Animation.Marquee as Marquee++import           Test.Tasty (TestTree, TestName, testGroup)+import           Test.Tasty.HUnit++mkTest :: TestName -> Marquee -> AST -> [AST] -> TestTree+mkTest name settings ast expected =+  Test.Tasty.HUnit.testCase name $+    let frames = length expected+        actual = map (Marquee.run 10 settings ast) [0..pred frames]+    in actual @?= expected++getTests :: TestTree+getTests =+  testGroup "Marquee"+  [ let+      ast = ASTText "12345"++      settings = Marquee 1 3 False++      expected = [ ASTText "123"+                 , ASTText "234"+                 , ASTText "345"+                 , ASTs (ASTText "45") (ASTText "1")+                 , ASTs (ASTText "5") (ASTText "12")++                 , ASTText "123"+                 , ASTText "234"+                 , ASTText "345"+                 , ASTs (ASTText "45") (ASTText "1")+                 ]+    in+      mkTest "shouldNotWrap #0" settings ast expected++  , let+      ast = ASTText "123"++      settings = Marquee 1 5 False++      expected = [ ASTs (ASTText "123") (ASTText "  ")+                 , ASTs (ASTText "123") (ASTText "  ")+                 ]++    in+      mkTest "shouldNotWrap #1" settings ast expected++  , let+      ast = ASTText "12345"++      settings = Marquee 1 3 True++      expected = [ ASTText "123"+                 , ASTText "234"+                 , ASTText "345"+                 , ASTs (ASTText "45") (ASTText "1")+                 , ASTs (ASTText "5") (ASTText "12")+                 , (ASTText "123")+                 ]++    in+      mkTest "shouldWrap #0" settings ast expected++  ]
+ test/DzenDhall/Test/Arguments.hs view
@@ -0,0 +1,49 @@+module DzenDhall.Test.Arguments where++import DzenDhall.Arguments+import Options.Applicative+import Test.Tasty+import Test.Tasty.HUnit+import Test.Hspec+import Control.Category++getTests :: TestTree+getTests =+  testGroup "Arguments"+  [ testCase "#1" $ do+      runArgParser [ "--config-dir", ".", "--dzen-binary", "dzen", "init" ]+        `shouldBe`+        pure Arguments { _mbConfigDir = Just "."+                       , _mbDzenBinary = Just "dzen"+                       , _stdoutFlag = ToDzen+                       , _mbCommand = Just Init+                       , _explain = DontExplain+                       }++  , testCase "#2" $ do+      runArgParser [ "--explain", "plug", "foo" ]+        `shouldBe`+        pure Arguments { _mbConfigDir = Nothing+                       , _mbDzenBinary = Nothing+                       , _stdoutFlag = ToDzen+                       , _mbCommand = Just (Plug $ PlugCommand "foo" Confirm)+                       , _explain = Explain+                       }++  , testCase "#3" $ do+      runArgParser [ "--explain", "plug", "--yes", "foo" ]+        `shouldBe`+        pure Arguments { _mbConfigDir = Nothing+                       , _mbDzenBinary = Nothing+                       , _stdoutFlag = ToDzen+                       , _mbCommand = Just (Plug $ PlugCommand "foo" DontConfirm)+                       , _explain = Explain+                       }+  ]++runArgParser :: [String] -> Maybe Arguments+runArgParser =+  execParserPure defaultPrefs argumentsParser >>>+  \case+    Options.Applicative.Success r -> Just r+    _                             -> Nothing
+ test/DzenDhall/Test/Config.hs view
@@ -0,0 +1,178 @@+module DzenDhall.Test.Config where++import           DzenDhall.Config++import           Control.Monad+import           Dhall+import           Lens.Micro+import           System.IO (FilePath)+import           Test.Tasty (TestTree, testGroup)+import           Test.Tasty.HUnit+import qualified Data.HashMap.Strict as H+import qualified Data.Text.IO+++dhallDir :: FilePath+dhallDir = "./dhall"++getTests :: TestTree+getTests =+  testGroup "Config data marshalling"+  [ testGroup "Data types" $+    [ testOpeningTag+    , testToken+    , testCheck+    , testFade+    , testSource+    , testMarquee+    , testButton+    , testPadding+    , testEvent+    , testBarSettings+    , testConfiguration+    , testStateTransitionTable+    , testPluginMeta+    ]++  , testGroup "Config examples" $+    [ dummy "dhall/config.dhall"+    , dummy "test/dhall/configs/automata.dhall"+    , dummy "test/dhall/configs/assertions.dhall"+    , dummy "test/dhall/configs/scopes.dhall"+    , dummy "test/dhall/configs/variables.dhall"+    , dummy "test/dhall/configs/getEvent.dhall"+    , dummy "test/dhall/configs/deduplication.dhall"+    , dummy "test/dhall/configs/sliders.dhall"+    , dummy "test/dhall/configs/marquees.dhall"+    ]+  ]++testFile :: (Eq a, Show a) =>+            Type a -> FilePath -> a -> TestTree+testFile ty file expected  =+  Test.Tasty.HUnit.testCase (file <> " marshalling") $ do+    program <- Data.Text.IO.readFile file+    actual  <- inputWithSettings (defaultInputSettings &+                                  rootDirectory .~ dhallDir &+                                  sourceName .~ file) ty program+    actual @?= expected++testOpeningTag :: TestTree+testOpeningTag =+  testFile (list openingTagType) "test/dhall/OpeningTag.dhall"+    [ OMarquee (Marquee 2 3 False), OFG (Color "red"), OTrim 3 DRight ]++testToken :: TestTree+testToken =+  testFile (list tokenType) "test/dhall/Token.dhall"+    [ TokOpen (OMarquee (Marquee 2 3 False))+    , TokMarkup "raw"+    , TokSource (Source { updateInterval = Just 1000+                        , command = [ "bash" ]+                        , input = "echo 1"+                        , escape = True+                        })+    , TokTxt "txt"+    , TokClose ]++testSource :: TestTree+testSource =+  testFile sourceSettingsType "test/dhall/Source.dhall"+    Source { updateInterval = Just 1000+           , command = [ "bash" ]+           , input = "echo hi"+           , escape = True+           }++testMarquee :: TestTree+testMarquee =+  testFile marqueeType "test/dhall/Marquee.dhall"+    Marquee { _mqFramesPerChar = 2+            , _mqWidth = 3+            , _mqShouldWrap = False+            }++testButton :: TestTree+testButton =+  testFile (list buttonType) "test/dhall/Button.dhall"+    [ MouseLeft+    , MouseMiddle+    , MouseRight+    , MouseScrollUp+    , MouseScrollDown+    , MouseScrollLeft+    , MouseScrollRight+    ]++testPadding :: TestTree+testPadding =+  testFile (list paddingType) "test/dhall/Padding.dhall"+    [ PLeft, PRight, PSides ]++testEvent :: TestTree+testEvent =+  testFile (list eventType) "test/dhall/Event.dhall"+    [ Event "some text"+    ]++testCheck :: TestTree+testCheck =+  testFile (list checkType) "test/dhall/Check.dhall"+  [ Check "" $ SuccessfulExit ""+  , Check "" $ BinaryInPath ""+  ]++testFade :: TestTree+testFade =+  testFile fadeType "test/dhall/Fade.dhall" (Fade VUp 3 4)++testBarSettings :: TestTree+testBarSettings =+  testFile barSettingsType "test/dhall/Settings.dhall"+    BarSettings { _bsMonitor = 1+                , _bsExtraArgs = [ "-l", "10" ]+                , _bsUpdateInterval = 250000+                , _bsFont = Nothing+                , _bsFontWidth = 10+                }++testConfiguration :: TestTree+testConfiguration =+  testFile (list configurationType) "test/dhall/Configuration.dhall"+    [ Configuration { _cfgBarTokens = [ TokClose ]+                    , _cfgBarSettings = BarSettings { _bsMonitor = 1+                                                    , _bsExtraArgs = [ "-l", "10" ]+                                                    , _bsUpdateInterval = 250000+                                                    , _bsFont = Nothing+                                                    , _bsFontWidth = 10+                                                    }+                    }+    ]++testStateTransitionTable :: TestTree+testStateTransitionTable =+  testFile stateTransitionTableType "test/dhall/StateTransitionTable.dhall" $+    STT ( H.fromList [ (("", Event "A", "" ), ("1", []))+                     , (("", Event "B", "" ), ("1", []))+                     , (("", Event "A", "1"), ("2", []))+                     , (("", Event "B", "1"), ("2", []))+                     , (("", Event "A", "2"), ("",  []))+                     , (("", Event "B", "2"), ("",  []))+                     ]+        )++testPluginMeta :: TestTree+testPluginMeta =+  testFile pluginMetaType "test/dhall/PluginMeta.dhall" $+    PluginMeta "1" "2" (Just "3") (Just "4") (Just "5") "6" "7" 8++-- These tests assert succesful input reading (i.e. that "contracts" (in dhall terminology)+-- are not violated):++dummy :: FilePath -> TestTree+dummy file =+  Test.Tasty.HUnit.testCase (file <> " marshalling") $ do+    program <- Data.Text.IO.readFile file+    void $+      inputWithSettings (defaultInputSettings & rootDirectory .~ dhallDir)+      (list configurationType) program
+ test/DzenDhall/Test/Event.hs view
@@ -0,0 +1,36 @@+module DzenDhall.Test.Event where++import Test.Tasty (TestTree, TestName, testGroup)+import Test.Tasty.HUnit++import DzenDhall.Config+import DzenDhall.Event++mkTest :: TestName -> String -> Maybe PipeCommand -> TestTree+mkTest name input expected =+  Test.Tasty.HUnit.testCase name $+    DzenDhall.Event.parsePipeCommand input @?= expected++getTests :: TestTree+getTests =+  testGroup "PipeCommand parser"++  [ mkTest "parsing #3"+    "event:@scope" $+    Nothing+  , mkTest "parsing #4"+    "event:1" $+    Nothing+  , mkTest "parsing #5"+    "event:1some" $+    Nothing+  , mkTest "parsing #6"+    "event:1@" $+    Nothing+  , mkTest "parsing #9"+    "event:MyEvent@scope" $+    Just $ RoutedEvent (Event "MyEvent") "scope"+  , mkTest "parsing #10"+    "click:123@scope-12" $+    Just $ Click "scope-12" 123+  ]
+ test/DzenDhall/Test/Parser.hs view
@@ -0,0 +1,155 @@+module DzenDhall.Test.Parser where++import qualified Data.HashMap.Strict as H+import           Data.Vector+import           Test.Tasty (TestTree, TestName, testGroup)+import           Test.Tasty.HUnit+import           Text.Parsec++import           DzenDhall.Config+import           DzenDhall.Data+import           DzenDhall.Parser++mkTest :: TestName -> [Token] -> Either ParseError (Bar Marshalled) -> TestTree+mkTest name tokenList expected =+  Test.Tasty.HUnit.testCase name $+    DzenDhall.Parser.runBarParser tokenList @?= expected++marquee :: Marquee+marquee = Marquee 0 0 True++getTests :: TestTree+getTests =+  testGroup "Bar data parsing"++  [ mkTest+    "parsing #1"+    [ TokOpen (OMarquee marquee)+    , TokMarkup "txt"+    , TokClose+    ]+    (Right $ Bars [ BarMarquee marquee $ Bars [ BarMarkup "txt" ] ])++  , mkTest+    "parsing #2"+    [ TokOpen (OFG $ Color "red")+    , TokMarkup "raw"+    , TokTxt "txt"+    , TokOpen (OMarquee marquee)+    , TokSource (Source { updateInterval = Nothing+                        , command = []+                        , input = ""+                        , escape = True+                        })+    , TokClose+    , TokClose+    ]++    $ Right $+    Bars [ BarProp (FG $ Color "red") $+           Bars [ BarMarkup "raw"+                , BarText "txt"+                , BarMarquee marquee $ Bars+                  [ BarSource (Source { updateInterval = Nothing+                                      , command = []+                                      , input = ""+                                      , escape = True+                                      })+                  ]+                ]+         ]++  , let fadeUp = Fade VUp 1 10+        slider = (Slider fadeUp fadeUp 1)+    in+      mkTest+      "parsing #3 - slider without separators"+      [ TokOpen (OSlider slider)+      , TokOpen (OSlider slider)+      , TokTxt "text"+      , TokClose+      , TokClose+      ]+      $ Right $+      Bars+      [ BarSlider slider $ Data.Vector.fromList+        [ Bars+          [ BarSlider slider $ Data.Vector.fromList+            [ Bars [ BarText "text" ]+            ]+          ]+        ]+      ]++  , let fadeUp = Fade VUp 1 10+        slider = (Slider fadeUp fadeUp 1)+    in+      mkTest+      "parsing #4 - slider with separators"+      [ TokOpen (OSlider slider)+      , TokOpen (OSlider slider)+      , TokTxt "a"+      , TokSeparator+      , TokTxt "b"+      , TokClose+      , TokSeparator+      , TokTxt "c"+      , TokClose+      ]+      $ Right $+      Bars+      [ BarSlider slider $ Data.Vector.fromList+        [ Bars+          [ BarSlider slider $ Data.Vector.fromList+            [ Bars+              [ BarText "a"+              ]+            , Bars+              [ BarText "b"+              ]+            ]+          ]+        , Bars+          [ BarText "c"+          ]+        ]+      ]++  , let stt = STT mempty in+      mkTest "parsing #5 - automaton"+      [ TokOpen (OAutomaton "id" stt)+      , TokOpen (OStateMapKey "a")+      , TokTxt "A"+      , TokTxt "A"+      , TokClose+      , TokOpen (OStateMapKey "b")+      , TokTxt "B"+      , TokTxt "B"+      , TokClose+      , TokOpen (OStateMapKey "c")+      , TokTxt "C"+      , TokTxt "C"+      , TokClose+      , TokClose+      ]+      $ Right $ Bars+      [ BarAutomaton "id" stt $+        H.fromList+        [ ( "a"+          , Bars [ BarText "A"+                 , BarText "A"+                 ]+          )+        , ( "b"+          , Bars [ BarText "B"+                 , BarText "B"+                 ]+          )+        , ( "c"+          , Bars [ BarText "C"+                 , BarText "C"+                 ]+          )+        ]+      ]+  ]
+ test/DzenDhall/Test/Plug.hs view
@@ -0,0 +1,30 @@+module DzenDhall.Test.Plug where++import DzenDhall.Commands.Plug as Plug++import Data.Maybe (fromJust)+import Network.URI+import Test.Tasty (TestTree, TestName, testGroup)+import Test.Tasty.HUnit+import Text.Parsec++mkTest :: TestName -> String -> Either ParseError PluginSourceSpec -> TestTree+mkTest name input expected =+  Test.Tasty.HUnit.testCase name $+    Plug.parseSourceSpec input @?= expected++getTests :: TestTree+getTests =+  testGroup "Plug parsing"++  [ mkTest "FromGithub #0"+    "fo0O/Bar"+    (Right (FromGithub "fo0O" "Bar" "master"))+  , mkTest "FromGithub #1"+    "fo0-O/Ba_r@dev-elopv1.1"+    (Right (FromGithub "fo0-O" "Ba_r" "dev-elopv1.1"))+  , let url = "https://hackage.haskell.org/" in+      mkTest "url" url $ Right (FromURL $ fromJust $ parseURI url)+  , mkTest "FromOrg" "foo" $ Right (FromOrg "foo" "master")+  , mkTest "FromOrg" "foo@develop" $ Right (FromOrg "foo" "develop")+  ]
+ test/Main.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE QuasiQuotes #-}+module Main where++import qualified DzenDhall.Test.AST+import qualified DzenDhall.Test.AST.Render+import qualified DzenDhall.Test.Animation.Marquee+import qualified DzenDhall.Test.Arguments+import qualified DzenDhall.Test.Config+import qualified DzenDhall.Test.Event+import qualified DzenDhall.Test.Parser+import qualified DzenDhall.Test.Plug++import qualified GHC.IO.Encoding+import qualified System.IO+import           Test.Tasty++main :: IO ()+main = do+  GHC.IO.Encoding.setLocaleEncoding System.IO.utf8++  Test.Tasty.defaultMain $+    testGroup "DzenDhall"+    [ DzenDhall.Test.Config.getTests+    , DzenDhall.Test.Parser.getTests+    , DzenDhall.Test.AST.getTests+    , DzenDhall.Test.AST.Render.getTests+    , DzenDhall.Test.Arguments.getTests+    , DzenDhall.Test.Animation.Marquee.getTests+    , DzenDhall.Test.Plug.getTests+    , DzenDhall.Test.Event.getTests+    ]