new cheat sheet generator

.gitignore

@@ -11,5 +11,8 @@ TAGS
 /cheat-sheet.tex
 
 /.stack-work
-/boon.elc
+*.elc
 /Colemak.hs
+/problem.smt2
+/result.smt2
+/dist

Makefile

@@ -1,17 +1,16 @@
 emacs ?= emacs
 
-cheat.pdf: cheat-sheet.hs
+cheat.pdf: cheat-sheet.hs Colemak.hs
-	ghc --make cheat-sheet.hs -main-is CC
+	nix-shell --run "cabal build"
-	./cheat-sheet
+	nix-shell --run dist/build/boonCS/boonCS
-	xelatex cheat-sheet.tex
+	nix-shell latex.nix --run "xelatex cheat-sheet.tex"
-	xelatex qwerty.tex
+	nix-shell --run dist/build/boonCS/boonCS
-	./cheat-sheet
+	nix-shell latex.nix --run "xelatex cheat-sheet.tex"
-	xelatex qwerty.tex
 
 test:
 	$(emacs) -batch --script boon-test.el
 
-Colemak.hs:
+Colemak.hs: boon-tutorial.el boon-colemak.el boon-keys.el
 	$(emacs) -batch \
           --eval "(add-to-list 'load-path (expand-file-name \".\"))" \
           --eval "(package-initialize)" \

boon-tutorial.el

