diff --git a/.nix-helpers/nixpkgs.nix b/.nix-helpers/nixpkgs.nix --- a/.nix-helpers/nixpkgs.nix +++ b/.nix-helpers/nixpkgs.nix @@ -20,13 +20,13 @@ if isNull nixpkgs then builtins.fetchTarball { - # Recent version of nixpkgs master as of 2020-03-03. - url = "https://github.com/NixOS/nixpkgs/archive/bd2c1d72c5a77bfc78693c5b6d121a9e8bb59e6f.tar.gz"; - sha256 = "sha256:0r6lbsz5a0yn6x96y890xvycc1h6la84k2hd3ig5c8irknxdbx22"; + # Recent version of nixpkgs master as of 2020-07-01 which uses LTS-16.2. + url = "https://github.com/NixOS/nixpkgs/archive/7db146538e49ad4bee4b5c4fea073c38586df7e2.tar.gz"; + sha256 = "06vhwys3rpj6grxn76n1sj14wf4hn9z8bmd2k1yhcy29cqri0xhk"; } else nixpkgs; - compilerVersion = if isNull compiler then "ghc882" else compiler; + compilerVersion = if isNull compiler then "ghc883" else compiler; # An overlay that adds termonad to all haskell package sets. haskellPackagesOverlay = self: super: { @@ -61,7 +61,6 @@ extraCabal2nixOptions { inherit (self) gtk3; - libpcre2 = self.pcre2; vte_291 = self.vte; }; in diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,121 +1,220 @@ -## 3.1.0.1 +## 4.0.0.0 -* Correct the solarized colours - [#148](https://github.com/cdepillabout/termonad/pull/148). - Thanks [@craigem](https://github.com/craigem)! +* Remove the dependently typed code for specifying terminal colors. + [#161](https://github.com/cdepillabout/termonad/pull/161). + Thanks [@ssbothwell](https://github.com/ssbothwell)! -* Add an example showing Gruvbox colours - [#149](https://github.com/cdepillabout/termonad/pull/149). - Thanks again [@craigem](https://github.com/craigem)! + The `Palette` data type has been updated to not used length-indexed lists, + but instead just newtype wrappers around normal lists. -* Set an upperbound on `base` so we make sure that only GHC-8.8 is used. Some - of the dependencies of Termonad don't support GHC-8.10 yet. + In prevous versions, the `Palette` data type looked like this: + ```haskell + data Palette c + = NoPalette + | BasicPalette !(Vec N8 c) + | ExtendedPalette !(Vec N8 c) !(Vec N8 c) + | ColourCubePalette !(Vec N8 c) !(Vec N8 c) !(Matrix '[N6, N6, N6] c) + | FullPalette !(Vec N8 c) !(Vec N8 c) !(Matrix '[N6, N6, N6] c) !(Vec N24 c) + ``` + In 4.0.0.0, `Palette` has been changed to the following: + + ```haskell + data Palette c + = NoPalette + | BasicPalette !(List8 c) + | ExtendedPalette !(List8 c) !(List8 c) + | ColourCubePalette !(List8 c) !(List8 c) !(Matrix c) + | FullPalette !(List8 c) !(List8 c) !(Matrix c) !(List24 c) + ``` + + Instead of using types like `Vec N8 c`, you will use types like `List8 c`. + + When setting the `palette` field of in a `ColourConfig`, you can now do + it like the following. Note that there is both a `mkList8` function that + returns `Maybe`, and an `unsafeMkList8` that throws a runtime error. + Most users will probably want to use the `unsafeMkList8` function, since + it is easy to use, and you can eyeball whether the list has the correct + number of elements. If you're doing something more complicated, you may + want to use the `mkList8` function: + + ```haskell + myColourConfig :: ColourConfig (AlphaColour Double) + myColourConfig = + defaultColourConfig + { palette = + ExtendedPalette + myStandardColours (maybe defaultLightColours id myLightColours) + } + where + -- This is a an example of creating a linked-list of colours, + -- This function uses an unsafe method for generating the list. + -- An exception will be thrown if your list does not have exactly 8 elements. + myStandardColours :: List8 (AlphaColour Double) + myStandardColours = unsafeMkList8 + [ createColour 40 30 20 -- dark brown (used as background colour) + , createColour 180 30 20 -- red + , createColour 40 160 20 -- green + , createColour 180 160 20 -- dark yellow + , createColour 40 30 120 -- dark purple + , createColour 180 30 120 -- bright pink + , createColour 40 160 120 -- teal + , createColour 180 160 120 -- light brown + ] + + -- This is an example of creating a linked-list of colours with a type + -- safe method. mkList8 produces a Maybe value which must be handled explicitely. + myLightColours :: Maybe (List8 (AlphaColour Double)) + myLightColours = mkList8 + [ createColour 70 60 50 -- brown + , createColour 220 30 20 -- light red + , createColour 40 210 20 -- light green + , createColour 220 200 20 -- yellow + , createColour 40 30 180 -- purple + , createColour 140 30 80 -- dark pink + , createColour 50 200 160 -- light teal + , createColour 220 200 150 -- light brown + ] + ``` + + Also see the functions `setAtList8`, `overAtList8`, `setAtList24`, + `overAtList24`, etc. + +## 3.1.0.1 + +* Correct the solarized colours + [#148](https://github.com/cdepillabout/termonad/pull/148). + Thanks [@craigem](https://github.com/craigem)! + +* Add an example showing Gruvbox colours + [#149](https://github.com/cdepillabout/termonad/pull/149). + Thanks again [@craigem](https://github.com/craigem)! + +* Set an upperbound on `base` so we make sure that only GHC-8.8 is used. Some + of the dependencies of Termonad don't support GHC-8.10 yet. + ## 3.1.0.0 -* Fix up deprecated functions used in Setup.hs. This should allow Termonad to - be compiled with Cabal-3.0.0.0 (which is used by default in GHC-8.8). - [#144](https://github.com/cdepillabout/termonad/pull/144) Thanks - [mdorman](https://github.com/mdorman)! +* Fix up deprecated functions used in Setup.hs. This should allow Termonad to + be compiled with Cabal-3.0.0.0 (which is used by default in GHC-8.8). + [#144](https://github.com/cdepillabout/termonad/pull/144) Thanks + [mdorman](https://github.com/mdorman)! -* Fully update to LTS-15 and GHC-8.8. Termonad now requires GHC-8.8 in order - to be compiled. [#145](https://github.com/cdepillabout/termonad/pull/145). +* Fully update to LTS-15 and GHC-8.8. Termonad now requires GHC-8.8 in order + to be compiled. [#145](https://github.com/cdepillabout/termonad/pull/145). ## 3.0.0.0 -* Remove the one-pixel white border around the `GtkNotebook` (the GTK widget thing - that contains the tabs). [#138](https://github.com/cdepillabout/termonad/pull/138) -* Add a right-click menu for the terminal. It currently allows copy and - paste. [#136](https://github.com/cdepillabout/termonad/pull/136) Thanks - @jecaro! -* Add a preferences file that settings will be saved to and read from at - `~/.config/termonad/termonad.yaml`. You can change settings with the - Preferences dialog. **The settings will only be used from this file if you - do not have a `~/.config/termonad/termonad.hs` file**. - [#140](https://github.com/cdepillabout/termonad/pull/140) Thanks again - @jecaro! +* Remove the one-pixel white border around the `GtkNotebook` (the GTK widget thing + that contains the tabs). [#138](https://github.com/cdepillabout/termonad/pull/138) +* Add a right-click menu for the terminal. It currently allows copy and + paste. [#136](https://github.com/cdepillabout/termonad/pull/136) Thanks + @jecaro! + +* Add a preferences file that settings will be saved to and read from at + `~/.config/termonad/termonad.yaml`. You can change settings with the + Preferences dialog. **The settings will only be used from this file if you + do not have a `~/.config/termonad/termonad.hs` file**. + [#140](https://github.com/cdepillabout/termonad/pull/140) Thanks again + @jecaro! + ## 2.1.0.0 -* Add a menu option to set preferences for a running Termonad session. The preferences you have set are lost when you end the Termonad session. [#130](https://github.com/cdepillabout/termonad/pull/130) Thanks @jecaro! +* Add a menu option to set preferences for a running Termonad session. + The preferences you have set are lost when you end the Termonad session. + [#130](https://github.com/cdepillabout/termonad/pull/130) Thanks @jecaro! ## 2.0.0.0 -* Added menu option to search for a regex within the terminal output. - This removes support for versions of VTE-2.91 older than 0.46. - This means that compiling on older versions of Debian and Ubuntu may no - longer work. [#118](https://github.com/cdepillabout/termonad/pull/118) +* Added menu option to search for a regex within the terminal output. + This removes support for versions of VTE-2.91 older than 0.46. + This means that compiling on older versions of Debian and Ubuntu may no + longer work. [#118](https://github.com/cdepillabout/termonad/pull/118) ## 1.3.0.0 -* Change all uses of - [`Colour`](http://hackage.haskell.org/package/colour-2.3.5/docs/Data-Colour.html#t:Colour) - to - [`AlphaColour`](http://hackage.haskell.org/package/colour-2.3.5/docs/Data-Colour.html#t:AlphaColour) - in `Termonad.Config.Colour`. Users should now use `AlphaColour` instead of - `Colour`. Also, all uses of `sRGB24` should be replaced with `createColour`. - This change is mechanical and should not affect how Termonad works at all. - Thanks to @jecaro and @amir! [#116](https://github.com/cdepillabout/termonad/pull/116) +* Change all uses of + [`Colour`](http://hackage.haskell.org/package/colour-2.3.5/docs/Data-Colour.html#t:Colour) + to + [`AlphaColour`](http://hackage.haskell.org/package/colour-2.3.5/docs/Data-Colour.html#t:AlphaColour) + in `Termonad.Config.Colour`. Users should now use `AlphaColour` instead of + `Colour`. Also, all uses of `sRGB24` should be replaced with `createColour`. + This change is mechanical and should not affect how Termonad works at all. + Thanks to @jecaro and @amir! [#116](https://github.com/cdepillabout/termonad/pull/116) ## 1.2.0.0 -* Got the code for setting the backgroud color of the terminal actually - working. Thanks @dakotaclemenceplaza. - [#111](https://github.com/cdepillabout/termonad/pull/111) - * This changes the type of `ColourConfig` to make the foreground and - background colors of the terminal optional. -* Various cleanup in the nix files. +* Got the code for setting the backgroud color of the terminal actually + working. Thanks @dakotaclemenceplaza. + [#111](https://github.com/cdepillabout/termonad/pull/111) + * This changes the type of `ColourConfig` to make the foreground and + background colors of the terminal optional. +* Various cleanup in the nix files. + ## 1.1.0.0 -* Added an - [example](https://github.com/cdepillabout/termonad/blob/0cd741d51958806092418b55abdf1c1dc078841c/example-config/ExampleSolarizedColourExtension.hs) - of how to setup a solarized color scheme. Thanks @craigem. - [#90](https://github.com/cdepillabout/termonad/pull/90) and [#103](https://github.com/cdepillabout/termonad/pull/103) -* Various fixes in the nix files. - * Make sure Termonad can see the GTK icons. +* Added an + [example](https://github.com/cdepillabout/termonad/blob/0cd741d51958806092418b55abdf1c1dc078841c/example-config/ExampleSolarizedColourExtension.hs) + of how to setup a solarized color scheme. Thanks @craigem. + [#90](https://github.com/cdepillabout/termonad/pull/90) and [#103](https://github.com/cdepillabout/termonad/pull/103) + +* Various fixes in the nix files. Make sure Termonad can see the GTK icons. [#91](https://github.com/cdepillabout/termonad/pull/91) and [#92](https://github.com/cdepillabout/termonad/pull/92) -* Add a menu option to change the font size at runtime. You should be able to - do this with the `Ctrl-+` and `Ctrl--` keys. - [#95](https://github.com/cdepillabout/termonad/pull/95) -* Get building with GHC 8.6. Thanks @clinty. [#98](https://github.com/cdepillabout/termonad/pull/98) +* Add a menu option to change the font size at runtime. You should be able to + do this with the `Ctrl-+` and `Ctrl--` keys. + [#95](https://github.com/cdepillabout/termonad/pull/95) + +* Get building with GHC 8.6. Thanks @clinty. + [#98](https://github.com/cdepillabout/termonad/pull/98) + ## 1.0.1.0 -* Stop using the `widgetSetFocusOnClick` function, which is not supported on - older versions of GTK. This lets Termonad be compiled with older versions - of GTK. [#87](https://github.com/cdepillabout/termonad/pull/87). -* Add CI. [#87](https://github.com/cdepillabout/termonad/pull/87). -* Support versions of VTE-2.91 older than 0.44. - [#87](https://github.com/cdepillabout/termonad/pull/87). -* Add some functions for converting from a list to a `Vec` in - `Termonad.Config.Vec`: `fromListVec` and `fromListVec_`. Commit 883eb98b5f. -* Fix the paste hotkey. [#86](https://github.com/cdepillabout/termonad/pull/86). +* Stop using the `widgetSetFocusOnClick` function, which is not supported on + older versions of GTK. This lets Termonad be compiled with older versions + of GTK. [#87](https://github.com/cdepillabout/termonad/pull/87). +* Add CI. [#87](https://github.com/cdepillabout/termonad/pull/87). + +* Support versions of VTE-2.91 older than 0.44. + [#87](https://github.com/cdepillabout/termonad/pull/87). + +* Add some functions for converting from a list to a `Vec` in + `Termonad.Config.Vec`: `fromListVec` and `fromListVec_`. Commit 883eb98b5f. + +* Fix the paste hotkey. [#86](https://github.com/cdepillabout/termonad/pull/86). + ## 1.0.0.0 -* The API for configuring Termonad is now completely different. Many, many - changes have gone into this version. You should approach it as a - completely different application. +* The API for configuring Termonad is now completely different. Many, many + changes have gone into this version. You should approach it as a + completely different application. - The CHANGELOG will be kept up-to-date for future releases. + The CHANGELOG will be kept up-to-date for future releases. ## 0.2.1.0 -* Make sure the window title is set to "Termonad". -* Relabel tabs when termonad is started. +* Make sure the window title is set to "Termonad". +* Relabel tabs when termonad is started. + ## 0.2.0.0 -* Open dialog asking if you want to quit when you try to use your WM to quit. -* Termonad will attempt to open up a new terminal in the working directory of - the current terminal. -* Make sure termonad won't crash if dyre can't find GHC. -* Add a few more ways to compile on NixOS. -* Add an icon for termonad. +* Open dialog asking if you want to quit when you try to use your WM to quit. +* Termonad will attempt to open up a new terminal in the working directory of + the current terminal. + +* Make sure termonad won't crash if dyre can't find GHC. + +* Add a few more ways to compile on NixOS. + +* Add an icon for termonad. + ## 0.1.0.0 -* Initial release. +* Initial release. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -25,25 +25,25 @@ **Table of Contents** - [Termonad](#termonad) - - [Installation](#installation) - - [Arch Linux](#arch-linux) - - [Ubuntu / Debian](#ubuntu--debian) - - [Nix](#nix) - - [Mac OS X](#mac-os-x) - - [Installing with just `stack`](#installing-with-just-stack) - - [Installing with just `nix`](#installing-with-just-nix) - - [Installing with `stack` using `nix`](#installing-with-stack-using-nix) - - [Windows](#windows) - - [How to use Termonad](#how-to-use-termonad) - - [Default Key Bindings](#default-key-bindings) - - [Configuring Termonad](#configuring-termonad) - - [Compiling Local Settings](#compiling-local-settings) - - [Running with `stack`](#running-with-stack) - - [Running with `nix`](#running-with-nix) - - [Goals](#goals) - - [Where to get help](#where-to-get-help) - - [Contributions](#contributions) - - [Maintainers](#maintainers) + - [Installation](#installation) + - [Arch Linux](#arch-linux) + - [Ubuntu / Debian](#ubuntu--debian) + - [Nix](#nix) + - [Mac OS X](#mac-os-x) + - [Installing with just `stack`](#installing-with-just-stack) + - [Installing with just `nix`](#installing-with-just-nix) + - [Installing with `stack` using `nix`](#installing-with-stack-using-nix) + - [Windows](#windows) + - [How to use Termonad](#how-to-use-termonad) + - [Default Key Bindings](#default-key-bindings) + - [Configuring Termonad](#configuring-termonad) + - [Compiling Local Settings](#compiling-local-settings) + - [Running with `stack`](#running-with-stack) + - [Running with `nix`](#running-with-nix) + - [Goals](#goals) + - [Where to get help](#where-to-get-help) + - [Contributions](#contributions) + - [Maintainers](#maintainers) @@ -190,7 +190,65 @@ ### Windows -(*currently no instructions available. please send a PR adding instructions if you get termonad to build.*) +To run Termonad on Windows, you'll need: + +* any X server app, for example **Vcxsrv** +* any WSL, for example **Ubuntu** + +I'm using both Vcxsrv and Ubuntu WSL. + +Configure both Vcxsrv and WSL. For Vcxsrv go with default settings +everywhere, it will be fine. Configure your WSL as you want (choose +your name etc.). After you set up the user, you'll have to update your +OS, run: + +```console +$ sudo apt-get update +$ sudo apt-get upgrade -y +$ sudo apt-get dist-upgrade -y +$ sudo apt-get autoremove -y +``` + +Configure the `DISPLAY` environment variable for the X server, and load the changes in bash: + +For WSL1: + +```console +$ echo "export DISPLAY=localhost:0.0" >> ~/.bashrc +$ source ~/.bashrc +``` + +For WSL2: + +```console +$ echo export DISPLAY=$(awk '/nameserver / {print $2; exit}' /etc/resolv.conf 2>/dev/null):0 >> ~/.bashrc +$ echo export LIBGL_ALWAYS_INDIRECT=1 >> ~/.bashrc +$ source ~/.bashrc +``` + +If you're using WSL2, you have to create a separate **inbound rule** for TCP port 6000, to allow WSL access to the X server. +If you're using mentioned earlier **Vcxsrv** you can enable public access for your X server by disabling Access Control on the Extra Settings. +You can also use `-ac` flag in the Additional parameters for VcXsrv section. + +Your X server should now be configured. + +Execute following command to install the necessary GTK system libraries: + +```console +$ apt-get install gobject-introspection libgirepository1.0-dev libgtk-3-dev libvte-2.91-dev libpcre2-dev +``` + +The required GTK system libraries should now be installed. + +Clone the Termonad repo: + +```sh +$ git clone https://github.com/cdepillabout/termonad +$ cd termonad/ +$ stack build +$ stack run +``` +After `stack run`, you should see a new window with your Termonad running. ## How to use Termonad diff --git a/example-config/ExampleColourExtension.hs b/example-config/ExampleColourExtension.hs --- a/example-config/ExampleColourExtension.hs +++ b/example-config/ExampleColourExtension.hs @@ -4,7 +4,6 @@ module Main where -import Data.Singletons (Sing, sing) import Termonad ( CursorBlinkMode(CursorBlinkModeOff), Option(Set) , ShowScrollbar(ShowScrollbarNever), TMConfig, confirmExit, cursorBlinkMode @@ -12,12 +11,9 @@ , start ) import Termonad.Config.Colour - ( AlphaColour, ColourConfig, Palette(ExtendedPalette), addColourExtension + ( AlphaColour, ColourConfig, List8, Palette(ExtendedPalette), addColourExtension , createColour, createColourExtension, cursorBgColour, defaultColourConfig - , foregroundColour, palette - ) -import Termonad.Config.Vec - ( N4, N8, Vec((:*), EmptyVec), fin_, setAtVec, unsafeFromListVec_ + , defaultLightColours, foregroundColour, palette, mkList8, unsafeMkList8 ) -- This is our main 'TMConfig'. It holds all of the non-colour settings @@ -47,29 +43,29 @@ , foregroundColour = Set (createColour 220 180 210) -- light pink -- Set the extended palette that has 8 colours standard colors and then 8 -- light colors. - , palette = ExtendedPalette myStandardColours myLightColours + , palette = ExtendedPalette myStandardColours + (maybe defaultLightColours id myLightColours) } where - -- This is a an example of creating a length-indexed linked-list of colours, - -- using 'Vec' constructors. - myStandardColours :: Vec N8 (AlphaColour Double) - myStandardColours = - createColour 40 30 20 -- dark brown (used as background colour) - :* createColour 180 30 20 -- red - :* createColour 40 160 20 -- green - :* createColour 180 160 20 -- dark yellow - :* createColour 40 30 120 -- dark purple - :* createColour 180 30 120 -- bright pink - :* createColour 40 160 120 -- teal - :* createColour 180 160 120 -- light brown - :* EmptyVec + -- This is a an example of creating a linked-list of colours, + -- This function uses an unsafe method for generating the list. + -- An exception will be thrown if your list does not have 8 elements. + myStandardColours :: List8 (AlphaColour Double) + myStandardColours = unsafeMkList8 + [ createColour 40 30 20 -- dark brown (used as background colour) + , createColour 180 30 20 -- red + , createColour 40 160 20 -- green + , createColour 180 160 20 -- dark yellow + , createColour 40 30 120 -- dark purple + , createColour 180 30 120 -- bright pink + , createColour 40 160 120 -- teal + , createColour 180 160 120 -- light brown + ] - -- This is an example of creating a length-indexed linked-list of colours, - -- using the 'unsafeFromListVec_' function. 'unsafeFromListVec_' is okay to - -- use as long as you're absolutely sure you have 8 elements. - myLightColours :: Vec N8 (AlphaColour Double) - myLightColours = - unsafeFromListVec_ + -- This is an example of creating a linked-list of colours with a type + -- safe method. mkList8 produces a Maybe value which must be handled explicitely. + myLightColours :: Maybe (List8 (AlphaColour Double)) + myLightColours = mkList8 [ createColour 70 60 50 -- brown , createColour 220 30 20 -- light red , createColour 40 210 20 -- light green @@ -79,13 +75,6 @@ , createColour 50 200 160 -- light teal , createColour 220 200 150 -- light brown ] - - -- This is an example of updating just a single value in a 'Colour' 'Vec'. - -- Here we are updating the 5th 'Colour' (which is at index 4). - _updateSingleColor :: Vec N8 (AlphaColour Double) - _updateSingleColor = - let fin4 = fin_ (sing :: Sing N4) - in setAtVec fin4 (createColour 40 30 150) myStandardColours main :: IO () main = do diff --git a/example-config/ExampleGruvboxColourExtension.hs b/example-config/ExampleGruvboxColourExtension.hs --- a/example-config/ExampleGruvboxColourExtension.hs +++ b/example-config/ExampleGruvboxColourExtension.hs @@ -32,11 +32,14 @@ , createColour , createColourExtension , defaultColourConfig + , defaultStandardColours + , defaultLightColours , backgroundColour , foregroundColour , palette + , List8 + , mkList8 ) -import Termonad.Config.Vec (Vec((:*), EmptyVec), N8) -- This is our main 'TMConfig'. It holds all of the non-colour settings -- for Termonad. @@ -66,29 +69,29 @@ , palette = ExtendedPalette gruvboxDark1 gruvboxDark2 } where - gruvboxDark1 :: Vec N8 (AlphaColour Double) - gruvboxDark1 = - createColour 40 40 40 -- bg0 - :* createColour 204 36 29 -- red.1 - :* createColour 152 151 26 -- green.2 - :* createColour 215 153 33 -- yellow.3 - :* createColour 69 133 136 -- blue.4 - :* createColour 177 98 134 -- purple.5 - :* createColour 104 157 106 -- aqua.6 - :* createColour 189 174 147 -- fg3 - :* EmptyVec + gruvboxDark1 :: List8 (AlphaColour Double) + gruvboxDark1 = maybe defaultStandardColours id $ mkList8 + [ createColour 40 40 40 -- bg0 + , createColour 204 36 29 -- red.1 + , createColour 152 151 26 -- green.2 + , createColour 215 153 33 -- yellow.3 + , createColour 69 133 136 -- blue.4 + , createColour 177 98 134 -- purple.5 + , createColour 104 157 106 -- aqua.6 + , createColour 189 174 147 -- fg3 + ] - gruvboxDark2 :: Vec N8 (AlphaColour Double) - gruvboxDark2 = - createColour 124 111 100 -- bg4 - :* createColour 251 71 52 -- red.9 - :* createColour 184 187 38 -- green.10 - :* createColour 250 189 47 -- yellow.11 - :* createColour 131 165 152 -- blue.12 - :* createColour 211 134 155 -- purple.13 - :* createColour 142 192 124 -- aqua.14 - :* createColour 235 219 178 -- fg1 - :* EmptyVec + gruvboxDark2 :: List8 (AlphaColour Double) + gruvboxDark2 = maybe defaultStandardColours id $ mkList8 + [ createColour 124 111 100 -- bg4 + , createColour 251 71 52 -- red.9 + , createColour 184 187 38 -- green.10 + , createColour 250 189 47 -- yellow.11 + , createColour 131 165 152 -- blue.12 + , createColour 211 134 155 -- purple.13 + , createColour 142 192 124 -- aqua.14 + , createColour 235 219 178 -- fg1 + ] -- This is our Gruvbox light 'ColourConfig'. It holds all of our dark-related settings. gruvboxLight :: ColourConfig (AlphaColour Double) @@ -101,29 +104,29 @@ , palette = ExtendedPalette gruvboxLight1 gruvboxLight2 } where - gruvboxLight1 :: Vec N8 (AlphaColour Double) - gruvboxLight1 = - createColour 251 241 199 -- bg0 - :* createColour 204 36 29 -- red.1 - :* createColour 152 151 26 -- green.2 - :* createColour 215 153 33 -- yellow.3 - :* createColour 69 133 136 -- blue.4 - :* createColour 177 98 134 -- purple.5 - :* createColour 104 157 106 -- aqua.6 - :* createColour 102 82 84 -- fg3 - :* EmptyVec + gruvboxLight1 :: List8 (AlphaColour Double) + gruvboxLight1 = maybe defaultLightColours id $ mkList8 + [ createColour 251 241 199 -- bg0 + , createColour 204 36 29 -- red.1 + , createColour 152 151 26 -- green.2 + , createColour 215 153 33 -- yellow.3 + , createColour 69 133 136 -- blue.4 + , createColour 177 98 134 -- purple.5 + , createColour 104 157 106 -- aqua.6 + , createColour 102 82 84 -- fg3 + ] - gruvboxLight2 :: Vec N8 (AlphaColour Double) - gruvboxLight2 = - createColour 168 153 132 -- bg4 - :* createColour 157 0 6 -- red.9 - :* createColour 121 116 14 -- green.10 - :* createColour 181 118 20 -- yellow.11 - :* createColour 7 102 120 -- blue.12 - :* createColour 143 63 113 -- purple.13 - :* createColour 66 123 88 -- aqua.14 - :* createColour 60 56 54 -- fg1 - :* EmptyVec + gruvboxLight2 :: List8 (AlphaColour Double) + gruvboxLight2 = maybe defaultLightColours id $ mkList8 + [ createColour 168 153 132 -- bg4 + , createColour 157 0 6 -- red.9 + , createColour 121 116 14 -- green.10 + , createColour 181 118 20 -- yellow.11 + , createColour 7 102 120 -- blue.12 + , createColour 143 63 113 -- purple.13 + , createColour 66 123 88 -- aqua.14 + , createColour 60 56 54 -- fg1 + ] -- This defines the font for the terminal. diff --git a/example-config/ExampleSolarizedColourExtension.hs b/example-config/ExampleSolarizedColourExtension.hs --- a/example-config/ExampleSolarizedColourExtension.hs +++ b/example-config/ExampleSolarizedColourExtension.hs @@ -32,11 +32,14 @@ , createColour , createColourExtension , defaultColourConfig + , defaultStandardColours + , defaultLightColours , backgroundColour , foregroundColour , palette + , List8 + , mkList8 ) -import Termonad.Config.Vec (Vec((:*), EmptyVec), N8) -- This is our main 'TMConfig'. It holds all of the non-colour settings -- for Termonad. @@ -66,29 +69,29 @@ , palette = ExtendedPalette solarizedDark1 solarizedDark2 } where - solarizedDark1 :: Vec N8 (AlphaColour Double) - solarizedDark1 = - createColour 7 54 66 -- base02 - :* createColour 220 50 47 -- red - :* createColour 133 153 0 -- green - :* createColour 181 137 0 -- yellow - :* createColour 38 139 210 -- blue - :* createColour 211 54 130 -- magenta - :* createColour 42 161 152 -- cyan - :* createColour 238 232 213 -- base2 - :* EmptyVec + solarizedDark1 :: List8 (AlphaColour Double) + solarizedDark1 = maybe defaultStandardColours id $ mkList8 + [ createColour 7 54 66 -- base02 + , createColour 220 50 47 -- red + , createColour 133 153 0 -- green + , createColour 181 137 0 -- yellow + , createColour 38 139 210 -- blue + , createColour 211 54 130 -- magenta + , createColour 42 161 152 -- cyan + , createColour 238 232 213 -- base2 + ] - solarizedDark2 :: Vec N8 (AlphaColour Double) - solarizedDark2 = - createColour 0 43 54 -- base03 - :* createColour 203 75 22 -- orange - :* createColour 88 110 117 -- base01 - :* createColour 101 123 131 -- base00 - :* createColour 131 148 150 -- base0 - :* createColour 108 113 196 -- violet - :* createColour 147 161 161 -- base1 - :* createColour 253 246 227 -- base3 - :* EmptyVec + solarizedDark2 :: List8 (AlphaColour Double) + solarizedDark2 = maybe defaultStandardColours id $ mkList8 + [ createColour 0 43 54 -- base03 + , createColour 203 75 22 -- orange + , createColour 88 110 117 -- base01 + , createColour 101 123 131 -- base00 + , createColour 131 148 150 -- base0 + , createColour 108 113 196 -- violet + , createColour 147 161 161 -- base1 + , createColour 253 246 227 -- base3 + ] -- This is our Solarized light 'ColourConfig'. It holds all of our light-related settings. solarizedLight :: ColourConfig (AlphaColour Double) @@ -101,29 +104,29 @@ , palette = ExtendedPalette solarizedLight1 solarizedLight2 } where - solarizedLight1 :: Vec N8 (AlphaColour Double) - solarizedLight1 = - createColour 7 54 66 -- base02 - :* createColour 220 50 47 -- red - :* createColour 133 153 0 -- green - :* createColour 181 137 0 -- yellow - :* createColour 38 139 210 -- blue - :* createColour 211 54 130 -- magenta - :* createColour 42 161 152 -- cyan - :* createColour 238 232 213 -- base2 - :* EmptyVec + solarizedLight1 :: List8 (AlphaColour Double) + solarizedLight1 = maybe defaultLightColours id $ mkList8 + [ createColour 7 54 66 -- base02 + , createColour 220 50 47 -- red + , createColour 133 153 0 -- green + , createColour 181 137 0 -- yellow + , createColour 38 139 210 -- blue + , createColour 211 54 130 -- magenta + , createColour 42 161 152 -- cyan + , createColour 238 232 213 -- base2 + ] - solarizedLight2 :: Vec N8 (AlphaColour Double) - solarizedLight2 = - createColour 0 43 54 -- base03 - :* createColour 203 75 22 -- orange - :* createColour 88 110 117 -- base01 - :* createColour 101 123 131 -- base00 - :* createColour 131 148 150 -- base0 - :* createColour 108 113 196 -- violet - :* createColour 147 161 161 -- base1 - :* createColour 253 246 227 -- base3 - :* EmptyVec + solarizedLight2 :: List8 (AlphaColour Double) + solarizedLight2 = maybe defaultLightColours id $ mkList8 + [ createColour 0 43 54 -- base03 + , createColour 203 75 22 -- orange + , createColour 88 110 117 -- base01 + , createColour 101 123 131 -- base00 + , createColour 131 148 150 -- base0 + , createColour 108 113 196 -- violet + , createColour 147 161 161 -- base1 + , createColour 253 246 227 -- base3 + ] -- This defines the font for the terminal. fontConf :: FontConfig diff --git a/src/Termonad/Config/Colour.hs b/src/Termonad/Config/Colour.hs --- a/src/Termonad/Config/Colour.hs +++ b/src/Termonad/Config/Colour.hs @@ -25,6 +25,26 @@ ( -- * Colour Config ColourConfig(..) , defaultColourConfig + , List8 + , List6 + , List24 + , Matrix + , mkList8 + , unsafeMkList8 + , setAtList8 + , overAtList8 + , mkList6 + , unsafeMkList6 + , setAtList6 + , overAtList6 + , mkList24 + , unsafeMkList24 + , setAtList24 + , overAtList24 + , mkMatrix + , unsafeMkMatrix + , setAtMatrix + , overAtMatrix -- ** Colour Config Lenses , lensCursorFgColour , lensCursorBgColour @@ -59,6 +79,8 @@ , paletteToList , coloursFromBits , cube + , setAt + , overAt -- * Doctest setup -- $setup ) where @@ -101,7 +123,6 @@ import Text.Printf (printf) import Text.Show (showString) -import Termonad.Config.Vec import Termonad.Lenses (lensCreateTermHook, lensHooks) import Termonad.Types ( Option(Unset) @@ -118,6 +139,180 @@ -- Colour Config -- ------------------- +-- | This newtype is for length 8 lists. Construct it with 'mkList8' or 'unsafeMkList8' +newtype List8 a = List8 { getList8 :: [a] } + deriving (Show, Eq, Foldable, Functor) + +-- | Typesafe smart constructor for length 8 lists. +mkList8 :: [a] -> Maybe (List8 a) +mkList8 xs = if length xs == 8 then Just (List8 xs) else Nothing + +-- | Unsafe smart constructor for length 8 lists. +unsafeMkList8 :: [a] -> List8 a +unsafeMkList8 xs = + case mkList8 xs of + Just xs' -> xs' + Nothing -> + error $ + "unsafeMkList8: input list contains " <> show (length xs) <> + " elements. Must contain exactly 8 elements." + +-- | Set a given value in a list. +-- +-- >>> setAt 2 "hello" ["a","b","c","d"] +-- ["a","b","hello","d"] +-- +-- You can set the first and last values in the list as well: +-- +-- >>> setAt 0 "hello" ["a","b","c","d"] +-- ["hello","b","c","d"] +-- >>> setAt 3 "hello" ["a","b","c","d"] +-- ["a","b","c","hello"] +-- +-- If you try to set a value outside of the list, you'll get back the same +-- list: +-- +-- >>> setAt (-10) "hello" ["a","b","c","d"] +-- ["a","b","c","d"] +-- >>> setAt 100 "hello" ["a","b","c","d"] +-- ["a","b","c","d"] +setAt :: forall a. Int -> a -> [a] -> [a] +setAt n newVal = overAt n (\_ -> newVal) + +-- | Update a given value in a list. +-- +-- >>> overAt 2 (\x -> x ++ x) ["a","b","c","d"] +-- ["a","b","cc","d"] +-- +-- You can update the first and last values in the list as well: +-- +-- >>> overAt 0 (\x -> "bye") ["a","b","c","d"] +-- ["bye","b","c","d"] +-- >>> overAt 3 (\x -> "") ["a","b","c","d"] +-- ["a","b","c",""] +-- +-- If you try to set a value outside of the list, you'll get back the same +-- list: +-- +-- >>> overAt (-10) (\_ -> "foobar") ["a","b","c","d"] +-- ["a","b","c","d"] +-- >>> overAt 100 (\_ -> "baz") ["a","b","c","d"] +-- ["a","b","c","d"] +overAt :: forall a. Int -> (a -> a) -> [a] -> [a] +overAt n f = foldr go [] . zip [0..] + where + go :: (Int, a) -> [a] -> [a] + go (i, a) next + | i == n = f a : next + | otherwise = a : next + +-- | Set a given value in a 'List8'. +-- +-- Internally uses 'setAt'. See documentation on 'setAt' for some examples. +setAtList8 :: Int -> a -> List8 a -> List8 a +setAtList8 n a (List8 l) = List8 (setAt n a l) + +-- | Set a given value in a 'List8'. +-- +-- Internally uses 'overAt'. See documentation on 'overAt' for some examples. +overAtList8 :: Int -> (a -> a) -> List8 a -> List8 a +overAtList8 n f (List8 l) = List8 (overAt n f l) + +-- | This newtype is for length 6 lists. Construct it with 'mkList6' or 'unsafeMkList6' +newtype List6 a = List6 { getList6 :: [a] } + deriving (Show, Eq, Foldable, Functor) + +-- | Typesafe smart constructor for length 6 lists. +mkList6 :: [a] -> Maybe (List6 a) +mkList6 xs = if length xs == 6 then Just (List6 xs) else Nothing + +-- | Unsafe smart constructor for length 6 lists. +unsafeMkList6 :: [a] -> List6 a +unsafeMkList6 xs = + case mkList6 xs of + Just xs' -> xs' + Nothing -> + error $ + "unsafeMkList6: input list contains " <> show (length xs) <> + " elements. Must contain exactly 6 elements." + +-- | Set a given value in a 'List6'. +-- +-- Internally uses 'setAt'. See documentation on 'setAt' for some examples. +setAtList6 :: Int -> a -> List6 a -> List6 a +setAtList6 n a (List6 l) = List6 (setAt n a l) + +-- | Set a given value in a 'List6'. +-- +-- Internally uses 'overAt'. See documentation on 'overAt' for some examples. +overAtList6 :: Int -> (a -> a) -> List6 a -> List6 a +overAtList6 n f (List6 l) = List6 (overAt n f l) + +-- | This newtype is for length 24 lists. Construct it with 'mkList24' or 'unsafeMkList24' +newtype List24 a = List24 { getList24 :: [a] } + deriving (Show, Eq, Foldable, Functor) + +-- | Typesafe smart constructor for length 24 lists. +mkList24 :: [a] -> Maybe (List24 a) +mkList24 xs = if length xs == 24 then Just (List24 xs) else Nothing + +-- | Unsafe smart constructor for length 24 lists. +unsafeMkList24 :: [a] -> List24 a +unsafeMkList24 xs = + case mkList24 xs of + Just xs' -> xs' + Nothing -> error "List must contain 24 elements" + +-- | Set a given value in a 'List24'. +-- +-- Internally uses 'setAt'. See documentation on 'setAt' for some examples. +setAtList24 :: Int -> a -> List24 a -> List24 a +setAtList24 n a (List24 l) = List24 (setAt n a l) + +-- | Set a given value in a 'List24'. +-- +-- Internally uses 'overAt'. See documentation on 'overAt' for some examples. +overAtList24 :: Int -> (a -> a) -> List24 a -> List24 a +overAtList24 n f (List24 l) = List24 (overAt n f l) + +-- | This newtype is for 6x6x6 matrices.. Construct it with 'mkMatrix' or 'unsafeMkMatrix' +newtype Matrix a = Matrix (List6 (List6 (List6 a))) + deriving (Show, Eq, Functor, Foldable) + +getMatrix :: Matrix a -> [[[a]]] +getMatrix (Matrix (List6 m)) = fmap getList6 $ (fmap . fmap) getList6 m + +-- | Unsafe smart constructor for 6x6x6 Matrices. +mkMatrix :: [[[a]]] -> Maybe (Matrix a) +mkMatrix xs = + if length xs == 6 && all (\x -> length x == 6) xs + && all (all (\x -> length x == 6)) xs + then Just $ Matrix $ List6 (fmap List6 ((fmap . fmap) List6 xs)) + else Nothing + +-- | Unsafe smart constructor for 6x6x6 Matrices. +unsafeMkMatrix :: [[[a]]] -> Matrix a +unsafeMkMatrix xs = + case mkMatrix xs of + Just xs' -> xs' + Nothing -> error "Matrix must be 6x6x6" + Nothing -> + error $ + "unsafeMkMatrix: input list must be exactly 6x6x6" + +-- | Set a given value in a 'Matrix'. +-- +-- Internally uses 'setAt'. See documentation on 'setAt' for some examples. +setAtMatrix :: Int -> Int -> Int -> a -> Matrix a -> Matrix a +setAtMatrix x y z a m = overAtMatrix x y z (\_ -> a) m + +-- | Set a given value in a 'Matrix'. +-- +-- Internally uses 'overAt'. See documentation on 'overAt' for some examples. +overAtMatrix :: Int -> Int -> Int -> (a -> a) -> Matrix a -> Matrix a +overAtMatrix x y z f (Matrix l6) = + Matrix (overAtList6 x (overAtList6 y (overAtList6 z f)) l6) + -- | This is the color palette to use for the terminal. Each data constructor -- lets you set progressively more colors. These colors are used by the -- terminal to render @@ -132,7 +327,7 @@ -- grey scale. -- -- The following image gives an idea of what each individual color looks like: --- + -- -- <> -- -- This picture does not exactly match up with Termonad's default colors, but it gives an @@ -148,14 +343,14 @@ = NoPalette -- ^ Don't set any colors and just use the default from VTE. This is a black -- background with light grey text. - | BasicPalette !(Vec N8 c) + | BasicPalette !(List8 c) -- ^ Set the colors from the standard colors. - | ExtendedPalette !(Vec N8 c) !(Vec N8 c) + | ExtendedPalette !(List8 c) !(List8 c) -- ^ Set the colors from the extended (light) colors (as well as standard colors). - | ColourCubePalette !(Vec N8 c) !(Vec N8 c) !(Matrix '[N6, N6, N6] c) + | ColourCubePalette !(List8 c) !(List8 c) !(Matrix c) -- ^ Set the colors from the color cube (as well as the standard colors and -- extended colors). - | FullPalette !(Vec N8 c) !(Vec N8 c) !(Matrix '[N6, N6, N6] c) !(Vec N24 c) + | FullPalette !(List8 c) !(List8 c) !(Matrix c) !(List24 c) -- ^ Set the colors from the grey scale (as well as the standard colors, -- extended colors, and color cube). deriving (Eq, Show, Functor, Foldable) @@ -175,35 +370,38 @@ -- True -- -- In general, as an end-user, you shouldn't need to use this. -coloursFromBits :: forall b. (Ord b, Floating b) => Word8 -> Word8 -> Vec N8 (AlphaColour b) -coloursFromBits scale offset = genVec_ createElem +coloursFromBits :: forall b. (Ord b, Floating b) => Word8 -> Word8 -> List8 (AlphaColour b) +coloursFromBits scale offset = genList createElem where - createElem :: Fin N8 -> AlphaColour b - createElem finN = - let red = cmp 0 finN - green = cmp 1 finN - blue = cmp 2 finN + createElem :: Int -> AlphaColour b + createElem i = + let red = cmp 0 i + green = cmp 1 i + blue = cmp 2 i color = opaque $ sRGB24 red green blue in color - cmp :: Int -> Fin N8 -> Word8 - cmp i = (offset +) . (scale *) . fromIntegral . bit i . toIntFin + cmp :: Int -> Int -> Word8 + cmp i = (offset +) . (scale *) . fromIntegral . bit i bit :: Int -> Int -> Int bit m i = i `div` (2 ^ m) `mod` 2 + genList :: (Int -> a) -> List8 a + genList f = unsafeMkList8 [ f x | x <- [0..7]] + -- | A 'Vec' of standard colors. Default value for 'BasicPalette'. -- -- >>> showColourVec defaultStandardColours -- ["#000000ff","#c00000ff","#00c000ff","#c0c000ff","#0000c0ff","#c000c0ff","#00c0c0ff","#c0c0c0ff"] -defaultStandardColours :: (Ord b, Floating b) => Vec N8 (AlphaColour b) +defaultStandardColours :: (Ord b, Floating b) => List8 (AlphaColour b) defaultStandardColours = coloursFromBits 192 0 -- | A 'Vec' of extended (light) colors. Default value for 'ExtendedPalette'. -- -- >>> showColourVec defaultLightColours -- ["#3f3f3fff","#ff3f3fff","#3fff3fff","#ffff3fff","#3f3fffff","#ff3fffff","#3fffffff","#ffffffff"] -defaultLightColours :: (Ord b, Floating b) => Vec N8 (AlphaColour b) +defaultLightColours :: (Ord b, Floating b) => List8 (AlphaColour b) defaultLightColours = coloursFromBits 192 63 -- | Convert an 'AlphaColour' to a 'Colour'. @@ -317,25 +515,38 @@ createColour r g b = sRGB32 r g b 255 -- | A helper function for showing all the colors in 'Vec' of colors. -showColourVec :: forall n. Vec n (AlphaColour Double) -> [String] -showColourVec = fmap sRGB32show . Data.Foldable.toList +showColourVec :: List8 (AlphaColour Double) -> [String] +showColourVec (List8 xs) = fmap sRGB32show xs +genMatrix :: (Int -> Int -> Int -> a) -> [a] +genMatrix f = [ f x y z | x <- [0..5], y <- [0..5], z <- [0..5] ] + +build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a] +build g = g (:) [] + +chunksOf :: Int -> [e] -> [[e]] +chunksOf i ls = map (take i) (build (splitter ls)) where + splitter :: [e] -> ([e] -> a -> a) -> a -> a + splitter [] _ n = n + splitter l c n = l `c` splitter (drop i l) c n + -- | Specify a colour cube with one colour vector for its displacement and three -- colour vectors for its edges. Produces a uniform 6x6x6 grid bounded by -- and orthognal to the faces. cube :: forall b. Fractional b => AlphaColour b - -> Vec N3 (AlphaColour b) - -> Matrix '[ N6, N6, N6] (AlphaColour b) -cube d (i :* j :* k :* EmptyVec) = - genMatrix_ $ - \(x :< y :< z :< EmptyHList) -> - affineCombo [(1, d), (coef x, i), (coef y, j), (coef z, k)] $ opaque black + -> AlphaColour b + -> AlphaColour b + -> AlphaColour b + -> Matrix (AlphaColour b) +cube d i j k = + let xs = genMatrix $ \x y z -> + affineCombo [(1, d), (coef x, i), (coef y, j), (coef z, k)] $ opaque black + in unsafeMkMatrix $ chunksOf 6 $ chunksOf 6 xs where - coef :: Fin N6 -> b - coef fin' = fromIntegral (toIntFin fin') / 5 - + coef :: Int -> b + coef x = fromIntegral x / 5 -- | A matrix of a 6 x 6 x 6 color cube. Default value for 'ColourCubePalette'. -- -- >>> putStrLn $ pack $ showColourCube defaultColourCube @@ -382,22 +593,19 @@ -- , #ffff00ff, #ffff5fff, #ffff87ff, #ffffafff, #ffffd7ff, #ffffffff -- ] -- ] -defaultColourCube :: (Ord b, Floating b) => Matrix '[N6, N6, N6] (AlphaColour b) +defaultColourCube :: (Ord b, Floating b) => Matrix (AlphaColour b) defaultColourCube = - genMatrix_ $ \(x :< y :< z :< EmptyHList) -> opaque $ sRGB24 (cmp x) (cmp y) (cmp z) + let xs = genMatrix $ \x y z -> opaque $ sRGB24 (cmp x) (cmp y) (cmp z) + in unsafeMkMatrix $ chunksOf 6 $ chunksOf 6 xs where - cmp :: Fin N6 -> Word8 - cmp i = - let i' = fromIntegral (toIntFin i) - in signum i' * 55 + 40 * i' + cmp :: Int -> Word8 + cmp i = let i' = fromIntegral i in signum i' * 55 + 40 * i' -- | Helper function for showing all the colors in a color cube. This is used -- for debugging. -showColourCube :: Matrix '[N6, N6, N6] (AlphaColour Double) -> String +showColourCube :: Matrix (AlphaColour Double) -> String showColourCube matrix = - -- TODO: This function will only work with a 6x6x6 matrix, but it could be - -- generalized to work with any Rank-3 matrix. - let itemList = Data.Foldable.toList matrix + let itemList = (mconcat . mconcat) $ getMatrix matrix in showSColourCube itemList "" where showSColourCube :: [AlphaColour Double] -> String -> String @@ -450,14 +658,15 @@ showCol :: AlphaColour Double -> String -> String showCol col str = sRGB32show col <> str --- | A 'Vec' of a grey scale. Default value for 'FullPalette'. +-- | A List of a grey scale. Default value for 'FullPalette'. -- --- >>> showColourVec defaultGreyscale --- ["#080808ff","#121212ff","#1c1c1cff","#262626ff","#303030ff","#3a3a3aff","#444444ff","#4e4e4eff","#585858ff","#626262ff","#6c6c6cff","#767676ff","#808080ff","#8a8a8aff","#949494ff","#9e9e9eff","#a8a8a8ff","#b2b2b2ff","#bcbcbcff","#c6c6c6ff","#d0d0d0ff","#dadadaff","#e4e4e4ff","#eeeeeeff"] -defaultGreyscale :: (Ord b, Floating b) => Vec N24 (AlphaColour b) -defaultGreyscale = genVec_ $ \n -> - let l = 8 + 10 * fromIntegral (toIntFin n) - in opaque $ sRGB24 l l l +-- >>> fmap sRGB32show defaultGreyscale +-- List24 {getList24 = ["#080808ff","#121212ff","#1c1c1cff","#262626ff","#303030ff","#3a3a3aff","#444444ff","#4e4e4eff","#585858ff","#626262ff","#6c6c6cff","#767676ff","#808080ff","#8a8a8aff","#949494ff","#9e9e9eff","#a8a8a8ff","#b2b2b2ff","#bcbcbcff","#c6c6c6ff","#d0d0d0ff","#dadadaff","#e4e4e4ff","#eeeeeeff"]} +defaultGreyscale :: (Ord b, Floating b) => List24 (AlphaColour b) +defaultGreyscale = unsafeMkList24 $ do + n <- [0..23] + let l = 8 + 10 * n + pure $ opaque $ sRGB24 l l l -- | The configuration for the colors used by Termonad. -- @@ -665,3 +874,4 @@ addColourHook newHook oldHook tmState term = do oldHook tmState term newHook tmState term + diff --git a/src/Termonad/Config/Vec.hs b/src/Termonad/Config/Vec.hs deleted file mode 100644 --- a/src/Termonad/Config/Vec.hs +++ /dev/null @@ -1,651 +0,0 @@ -{-# LANGUAGE RoleAnnotations #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeInType #-} -{-# LANGUAGE UndecidableInstances #-} - --- | Module : Termonad.Config.Vec --- Description : A small library of dependent types --- Copyright : (c) Dennis Gosnell, 2018 --- License : BSD3 --- Stability : experimental --- Portability : POSIX --- --- This is a small library of dependent types. It provides indexed types like --- 'Fin', 'Vec', and 'Matrix'. --- --- This is mainly used in Termonad for "Termonad.Config.Colour" to represent --- length-indexed colour lists. --- --- This module implements a subset of the functionality from the abandoned --- library. --- Ideally this module would be split out to a separate package. --- If you're interested in working on something like this, please see --- on Github. - -module Termonad.Config.Vec - -- ( Fin - -- , I(I) - -- , M(M) - -- , N3 - -- , N24 - -- , N6 - -- , N8 - -- , Prod((:<), Ø) - -- , Range - -- , Vec - -- , VecT((:+), (:*), ØV, EmptyV) - -- , fin - -- , genMatrix_ - -- , setSubmatrix - -- , genVec_ - -- , vSetAt' - -- ) - where - -import Termonad.Prelude hiding ((\\), index) - -import Data.Distributive (Distributive(distribute)) -import qualified Data.Foldable as Data.Foldable -import Data.Functor.Rep (Representable(..), apRep, bindRep, distributeRep, pureRep) -import Data.Kind (Type) -import Data.Singletons.Prelude -import Data.Singletons.TH -import Text.Show (showParen, showString) -import Unsafe.Coerce (unsafeCoerce) - --------------------------- --- Misc VecT Operations -- --------------------------- - --- TODO: These could be implemented? - --- data Range n l m = Range (IFin ('S n) l) (IFin ('S n) (l + m)) --- deriving (Show, Eq) - --- instance (Known (IFin ('S n)) l, Known (IFin ('S n)) (l + m)) --- => Known (Range n l) m where --- type KnownC (Range n l) m --- = (Known (IFin ('S n)) l, Known (IFin ('S n)) (l + m)) --- known = Range known known - --- updateRange :: Range n l m -> (Fin m -> f a -> f a) -> VecT n f a -> VecT n f a --- updateRange = \case --- Range IFZ IFZ -> \_ -> id --- Range (IFS l) (IFS m) -> \f -> onTail (updateRange (Range l m) f) \\ m --- Range IFZ (IFS m) -> \f -> onTail (updateRange (Range IFZ m) $ f . FS) --- . onHead (f FZ) \\ m - --- setRange :: Range n l m -> VecT m f a -> VecT n f a -> VecT n f a --- setRange r nv = updateRange r (\i _ -> index i nv) - --- updateSubmatrix --- :: (ns ~ Fsts3 nlms, ms ~ Thds3 nlms) --- => HList (Uncur3 Range) nlms -> (HList Fin ms -> a -> a) -> M ns a -> M ns a --- updateSubmatrix = \case --- Ø -> \f -> (f Ø <$>) --- Uncur3 r :< rs -> \f -> onMatrix . updateRange r $ \i -> --- asM . updateSubmatrix rs $ f . (i :<) - --- setSubmatrix --- :: (ns ~ Fsts3 nlms, ms ~ Thds3 nlms) --- => HList (Uncur3 Range) nlms -> M ms a -> M ns a -> M ns a --- setSubmatrix rs sm = updateSubmatrix rs $ \is _ -> indexMatrix is sm - ------------ --- Peano -- ------------ - -$(singletons [d| - - data Peano = Z | S Peano deriving (Eq, Ord, Show) - - addPeano :: Peano -> Peano -> Peano - addPeano Z a = a - addPeano (S a) b = S (addPeano a b) - - subtractPeano :: Peano -> Peano -> Peano - subtractPeano Z _ = Z - subtractPeano a Z = a - subtractPeano (S a) (S b) = subtractPeano a b - - multPeano :: Peano -> Peano -> Peano - multPeano Z _ = Z - multPeano (S a) b = addPeano (multPeano a b) b - - n0 :: Peano - n0 = Z - - n1 :: Peano - n1 = S n0 - - n2 :: Peano - n2 = S n1 - - n3 :: Peano - n3 = S n2 - - n4 :: Peano - n4 = S n3 - - n5 :: Peano - n5 = S n4 - - n6 :: Peano - n6 = S n5 - - n7 :: Peano - n7 = S n6 - - n8 :: Peano - n8 = S n7 - - n9 :: Peano - n9 = S n8 - - n10 :: Peano - n10 = S n9 - - n24 :: Peano - n24 = multPeano n4 n6 - - instance Num Peano where - (+) = addPeano - - (-) = subtractPeano - - (*) = multPeano - - abs = id - - signum Z = Z - signum (S _) = S Z - - fromInteger n = - if n < 0 - then error "Num Peano fromInteger: n is negative" - else - if n == 0 then Z else S (fromInteger (n - 1)) - |]) - --- | This is a proof that if we know @'S' n@ is less than @'S' m@, then we --- know @n@ is also less than @m@. --- --- >>> ltSuccProof (sing :: Sing N4) (sing :: Sing N5) --- Refl -ltSuccProof :: - forall (n :: Peano) (m :: Peano) proxy. ('S n < 'S m) ~ 'True - => proxy n - -> proxy m - -> (n < m) :~: 'True -ltSuccProof _ _ = unsafeCoerce (Refl :: Int :~: Int) - ---------- --- Fin -- ---------- - -data Fin :: Peano -> Type where - FZ :: forall (n :: Peano). Fin ('S n) - FS :: forall (n :: Peano). !(Fin n) -> Fin ('S n) - -deriving instance Eq (Fin n) -deriving instance Ord (Fin n) -deriving instance Show (Fin n) - -toIntFin :: Fin n -> Int -toIntFin FZ = 0 -toIntFin (FS x) = succ $ toIntFin x - --- | Similar to 'ifin' but for 'Fin'. --- --- >>> fin (sing :: Sing N5) (sing :: Sing N1) :: Fin N5 --- FS FZ -fin :: - forall total n. (n < total) ~ 'True - => Sing total - -> Sing n - -> Fin total -fin total n = toFinIFin $ ifin total n - --- | Similar to 'ifin_' but for 'Fin'. --- --- >>> fin_ @N4 (sing :: Sing N2) :: Fin N4 --- FS (FS FZ) -fin_ :: - forall total n. (SingI total, (n < total) ~ 'True) - => Sing n - -> Fin total -fin_ n = toFinIFin $ ifin_ n - -data SFin :: forall n. Fin n -> Type where - SFZ :: SFin 'FZ - SFS :: SFin n -> SFin ('FS n) - -type instance Sing @(Fin n) = SFin - -instance SingI 'FZ where - sing = SFZ - -instance SingI n => SingI ('FS n) where - sing = SFS sing - -instance SingKind (Fin n) where - type Demote (Fin n) = Fin n - fromSing :: forall (a :: Fin n). Sing a -> Fin n - fromSing SFZ = FZ - fromSing (SFS fin') = FS (fromSing fin') - - toSing :: Fin n -> SomeSing (Fin n) - toSing FZ = SomeSing SFZ - toSing (FS fin') = - case toSing fin' of - SomeSing n -> SomeSing (SFS n) - -instance Show (SFin 'FZ) where - show SFZ = "SFZ" - -instance Show (SFin n) => Show (SFin ('FS n)) where - showsPrec d (SFS n) = - showParen (d > 10) $ - showString "SFS " . showsPrec 11 n - ----------- --- IFin -- ----------- - -data IFin :: Peano -> Peano -> Type where - IFZ :: forall (n :: Peano). IFin ('S n) 'Z - IFS :: forall (n :: Peano) (m :: Peano). !(IFin n m) -> IFin ('S n) ('S m) - -deriving instance Eq (IFin x y) -deriving instance Ord (IFin x y) -deriving instance Show (IFin x y) - -toFinIFin :: IFin n m -> Fin n -toFinIFin IFZ = FZ -toFinIFin (IFS n) = FS (toFinIFin n) - -toIntIFin :: IFin n m -> Int -toIntIFin = toIntFin . toFinIFin - --- | Create an 'IFin'. --- --- >>> ifin (sing :: Sing N5) (sing :: Sing N2) :: IFin N5 N2 --- IFS (IFS IFZ) -ifin :: - forall total n. ((n < total) ~ 'True) - => Sing total - -> Sing n - -> IFin total n -ifin (SS _) SZ = IFZ -ifin (SS total') (SS n') = - IFS $ - case ltSuccProof n' total' of - Refl -> ifin total' n' -ifin _ _ = error "ifin: pattern impossible but GHC doesn't realize it" - --- | Create an 'IFin', but take the total implicitly. --- --- >>> ifin_ @N5 (sing :: Sing N3) :: IFin N5 N3 --- IFS (IFS (IFS IFZ)) -ifin_ :: - forall total n. (SingI total, (n < total) ~ 'True) - => Sing n - -> IFin total n -ifin_ = ifin sing - -data SIFin :: forall n m. IFin n m -> Type where - SIFZ :: SIFin 'IFZ - SIFS :: SIFin x -> SIFin ('IFS x) - -type instance Sing @(IFin n m) = SIFin - -instance SingI 'IFZ where - sing :: Sing 'IFZ - sing = SIFZ - -instance SingI n => SingI ('IFS n) where - sing = SIFS sing - -instance SingKind (IFin n m) where - type Demote (IFin n m) = IFin n m - fromSing :: forall (a :: IFin n m). Sing a -> IFin n m - fromSing SIFZ = IFZ - fromSing (SIFS fin') = IFS (fromSing fin') - - toSing :: IFin n m -> SomeSing (IFin n m) - toSing IFZ = SomeSing SIFZ - toSing (IFS fin') = - case toSing fin' of - SomeSing n -> SomeSing (SIFS n) - -instance Show (SIFin 'IFZ) where - show SIFZ = "SIFZ" - -instance Show (SIFin n) => Show (SIFin ('IFS n)) where - showsPrec d (SIFS n) = - showParen (d > 10) $ - showString "SIFS " . showsPrec 11 n - ------------ --- HList -- ------------ - -data HList :: (k -> Type) -> [k] -> Type where - EmptyHList :: HList f '[] - (:<) :: forall (f :: k -> Type) (a :: k) (as :: [k]). f a -> HList f as -> HList f (a ': as) - -infixr 6 :< - --- | Data constructor for ':<'. -pattern ConsHList :: (f a :: Type) -> HList f as -> HList f (a ': as) -pattern ConsHList fa hlist = fa :< hlist - ---------- --- Vec -- ---------- - -data Vec (n :: Peano) :: Type -> Type where - EmptyVec :: Vec 'Z a - (:*) :: !a -> !(Vec n a) -> Vec ('S n) a - deriving anyclass MonoFoldable - -infixr 6 :* - --- | Data constructor for ':*'. -pattern ConsVec :: (a :: Type) -> Vec n a -> Vec ('S n) a -pattern ConsVec a vec = a :* vec - -deriving instance Eq a => Eq (Vec n a) -deriving instance Ord a => Ord (Vec n a) -deriving instance Show a => Show (Vec n a) - -deriving instance Functor (Vec n) -deriving instance Foldable (Vec n) - -instance MonoFunctor (Vec n a) - -instance SingI n => MonoPointed (Vec n a) - -instance SingI n => Applicative (Vec n) where - pure a = replaceVec_ a - - (<*>) = apVec ($) - -instance SingI n => Distributive (Vec n) where - distribute :: Functor f => f (Vec n a) -> Vec n (f a) - distribute = distributeRep - -instance SingI n => Representable (Vec n) where - type Rep (Vec n) = Fin n - - tabulate :: (Fin n -> a) -> Vec n a - tabulate = genVec_ - - index :: Vec n a -> Fin n -> a - index = flip indexVec - -instance SingI n => Monad (Vec n) where - (>>=) :: Vec n a -> (a -> Vec n b) -> Vec n b - (>>=) = bindRep - -type instance Element (Vec n a) = a - -genVec_ :: SingI n => (Fin n -> a) -> Vec n a -genVec_ = genVec sing - -genVec :: SPeano n -> (Fin n -> a) -> Vec n a -genVec SZ _ = EmptyVec -genVec (SS n) f = f FZ :* genVec n (f . FS) - -indexVec :: Fin n -> Vec n a -> a -indexVec FZ (a :* _) = a -indexVec (FS n) (_ :* vec) = indexVec n vec - -singletonVec :: a -> Vec N1 a -singletonVec a = ConsVec a EmptyVec - -replaceVec :: Sing n -> a -> Vec n a -replaceVec SZ _ = EmptyVec -replaceVec (SS n) a = a :* replaceVec n a - -imapVec :: forall n a b. (Fin n -> a -> b) -> Vec n a -> Vec n b -imapVec _ EmptyVec = EmptyVec -imapVec f (a :* as) = f FZ a :* imapVec (\fin' vec -> f (FS fin') vec) as - -replaceVec_ :: SingI n => a -> Vec n a -replaceVec_ = replaceVec sing - -apVec :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c -apVec _ EmptyVec _ = EmptyVec -apVec f (a :* as) (b :* bs) = f a b :* apVec f as bs - -onHeadVec :: (a -> a) -> Vec ('S n) a -> Vec ('S n) a -onHeadVec f (a :* as) = f a :* as - -dropVec :: Sing m -> Vec (m + n) a -> Vec n a -dropVec SZ vec = vec -dropVec (SS n) (_ :* vec) = dropVec n vec - -takeVec :: IFin n m -> Vec n a -> Vec m a -takeVec IFZ _ = EmptyVec -takeVec (IFS n) (a :* vec) = a :* takeVec n vec - -updateAtVec :: Fin n -> (a -> a) -> Vec n a -> Vec n a -updateAtVec FZ f (a :* vec) = f a :* vec -updateAtVec (FS n) f (a :* vec) = a :* updateAtVec n f vec - -setAtVec :: Fin n -> a -> Vec n a -> Vec n a -setAtVec fin' a = updateAtVec fin' (const a) - -fromListVec :: Sing n -> [a] -> Maybe (Vec n a) -fromListVec SZ _ = Just EmptyVec -fromListVec (SS _) [] = Nothing -fromListVec (SS n) (a:as) = do - tailVec <- fromListVec n as - pure $ ConsVec a tailVec - -fromListVec_ :: SingI n => [a] -> Maybe (Vec n a) -fromListVec_ = fromListVec sing - -unsafeFromListVec :: Sing n -> [a] -> Vec n a -unsafeFromListVec n as = - case fromListVec n as of - Just vec -> vec - Nothing -> - error $ - "unsafeFromListVec: couldn't create a length " <> - show n <> " vector from the input list" - -unsafeFromListVec_ :: SingI n => [a] -> Vec n a -unsafeFromListVec_ = unsafeFromListVec sing - ------------- --- Matrix -- ------------- - -type family MatrixTF (ns :: [Peano]) (a :: Type) :: Type where - MatrixTF '[] a = a - MatrixTF (n ': ns) a = Vec n (MatrixTF ns a) - -newtype Matrix ns a = Matrix - { unMatrix :: MatrixTF ns a - } - deriving anyclass (MonoFoldable) - -type instance Element (Matrix ns a) = a - ---------------------------------- --- Defunctionalization Symbols -- ---------------------------------- - -type MatrixTFSym2 (ns :: [Peano]) (t :: Type) = (MatrixTF ns t :: Type) - -data MatrixTFSym1 (ns :: [Peano]) (z :: TyFun Type Type) - = forall (arg :: Type). SameKind (Apply (MatrixTFSym1 ns) arg) (MatrixTFSym2 ns arg) => MatrixTFSym1KindInference - -type instance Apply (MatrixTFSym1 l1) l2 = MatrixTF l1 l2 - -type role MatrixTFSym0 phantom - -data MatrixTFSym0 (l :: TyFun [Peano] (Type ~> Type)) - = forall (arg :: [Peano]). SameKind (Apply MatrixTFSym0 arg) (MatrixTFSym1 arg) => MatrixTFSym0KindInference - -type instance Apply MatrixTFSym0 l = MatrixTFSym1 l - -type role MatrixTFSym1 phantom phantom - ----------------------- --- Matrix Functions -- ----------------------- - -eqSingMatrix :: forall (peanos :: [Peano]) (a :: Type). Eq a => Sing peanos -> Matrix peanos a -> Matrix peanos a -> Bool -eqSingMatrix = compareSingMatrix (==) True (&&) - -ordSingMatrix :: forall (peanos :: [Peano]) (a :: Type). Ord a => Sing peanos -> Matrix peanos a -> Matrix peanos a -> Ordering -ordSingMatrix = compareSingMatrix compare EQ f - where - f :: Ordering -> Ordering -> Ordering - f EQ o = o - f o _ = o - -compareSingMatrix :: - forall (peanos :: [Peano]) (a :: Type) (c :: Type) - . (a -> a -> c) - -> c - -> (c -> c -> c) - -> Sing peanos - -> Matrix peanos a - -> Matrix peanos a - -> c -compareSingMatrix f _ _ SNil (Matrix a) (Matrix b) = f a b -compareSingMatrix _ empt _ (SCons SZ _) (Matrix EmptyVec) (Matrix EmptyVec) = empt -compareSingMatrix f empt combine (SCons (SS peanoSingle) moreN) (Matrix (a :* moreA)) (Matrix (b :* moreB)) = - combine - (compareSingMatrix f empt combine moreN (Matrix a) (Matrix b)) - (compareSingMatrix f empt combine (SCons peanoSingle moreN) (Matrix moreA) (Matrix moreB)) - -fmapSingMatrix :: forall (peanos :: [Peano]) (a :: Type) (b ::Type). Sing peanos -> (a -> b) -> Matrix peanos a -> Matrix peanos b -fmapSingMatrix SNil f (Matrix a) = Matrix $ f a -fmapSingMatrix (SCons SZ _) _ (Matrix EmptyVec) = Matrix EmptyVec -fmapSingMatrix (SCons (SS peanoSingle) moreN) f (Matrix (a :* moreA)) = - let matA = fmapSingMatrix moreN f (Matrix a) - matB = fmapSingMatrix (SCons peanoSingle moreN) f (Matrix moreA) - in consMatrix matA matB - -consMatrix :: Matrix ns a -> Matrix (n ': ns) a -> Matrix ('S n ': ns) a -consMatrix (Matrix a) (Matrix as) = Matrix $ ConsVec a as - -toListMatrix :: - forall (peanos :: [Peano]) (a :: Type). - Sing peanos - -> Matrix peanos a - -> [a] -toListMatrix SNil (Matrix a) = [a] -toListMatrix (SCons SZ _) (Matrix EmptyVec) = [] -toListMatrix (SCons (SS peanoSingle) moreN) (Matrix (a :* moreA)) = - toListMatrix moreN (Matrix a) <> toListMatrix (SCons peanoSingle moreN) (Matrix moreA) - -genMatrix :: - forall (ns :: [Peano]) (a :: Type). - Sing ns - -> (HList Fin ns -> a) - -> Matrix ns a -genMatrix SNil f = Matrix $ f EmptyHList -genMatrix (SCons (n :: SPeano foo) (ns' :: Sing oaoa)) f = - Matrix $ (genVec n $ (gagaga :: Fin foo -> MatrixTF oaoa a) :: Vec foo (MatrixTF oaoa a)) - where - gagaga :: Fin foo -> MatrixTF oaoa a - gagaga faaa = unMatrix $ (genMatrix ns' $ byebye faaa :: Matrix oaoa a) - - byebye :: Fin foo -> HList Fin oaoa -> a - byebye faaa = f . ConsHList faaa - -genMatrix_ :: SingI ns => (HList Fin ns -> a) -> Matrix ns a -genMatrix_ = genMatrix sing - -indexMatrix :: HList Fin ns -> Matrix ns a -> a -indexMatrix EmptyHList (Matrix a) = a -indexMatrix (i :< is) (Matrix vec) = indexMatrix is $ Matrix (indexVec i vec) - -imapMatrix :: forall (ns :: [Peano]) a b. Sing ns -> (HList Fin ns -> a -> b) -> Matrix ns a -> Matrix ns b -imapMatrix SNil f (Matrix a) = Matrix (f EmptyHList a) -imapMatrix (SCons _ ns) f matrix = - onMatrixTF - (imapVec (\fin' -> onMatrix (imapMatrix ns (\hlist -> f (ConsHList fin' hlist))))) - matrix - -imapMatrix_ :: SingI ns => (HList Fin ns -> a -> b) -> Matrix ns a -> Matrix ns b -imapMatrix_ = imapMatrix sing - -onMatrixTF :: (MatrixTF ns a -> MatrixTF ms b) -> Matrix ns a -> Matrix ms b -onMatrixTF f (Matrix mat) = Matrix $ f mat - -onMatrix :: (Matrix ns a -> Matrix ms b) -> MatrixTF ns a -> MatrixTF ms b -onMatrix f = unMatrix . f . Matrix - -updateAtMatrix :: HList Fin ns -> (a -> a) -> Matrix ns a -> Matrix ns a -updateAtMatrix EmptyHList _ mat = mat -updateAtMatrix (n :< ns) f mat = - onMatrixTF (updateAtVec n (onMatrix (updateAtMatrix ns f))) mat - -setAtMatrix :: HList Fin ns -> a -> Matrix ns a -> Matrix ns a -setAtMatrix fins a = updateAtMatrix fins (const a) - ----------------------- --- Matrix Instances -- ----------------------- - -deriving instance (Eq (MatrixTF ns a)) => Eq (Matrix ns a) - -deriving instance (Ord (MatrixTF ns a)) => Ord (Matrix ns a) - -deriving instance (Show (MatrixTF ns a)) => Show (Matrix ns a) - -instance SingI ns => Functor (Matrix ns) where - fmap :: (a -> b) -> Matrix ns a -> Matrix ns b - fmap = fmapSingMatrix sing - -instance SingI ns => Data.Foldable.Foldable (Matrix ns) where - foldr :: (a -> b -> b) -> b -> Matrix ns a -> b - foldr comb b = Data.Foldable.foldr comb b . toListMatrix sing - - toList :: Matrix ns a -> [a] - toList = toListMatrix sing - -instance SingI ns => Distributive (Matrix ns) where - distribute :: Functor f => f (Matrix ns a) -> Matrix ns (f a) - distribute = distributeRep - -instance SingI ns => Representable (Matrix ns) where - type Rep (Matrix ns) = HList Fin ns - - tabulate :: (HList Fin ns -> a) -> Matrix ns a - tabulate = genMatrix_ - - index :: Matrix ns a -> HList Fin ns -> a - index = flip indexMatrix - -instance Num a => Num (Matrix '[] a) where - Matrix a + Matrix b = Matrix (a + b) - - Matrix a * Matrix b = Matrix (a * b) - - Matrix a - Matrix b = Matrix (a - b) - - abs (Matrix a) = Matrix (abs a) - - signum (Matrix a) = Matrix (signum a) - - fromInteger :: Integer -> Matrix '[] a - fromInteger = Matrix . fromInteger - -instance SingI ns => Applicative (Matrix ns) where - pure :: a -> Matrix ns a - pure = pureRep - - (<*>) :: Matrix ns (a -> b) -> Matrix ns a -> Matrix ns b - (<*>) = apRep - -instance SingI ns => Monad (Matrix ns) where - (>>=) :: Matrix ns a -> (a -> Matrix ns b) -> Matrix ns b - (>>=) = bindRep diff --git a/termonad.cabal b/termonad.cabal --- a/termonad.cabal +++ b/termonad.cabal @@ -1,5 +1,5 @@ name: termonad -version: 3.1.0.1 +version: 4.0.0.0 synopsis: Terminal emulator configurable in Haskell description: Please see . homepage: https://github.com/cdepillabout/termonad @@ -43,7 +43,6 @@ , Termonad.App , Termonad.Config , Termonad.Config.Colour - , Termonad.Config.Vec , Termonad.Gtk , Termonad.Keys , Termonad.Lenses @@ -80,7 +79,6 @@ , mono-traversable , pretty-simple , QuickCheck - , singletons , text , transformers , yaml @@ -148,8 +146,6 @@ type: exitcode-stdio-1.0 main-is: Test.hs hs-source-dirs: test - -- other-modules: Test.FocusList - -- , Test.FocusList.Invariants build-depends: base , genvalidity-containers , genvalidity-hspec @@ -203,7 +199,6 @@ build-depends: base , termonad , colour - , singletons default-language: Haskell2010 ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -threaded -rtsopts -with-rtsopts=-N @@ -217,7 +212,6 @@ build-depends: base , termonad , colour - , singletons default-language: Haskell2010 ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -threaded -rtsopts -with-rtsopts=-N @@ -231,7 +225,6 @@ build-depends: base , termonad , colour - , singletons default-language: Haskell2010 ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -threaded -rtsopts -with-rtsopts=-N diff --git a/test/readme/README.lhs b/test/readme/README.lhs --- a/test/readme/README.lhs +++ b/test/readme/README.lhs @@ -25,25 +25,25 @@ **Table of Contents** - [Termonad](#termonad) - - [Installation](#installation) - - [Arch Linux](#arch-linux) - - [Ubuntu / Debian](#ubuntu--debian) - - [Nix](#nix) - - [Mac OS X](#mac-os-x) - - [Installing with just `stack`](#installing-with-just-stack) - - [Installing with just `nix`](#installing-with-just-nix) - - [Installing with `stack` using `nix`](#installing-with-stack-using-nix) - - [Windows](#windows) - - [How to use Termonad](#how-to-use-termonad) - - [Default Key Bindings](#default-key-bindings) - - [Configuring Termonad](#configuring-termonad) - - [Compiling Local Settings](#compiling-local-settings) - - [Running with `stack`](#running-with-stack) - - [Running with `nix`](#running-with-nix) - - [Goals](#goals) - - [Where to get help](#where-to-get-help) - - [Contributions](#contributions) - - [Maintainers](#maintainers) + - [Installation](#installation) + - [Arch Linux](#arch-linux) + - [Ubuntu / Debian](#ubuntu--debian) + - [Nix](#nix) + - [Mac OS X](#mac-os-x) + - [Installing with just `stack`](#installing-with-just-stack) + - [Installing with just `nix`](#installing-with-just-nix) + - [Installing with `stack` using `nix`](#installing-with-stack-using-nix) + - [Windows](#windows) + - [How to use Termonad](#how-to-use-termonad) + - [Default Key Bindings](#default-key-bindings) + - [Configuring Termonad](#configuring-termonad) + - [Compiling Local Settings](#compiling-local-settings) + - [Running with `stack`](#running-with-stack) + - [Running with `nix`](#running-with-nix) + - [Goals](#goals) + - [Where to get help](#where-to-get-help) + - [Contributions](#contributions) + - [Maintainers](#maintainers) @@ -190,7 +190,65 @@ ### Windows -(*currently no instructions available. please send a PR adding instructions if you get termonad to build.*) +To run Termonad on Windows, you'll need: + +* any X server app, for example **Vcxsrv** +* any WSL, for example **Ubuntu** + +I'm using both Vcxsrv and Ubuntu WSL. + +Configure both Vcxsrv and WSL. For Vcxsrv go with default settings +everywhere, it will be fine. Configure your WSL as you want (choose +your name etc.). After you set up the user, you'll have to update your +OS, run: + +```console +$ sudo apt-get update +$ sudo apt-get upgrade -y +$ sudo apt-get dist-upgrade -y +$ sudo apt-get autoremove -y +``` + +Configure the `DISPLAY` environment variable for the X server, and load the changes in bash: + +For WSL1: + +```console +$ echo "export DISPLAY=localhost:0.0" >> ~/.bashrc +$ source ~/.bashrc +``` + +For WSL2: + +```console +$ echo export DISPLAY=$(awk '/nameserver / {print $2; exit}' /etc/resolv.conf 2>/dev/null):0 >> ~/.bashrc +$ echo export LIBGL_ALWAYS_INDIRECT=1 >> ~/.bashrc +$ source ~/.bashrc +``` + +If you're using WSL2, you have to create a separate **inbound rule** for TCP port 6000, to allow WSL access to the X server. +If you're using mentioned earlier **Vcxsrv** you can enable public access for your X server by disabling Access Control on the Extra Settings. +You can also use `-ac` flag in the Additional parameters for VcXsrv section. + +Your X server should now be configured. + +Execute following command to install the necessary GTK system libraries: + +```console +$ apt-get install gobject-introspection libgirepository1.0-dev libgtk-3-dev libvte-2.91-dev libpcre2-dev +``` + +The required GTK system libraries should now be installed. + +Clone the Termonad repo: + +```sh +$ git clone https://github.com/cdepillabout/termonad +$ cd termonad/ +$ stack build +$ stack run +``` +After `stack run`, you should see a new window with your Termonad running. ## How to use Termonad