@@ -12,11 +12,12 @@
 
 (defun boon-dump-map (map)
   "Dump the MAP in a format usable to generate a cheat sheet."
-   (apply
+  (concat
-    'concat
+   "["
+   (-reduce (lambda (x y) (concat x "," y))
             (--map (let* ((b (lookup-key map (make-vector 1 it)))
                           (mn (boon-mnemonic-noformat b map)))
-             (format "(%d,%S,\"%S\"):" it mn
+                     (format "(%d,(%S,\"%S\"))" it mn
                              (cond ((symbolp b) b)
                                    ((eq b boon-x-map) 'x-map)
                                    ((eq b boon-goto-map) 'goto-map))
@@ -24,8 +25,9 @@
                    (-concat
                     (-iterate '1+ ?A 26)
                     (-iterate '1+ ?a 26)
-            '(?\; ?: ?- ?' ?, ?. ?< ?>)
+                    '(?\; ?: ?- ?' ?, ?. ?< ?> ?/ ?? 32 ?\")
-            ))))
+                    )))
+   "]"))
 
 (defun boon-dump-cheatsheet (flavour)
   "Dump cheatcheat info for FLAVOUR."
@@ -34,11 +36,11 @@
     (require 'boon)
     (load el)
     (with-temp-buffer
-      (insert (format "module %s where \n " module))
+      (insert (format "module %s where \n" module))
       (insert (format "nil = \"\"\n"))
-      (insert (format "commandMap = %s:[]\n" (boon-dump-map boon-command-map)))
+      (insert (format "commandMap = %s\n" (boon-dump-map boon-command-map)))
-      (insert (format "movesMap   = %s:[]\n" (boon-dump-map boon-moves-map)))
+      (insert (format "movesMap   = %s\n" (boon-dump-map boon-moves-map)))
-      (insert (format "selectMap  = %s:[]\n" (boon-dump-map boon-select-map)))
+      (insert (format "selectMap  = %s\n" (boon-dump-map boon-select-map)))
       (write-region nil nil (concat module ".hs")))))
 
 (defun boon-keymap-rev-look (sub map)

boon.cabal

@@ -0,0 +1,22 @@
+name:           boon
+version:        1.0
+category:       Development
+synopsis:       A generator of nix files
+description:
+  Soon to appear.
+license:        GPL
+license-file:   LICENSE
+author:         Jean-Philippe Bernardy
+maintainer:     jeanphilippe.bernardy@gmail.com
+Cabal-Version:  >= 1.20
+tested-with:    GHC==8.0.1
+build-type:     Simple
+
+executable boonCS
+  default-language: Haskell2010
+  build-depends: base
+  build-depends: lens
+  build-depends: gasp
+  build-depends: marxup
+  build-depends: lp-diagrams
+  main-is: cheat-sheet.hs

cheat-sheet.hs

@@ -1,28 +1,26 @@
-{-# OPTIONS_GHC -XTypeSynonymInstances -XOverloadedStrings -XRecursiveDo -pgmF marxup -F #-}
+{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TupleSections, RecordWildCards #-}
+{-# OPTIONS_GHC -pgmF marxup -F #-}
-module CC where
+{-# LANGUAGE TupleSections, RecordWildCards, RecursiveDo, OverloadedStrings #-}
+module Main (main) where
 
-import Data.Char (toUpper)
+import Data.Char (toUpper,chr)
 import Prelude hiding (mapM,sequence,Num(..),(/))
 import MarXup
 import MarXup.Latex
 import MarXup.Tex hiding (label)
-import Control.Applicative
-import Data.Monoid
-import Control.Monad (unless)
 import Graphics.Diagrams
 import MarXup.Diagram
-import MarXup.Latex.Math (ensureMath)
 import Control.Lens (set)
--- import Data.String
 import Data.Traversable
-import Data.List (zip4,zipWith4,isSuffixOf,isPrefixOf)
+import Data.List (isSuffixOf,isPrefixOf)
 import Algebra.Classes
+import qualified Colemak
+
 preamble body = do
   documentClass "article" ["10pt"]
   usepackage "fontspec" []
   cmd "setsansfont" (tex "DejaVu Sans")
-  cmd "setmainfont" (tex "DejaVu Serif")
+  -- cmd "setmainfont" (tex "DejaVu Serif")
   usepackage "tikz" []
   usepackage "graphicx" []
   usepackage "amssymb" []
@@ -31,12 +29,22 @@ preamble body = do
   env "document" body
 
 data CheatSheet = CS
-  { leftHandK, rightHandK :: [[String]] -- keycaps
+  { leftHandK, rightHandK :: [[String]] -- keycap glyphs
-  , leftHandM, rightHandM :: [[TeX]] -- mnemonics
+  , commandsInfo, selectorsInfo :: [(Integer,(String,String))]
-  , leftHandL, leftHandU, rightHandL, rightHandU :: [[(TeX,Argument)]] -- commands (lowercase, uppercase)
-  , leftHandR :: [[(TeX,Argument)]] -- region selectors
   }
 
+commandArgument :: String -> Argument
+commandArgument x | "region" `isSuffixOf` x = TextRegion
+                  | "character" `isSuffixOf` x = Char
+                  | "map" `isSuffixOf` x = Prefix
+                  | "avy" `isPrefixOf` x = Char
+commandArgument "boon-enclose" = Bin Enclosure TextRegion
+commandArgument "selectContent" = TextRegion
+commandArgument "" = Reserved
+commandArgument _  = None
+
+
+colemakCS :: CheatSheet
 colemakCS = CS {
   leftHandK = [["q","w","f","p","g"]
               ,["a","r","s","t","d"]
@@ -45,41 +53,11 @@ colemakCS = CS {
  ,rightHandK = [["j","l","u","y",";"," "]
                ,["h","n","e","i","o","'"]
                ,["k","m",",",".","/"," "]]
-
+ ,commandsInfo = Colemak.commandMap ++ Colemak.movesMap
- ,rightHandM = [["Jump", "⇤", "↑", "↓", "⇥"]
+ ,selectorsInfo = Colemak.selectMap
-               ,["Hop", "⇠" , "←", "→", "⇢" , "'"]
-               ,["bacK to marK", "", "↜", "↝", ""]
-               ]
- ,leftHandL = [[("escape",Char), ("search backward",SearchObject), ("search forward",SearchObject), ("occur",None), ("goto-...",Prefix)]
-              ,[("enclose",Bin Enclosure TextRegion), ("kill+insert", TextRegion), ("yank", None), ("kill", TextRegion), ("replace char", Char)]
-              ,[reserved, ("C-x",Prefix), ("C-c C-...",Prefix), ("insert mode",None), ("yank register",Char)]
-              ]
- ,leftHandM = [["Quote", "backWard", "Forward", "Pinpoint", "Goto"]
-              ,["Around", "Replace", "Splice", "Take", "Displace"]
-              ,["", "eXtended", "Command", "⋎ (insert mark)", "Bank"]
-              ]
- ,leftHandU = [[reserved, ("re-search backward",None), ("re-search forward",None), ("Play-macro",None), reserved]
-              ,[reserved, ("Record macro", None), ("pop-yank", None), ("copy", TextRegion), reserved]
-              ,[reserved, reserved, reserved, ("open line",None), ("copy register",Char)]
-              ]
- ,leftHandR = [[("quotes (string)",None), ("word",None), ("word",None), ("paragraph",None), reserved]
-              ,[("enclosure",TextRegion), ("whole-line",None), ("symbol",None), ("whitespace+",TextRegion), ("document",None), ("previous-region",None)]
-              ,[("inclosure",TextRegion), ("s-expr",None), ("s-expr contents",None), reserved, reserved]
-              ]
- ,rightHandL = movesC
-  [["jump-to-def", "begin-of-line", "previous-line", "next-line", "end-of-line"]
-  ,["avy-jump", "smarter-left", "backward-char", "forward-char", "smarter-right", "toggle mark-active"]
-  ,["pop-mark", "", "begin-of-expr", "end-of-expr", ""]
-  ]
-
- ,rightHandU = movesC
-  [["reserved", "", "previous-paragraph", "next-paragraph", ""]
-  ,["avy-jump-char", "", "smarter-up", "smarter-down", "", ""]
-  ,["pop-mark-quick", "", "begin-of-buffer", "end-of-buffer", ""]
-  ]
 }
 
-qwertyCS = colemakCS {
+qwertyCS = CS {
   leftHandK = [["q","w","e","r","t"]
               ,["a","s","d","f","g"]
               ,["z","x","c","v","b"]]
@@ -87,26 +65,11 @@ qwertyCS = colemakCS {
  ,rightHandK = [["y","u","i","o","p"," "]
                ,["h","j","k","l",";","'"]
                ,["n","m",",",".","/"," "]]
-
- ,leftHandL = [[("escape",Char), ("search backward",SearchObject), ("search forward",SearchObject), ("occur",None), ("replace char", Char)]
-              ,[("enclose",Bin Enclosure TextRegion), ("kill+insert", TextRegion), ("kill", TextRegion), ("yank", None), ("goto-...",Prefix)]
-              ,[reserved, ("C-x",Prefix), ("C-c C-...",Prefix), ("insert mode",None), ("yank register",Char)]
-              ]
- ,leftHandU = [[reserved, ("re-search backward",None), ("re-search forward",None), ("Record macro", None), reserved]
-              ,[reserved, reserved,  ("copy", TextRegion), ("pop-yank", None), reserved]
-              ,[reserved, reserved, reserved, ("open line",None), ("copy register",Char)]
-              ]
- ,leftHandM = [["Quote", "backWard", "Elsewhere?", "occurR", "Transform"]
-              ,["Around", "Substitute", "Delete", "Flush", "Goto"]
-              ,["", "eXtended", "Command", "⋎ (insert mark)", "Bank"]
-              ]
- ,leftHandR = [[("quotes (string)",None), ("word",None), ("word",None), ("paragraph",None), reserved]
-              ,[("enclosure",TextRegion), ("symbol",None), ("document",None), reserved, ("paragraph",None), ("previous-region",None)]
-              ,[("inclosure",TextRegion), ("s-expr",None), ("s-expr contents",None),  ("whitespace+",TextRegion), ("blanks",TextRegion) ]
-              ]
 }
 
-upKey c = case [c] 
+
+upKey :: Char -> Char
+upKey c = case [c] of
   "'" -> head "\""
   ";" -> ':'
   "," -> '<'
@@ -127,39 +90,35 @@ argColor a = case a of
   Bin _ _ -> "purple"
   _ -> "white"
 
-reserved :: (TeX,Argument)
+varwidth :: forall a. String -> Tex a -> Tex a
-reserved = (italic "reserved",Reserved)
-
-
-moveC :: String -> (TeX,Argument)
-moveC "" = ("",Reserved)
-moveC x | "avy" `isPrefixOf` x = (textual x,Char)
-moveC x | "region" `isSuffixOf` x = (textual x,TextRegion)
-moveC x = (textual x,None)
-movesC = map (map moveC)
-
-sm = cmd0 "shortmid"
-ma = ensureMath
-
 varwidth x body = env "varwidth" ((braces $ tex x) >> cmd0 "centering" >> body)
 
-zzip = zipWith zip
-zzipWith = zipWith . zipWith
-
-zzip4 f = zipWith4 (zipWith4 f)
-zzip3 f = zipWith3 (zipWith3 f)
-
 keySize :: Constant
 keySize = 65
 
-fontsize :: String -> String -> TeX -> TeX
+massageInfo :: (Integer, (String,String)) -> (String, (TeX,Argument,TeX))
-fontsize x y body = braces $ cmdn_ "fontsize" [tex x, tex y] <> body
+massageInfo (c,(mnemonic,command)) = ([chr (fromIntegral c)],(cmdTex,arg,textual mnemonic))
+  where (cmdTex,arg) | command == "nil" = (italic "reserved",Reserved)
+                     | otherwise = (textual (shortenCommand command),commandArgument command)
 
--- keyHalf :: String -> (TeX,Argument) -> TexDiagram Anchorage
+shortenCommand :: String -> String
-keyHalf k (act,arg) = do
+shortenCommand c | "boon-" `isPrefixOf` c = shortenCommand (drop 5 c)
+shortenCommand c | "-map" `isSuffixOf` c = shortenCommand (dropR 4 c)
+shortenCommand c = c
+
+dropR :: forall a. Int -> [a] -> [a]
+dropR n = reverse . drop n . reverse
+
+keyHalf :: [(String, (TeX, Argument, TeX))]
+           -> String -> TexDiagram Object
+keyHalf kmInfo k = case lookup k kmInfo of
+    Nothing -> error $ "key (" ++ k ++ ") not found in keymap."
+    Just (act,arg,mnem) -> do
       up <- using (fill (argColor arg)) $ draw $ box "keyHalf"
       upK <- label "k" $  textSize Huge $ sans $ textual $ k
       upT <- label "scr" $ varwidth "45pt" $ sans $ textSize ScriptSize $ act
+      m <- (label "mnem" $ sans $ textSize Tiny $ mnem)
+      m # SW .=. up # SW
       up # E .=. upT # E
       up # W .=. upK # W
       width up === constant keySize
@@ -167,12 +126,11 @@ keyHalf k (act,arg) = do
       return up
 
 
-keyDiagram k mnem l u = do
+keyDiagram :: [(String, (TeX, Argument, TeX))] -> String -> Diagram TeX Tex Object
+keyDiagram kmInfo k = do
   b <- using (set lineWidth thick) $ draw $ box "keyB"
-  up <- keyHalf (map upKey k) u
+  up <- keyHalf kmInfo (map upKey k)
-  down <- keyHalf k l
+  down <- keyHalf kmInfo k
-  m <- (label "mnem" $ sans $ textSize Tiny $ mnem)
-  m # SW .=. b # SW
   up # S .=. down # N
   b # NW .=. up # NW
   b # NE .=. up # NE
@@ -193,6 +151,7 @@ keyFull w k act arg = do
 keyDist :: Constant
 keyDist = 5
 
+argDescs :: [(Argument, TeX)]
 argDescs =
   [(Bin Enclosure TextRegion, "First an enclosure, then a region")
   ,(None,"No Argument")
@@ -226,17 +185,19 @@ matrixDiag matrix = do
   alignMatrix $ map (map (# Center)) keys
   return $ reverse keys
 
+keyBDiag :: CheatSheet -> TexDiagram ()
 keyBDiag CS {..} = do
-  keys <- matrixDiag (zzip4 keyDiagram (leftHandK +++ rightHandK) (leftHandM +++ rightHandM) (leftHandL +++ rightHandL) (leftHandU +++ rightHandU))
+  keys <- matrixDiag (map (map (keyDiagram (map massageInfo commandsInfo))) (leftHandK +++ rightHandK))
   esc <- keyFull keySize "esc" "back to normal mode" None
   esc # SW .=. (keys !! 0 !! 0) # NW + (Point zero (constant keyDist))
   bar <- keyFull (keySize * 6 + keyDist * 5) "space" "select region" TextRegion
   keys !! 2 !! 2 # SW .=. bar # NW  + (Point zero (constant keyDist))
   return ()
 
+regDiag :: CheatSheet -> TexDiagram ()
 regDiag CS {..} = do
   txt <- label "lhtrs" "Left-hand text region specifiers:"
-  keys <- matrixDiag (zzipWith keyHalf leftHandK leftHandR)
+  keys <- matrixDiag (map (map (keyHalf (map massageInfo selectorsInfo))) leftHandK)
   spread vdist (constant 7) [keys!!0!!0,txt]
   return ()
 
@@ -244,9 +205,10 @@ regDiag CS {..} = do
 x +++ y = zipWith (++) x y
 
 
+main :: IO ()
 main = do
   renderTex Plain "cheat-sheet" (docu colemakCS)
-  renderTex Plain "qwerty"      (docu qwertyCS)
+  -- renderTex Plain "qwerty"      (docu qwertyCS)
 
 docu :: CheatSheet -> TeX
 docu csData = preamble «

default.nix

@@ -0,0 +1,11 @@
+{ mkDerivation, base, gasp, lens, lp-diagrams, marxup, stdenv }:
+mkDerivation {
+  pname = "boon";
+  version = "1.0";
+  src = ./.;
+  isLibrary = false;
+  isExecutable = true;
+  executableHaskellDepends = [ base gasp lens lp-diagrams marxup ];
+  description = "A generator of nix files";
+  license = "GPL";
+}

latex.nix

@@ -0,0 +1,14 @@
+with (import <nixpkgs> {});
+stdenv.mkDerivation {
+  name = "docsEnv";
+  buildInputs = [ (texlive.combine {
+                    inherit (texlive)
+                      varwidth
+                      lm
+                      xargs
+                      logreq
+                      scheme-small wrapfig marvosym wasysym wasy cm-super unicode-math filehook lm-math capt-of
+                      xstring ucharcat;
+                  })
+                ];
+}

lp-diagrams.nix

@@ -0,0 +1,20 @@
+{ mkDerivation, base, containers, fetchgit, gasp, graphviz
+, labeled-tree, lens, mtl, parsek, polynomials-bernstein, process
+, reflection, stdenv, text, typography-geometry, vector
+}:
+mkDerivation {
+  pname = "lp-diagrams";
+  version = "2.1.0";
+  src = fetchgit {
+    url = "https://github.com/jyp/lp-diagrams.git";
+    sha256 = "0n25cc2h863xgr119a0y8ip0pdazpljhjixlr2pvm9g18r23csw6";
+    rev = "5a9196d14191f7d8d16a191676ad461e1fbce89f";
+  };
+  libraryHaskellDepends = [
+    base containers gasp graphviz labeled-tree lens mtl parsek
+    polynomials-bernstein process reflection text typography-geometry
+    vector
+  ];
+  description = "An EDSL for diagrams based based on linear constraints";
+  license = stdenv.lib.licenses.agpl3;
+}

marxup.nix

@@ -0,0 +1,24 @@
+{ mkDerivation, base, configurator, containers, directory, dlist
+, fetchgit, filepath, haskell-src-exts, labeled-tree, lens
+, lp-diagrams, mtl, parsek, pretty, process, stdenv, text
+}:
+mkDerivation {
+  pname = "marxup";
+  version = "3.1.0.0";
+  src = fetchgit {
+    url = "https://github.com/jyp/marxup.git";
+    sha256 = "1flpdaxxiqacg1m8ac76a32qv78yp1721nlgnnw2kvpqyqhjs8za";
+    rev = "ac35153d20e6f6d628b5a489a7fddd1ef0cb1140";
+  };
+  isLibrary = true;
+  isExecutable = true;
+  libraryHaskellDepends = [
+    base containers directory filepath haskell-src-exts labeled-tree
+    lens lp-diagrams mtl process text
+  ];
+  executableHaskellDepends = [
+    base configurator dlist parsek pretty
+  ];
+  description = "Markup language preprocessor for Haskell";
+  license = stdenv.lib.licenses.gpl2;
+}

shell.nix

@@ -1,10 +1,15 @@
-with (import <nixpkgs> {});
+{ nixpkgs ? import <nixpkgs> {}, compiler ? "ghc801" }: 
-
+with (import <nixpkgs> {}).pkgs;
-haskell.lib.buildStackProject {
+let hp = haskell.packages.${compiler}.override{
-  ghc = haskell.compiler.ghc7103;
+    overrides = self: super: {
-  name = "myEnv";
+      lp-diagrams = self.callPackage ./lp-diagrams.nix {};
-  buildInputs = [ ncurses zlib.dev zlib.out ];
+      marxup = self.callPackage ./marxup.nix {};
+      };};
+    locpkg = hp.callPackage ./default.nix { }; 
+in stdenv.mkDerivation {
+    name = locpkg.name;
+    buildInputs = locpkg.buildInputs ++ [ z3 ];
     shellHook = ''
       export LANG=en_US.UTF-8
       '';
-}
+     }

styx.yaml

@@ -0,0 +1,5 @@
+nix-repos:
+  lp-diagrams:
+    location: https://github.com/jyp/lp-diagrams.git
+  marxup:
+    location: https://github.com/jyp/marxup.git