ghci4luatex (empty) → 0.0
raw patch · 13 files changed
+2300/−0 lines, 13 filesdep +QuickCheckdep +aesondep +basebinary-added
Dependencies added: QuickCheck, aeson, base, bytestring, cmdargs, containers, ghci4luatex, hspec, network-simple, process, stm, text
Files
- CHANGELOG.md +13/−0
- LICENSE +28/−0
- README.md +126/−0
- app/ghci4luatex.hs +141/−0
- dkjson.lua +752/−0
- doc/ghci-doc.pdf binary
- doc/ghci-doc.tex +438/−0
- ghci.sty +142/−0
- ghci4luatex.cabal +102/−0
- src/Data/Memoizer/Commands.hs +141/−0
- src/Data/Memoizer/Sessions.hs +147/−0
- src/System/Process/Ghci.hs +221/−0
- test/Spec.hs +49/−0
+ CHANGELOG.md view
@@ -0,0 +1,13 @@+# Changelog for `ghci4luatex`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## 0.0 - 2025-07-04++* A server that executes GHCi commands and memoizes the results+* A LuaTeX package that sends commands to that server+
+ LICENSE view
@@ -0,0 +1,28 @@+BSD 3-Clause License++Copyright (c) 2025, Alice Rixte++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the copyright holder nor the names of its+ 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 HOLDER 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,126 @@+# ghci4luatex : a GHCi session in LuaTeX++[](https://haskell.org) [](https://hackage.haskell.org/package/ghci4luatex) [](https://github.com/AliceRixte/ghci4luatex/LICENSE)++Run a GHCi session within a latex document :++* The `ghci` environment evaluates Haskell code without printing anything :++```latex+\begin{ghci}+x :: Int+x = 4++y :: Int+y = 5+\end{ghci}+```++* The `hask` command evaluates any GHCi command and prints in Haskell what GHCi printed :++```latex+The sum of $x$ and $y$ when $x = \hask{x}$ and $y = \hask{y}$ is $\hask{x + y}$.+```++* You can use `HaTeX` :++```latex++\begin{ghci}+:set -XOverloadedStrings+\end{ghci}++\begin{ghci}+import Text.LaTeX++printTex = putStrLn . prettyLateX+\end{ghci}++\hask{printTex (section "A section using HaTeX")}+```++* Use any package you need by adding it to `package.yaml` (if the package is on Stackage) or to `stack.yaml` if it is your own package or only on Hackage.+++## Quick start+++1. Install `haskell` and `cabal` or `stack`++2. Install `ghci4luatex`by running either++```+cabal install ghci4luatex+```++or++```+stack install ghci4luatex+```++3. Copy `ghci.sty` and `dkjson.lua` in the folder containing a `main.tex` file with the following content :++``` latex+\documentclass{article}++\usepackage{ghci}++\begin{document}++\begin{ghci}+x :: Int+x = 5++y :: Int+y = 6+\end{ghci}++The sum of $x$ and $y$ when $x = \hask{x}$ and $y = \hask{y}$ is $\hask{x + y}$.++\end{document}+```++4. Within that folder, run the `ghci4luatex` server :++```+ghci4luatex+```++5. Open another shell and compile with `luatex` :++```+latexmk -shell-escape -lualatex main.tex+```++## Workflow with `lhs2tex` in Visual Studio Code with LaTeX workshop++In this repository, you will find an [example](./example/README.md) that contains a [Makefile](./example/Makefile).++You can take inspiration from this to use `make` in a LateX Workshop receipe :++1. Install the [LaTeX Workshop](https://marketplace.visualstudio.com/items?itemName=James-Yu.latex-workshop) extension.+2. In `settings.json` , add the following+```json+"latex-workshop.latex.recipes": [+ {+ "name": "ghci4luatex",+ "tools": [+ "mklatex"+ ]+ }+ ],+"latex-workshop.latex.outDir": "./build/",+"latex-workshop.latex.tools": [+ {+ "name": "mklatex",+ "command": "make",+ "args": [+ "latex",+ "main=%DOCFILE%"+ ],+ "env": {}+ }+ ],+```+
+ app/ghci4luatex.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}++module Main (main) where++import Control.Monad+import GHC.Generics+import System.IO+import Data.IORef++++import Network.Simple.TCP++import qualified Data.ByteString.Lazy as BL++import System.Console.CmdArgs++import Data.Aeson++import System.Process.Ghci+import qualified Data.Memoizer.Sessions as Memo++data ServerMsg = NewSession String | ContinueSession String+ deriving (Show, Eq, Generic)++instance ToJSON ServerMsg where+ toEncoding = genericToEncoding defaultOptions++instance FromJSON ServerMsg++data Ghci4luatexMsg = GhciMsg String | ServerMsg ServerMsg+ deriving (Show, Eq, Generic)+++instance ToJSON Ghci4luatexMsg where+ toEncoding = genericToEncoding defaultOptions++instance FromJSON Ghci4luatexMsg++data Ghci4luatex = Ghci4luatex+ { command :: String+ , host :: String+ , port :: String+ }+ deriving (Data,Typeable,Show,Eq)++type GhciMemo = Memo.SessionMemoizer String String BL.ByteString++cmdArg :: Ghci4luatex+cmdArg = Ghci4luatex+ { command = "ghci" &= help "Command to run (defaults to ghci)"+ , host = "127.0.0.1" &= help "Host address (defaults to localhost)"+ , port = "54123" &= help "Port (defaults to 54123)"+ }+ &= verbosity+ &= summary "ghci4luatex v0.1, (C) Alice Rixte"++main :: IO ()+main = do+ Ghci4luatex str addr prt <- cmdArgs cmdArg+ case words str of+ [] -> putStrLn "Error : Empty ghci command."+ cmd : ghciArgs -> do+ v <- getVerbosity+ when (v >= Normal) $ do+ putChar '\n'+ putStrLn "(-: Starting GHCi Server :-)"+ putChar '\n'++ ghci <- startGhci v cmd ghciArgs++ when (v >= Normal) $ do+ putChar '\n'+ putStrLn "(-: GHCi server is ready :-)"+ putChar '\n'++ memo <- newIORef (Memo.initSession "main" :: GhciMemo)+ serve (Host addr) prt $ \(sock, remoteAddr) -> do+ when (v > Normal) $ putStrLn $ "New connection of " ++ show remoteAddr+ handleClient v sock ghci memo++printGhciMsg :: String -> IO ()+printGhciMsg str =+ case lines str of+ [] -> return ()+ -- [s] -> when (s /= "") $ putStrLn $ "ghci| " ++ s+ (x:q) -> do+ putStrLn $ "ghci> " ++ x+ mapM_ (putStrLn . ("ghci| " ++)) q++handleClient :: Verbosity -> Socket -> Ghci -> IORef GhciMemo -> IO ()+handleClient v sock ghci memo =+ loop+ where+ loop = do+ msg <- recv sock 1024+ case msg of+ Just bs -> do+ case decodeStrict bs :: Maybe Ghci4luatexMsg of+ Nothing ->+ let json = encode (GhciResult "ghci4luatex :: Error : Could not parse JSON message." "")+ in do+ hPutStr stderr $ "Error : Could not parse JSON message : "+ hPutStr stderr $ show bs+ hPutStr stderr "\n"+ hFlush stderr+ sendLazy sock json+ Just (GhciMsg s) -> do++ m <-readIORef memo+ json <- case Memo.lookup s m of+ Nothing -> do+ when (v >= Normal) $ printGhciMsg s+ res <- execGhciCmd ghci v (s ++ "\n")+ when (v >= Normal) $ putStrLn ""+ let json = encode res <> "\n"+ modifyIORef memo (Memo.storeResult s json)+ return json+ Just json -> do+ when (v >= Loud) $ do+ printGhciMsg s+ putStrLn "Memoized !"+ putStrLn ""+ modifyIORef memo Memo.nextCmd+ return json+ sendLazy sock json+ Just (ServerMsg (NewSession s)) -> do+ modifyIORef memo (Memo.newSession s)+ when (v >= Normal) $ do+ putStrLn $ "--- New session : " ++ show s ++ "---\n"+ Just (ServerMsg (ContinueSession s)) -> do+ modifyIORef memo (Memo.continueSession s)+ when (v >= Normal) $ do+ putStrLn $ "--- Continue session : " ++ show s ++ "---\n"++ loop+ Nothing -> when (v >= Loud) $ do+ putChar '\n'+ putStrLn "Connexion was closed"
+ dkjson.lua view
@@ -0,0 +1,752 @@+-- Module options:+local always_use_lpeg = false+local register_global_module_table = false+local global_module_name = 'json'++--[==[++David Kolf's JSON module for Lua 5.1 - 5.4++Version 2.8+++For the documentation see the corresponding readme.txt or visit+<http://dkolf.de/dkjson-lua/>.++You can contact the author by sending an e-mail to 'david' at the+domain 'dkolf.de'.+++Copyright (C) 2010-2024 David Heiko Kolf++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.++--]==]++-- global dependencies:+local pairs, type, tostring, tonumber, getmetatable, setmetatable =+ pairs, type, tostring, tonumber, getmetatable, setmetatable+local error, require, pcall, select = error, require, pcall, select+local floor, huge = math.floor, math.huge+local strrep, gsub, strsub, strbyte, strchar, strfind, strlen, strformat =+ string.rep, string.gsub, string.sub, string.byte, string.char,+ string.find, string.len, string.format+local strmatch = string.match+local concat = table.concat++local json = { version = "dkjson 2.8" }++local jsonlpeg = {}++if register_global_module_table then+ if always_use_lpeg then+ _G[global_module_name] = jsonlpeg+ else+ _G[global_module_name] = json+ end+end++local _ENV = nil -- blocking globals in Lua 5.2 and later++pcall (function()+ -- Enable access to blocked metatables.+ -- Don't worry, this module doesn't change anything in them.+ local debmeta = require "debug".getmetatable+ if debmeta then getmetatable = debmeta end+end)++json.null = setmetatable ({}, {+ __tojson = function () return "null" end+})++local function isarray (tbl)+ local max, n, arraylen = 0, 0, 0+ for k,v in pairs (tbl) do+ if k == 'n' and type(v) == 'number' then+ arraylen = v+ if v > max then+ max = v+ end+ else+ if type(k) ~= 'number' or k < 1 or floor(k) ~= k then+ return false+ end+ if k > max then+ max = k+ end+ n = n + 1+ end+ end+ if max > 10 and max > arraylen and max > n * 2 then+ return false -- don't create an array with too many holes+ end+ return true, max+end++local escapecodes = {+ ["\""] = "\\\"", ["\\"] = "\\\\", ["\b"] = "\\b", ["\f"] = "\\f",+ ["\n"] = "\\n", ["\r"] = "\\r", ["\t"] = "\\t"+}++local function escapeutf8 (uchar)+ local value = escapecodes[uchar]+ if value then+ return value+ end+ local a, b, c, d = strbyte (uchar, 1, 4)+ a, b, c, d = a or 0, b or 0, c or 0, d or 0+ if a <= 0x7f then+ value = a+ elseif 0xc0 <= a and a <= 0xdf and b >= 0x80 then+ value = (a - 0xc0) * 0x40 + b - 0x80+ elseif 0xe0 <= a and a <= 0xef and b >= 0x80 and c >= 0x80 then+ value = ((a - 0xe0) * 0x40 + b - 0x80) * 0x40 + c - 0x80+ elseif 0xf0 <= a and a <= 0xf7 and b >= 0x80 and c >= 0x80 and d >= 0x80 then+ value = (((a - 0xf0) * 0x40 + b - 0x80) * 0x40 + c - 0x80) * 0x40 + d - 0x80+ else+ return ""+ end+ if value <= 0xffff then+ return strformat ("\\u%.4x", value)+ elseif value <= 0x10ffff then+ -- encode as UTF-16 surrogate pair+ value = value - 0x10000+ local highsur, lowsur = 0xD800 + floor (value/0x400), 0xDC00 + (value % 0x400)+ return strformat ("\\u%.4x\\u%.4x", highsur, lowsur)+ else+ return ""+ end+end++local function fsub (str, pattern, repl)+ -- gsub always builds a new string in a buffer, even when no match+ -- exists. First using find should be more efficient when most strings+ -- don't contain the pattern.+ if strfind (str, pattern) then+ return gsub (str, pattern, repl)+ else+ return str+ end+end++local function quotestring (value)+ -- based on the regexp "escapable" in https://github.com/douglascrockford/JSON-js+ value = fsub (value, "[%z\1-\31\"\\\127]", escapeutf8)+ if strfind (value, "[\194\216\220\225\226\239]") then+ value = fsub (value, "\194[\128-\159\173]", escapeutf8)+ value = fsub (value, "\216[\128-\132]", escapeutf8)+ value = fsub (value, "\220\143", escapeutf8)+ value = fsub (value, "\225\158[\180\181]", escapeutf8)+ value = fsub (value, "\226\128[\140-\143\168-\175]", escapeutf8)+ value = fsub (value, "\226\129[\160-\175]", escapeutf8)+ value = fsub (value, "\239\187\191", escapeutf8)+ value = fsub (value, "\239\191[\176-\191]", escapeutf8)+ end+ return "\"" .. value .. "\""+end+json.quotestring = quotestring++local function replace(str, o, n)+ local i, j = strfind (str, o, 1, true)+ if i then+ return strsub(str, 1, i-1) .. n .. strsub(str, j+1, -1)+ else+ return str+ end+end++-- locale independent num2str and str2num functions+local decpoint, numfilter++local function updatedecpoint ()+ decpoint = strmatch(tostring(0.5), "([^05+])")+ -- build a filter that can be used to remove group separators+ numfilter = "[^0-9%-%+eE" .. gsub(decpoint, "[%^%$%(%)%%%.%[%]%*%+%-%?]", "%%%0") .. "]+"+end++updatedecpoint()++local function num2str (num)+ return replace(fsub(tostring(num), numfilter, ""), decpoint, ".")+end++local function str2num (str)+ local num = tonumber(replace(str, ".", decpoint))+ if not num then+ updatedecpoint()+ num = tonumber(replace(str, ".", decpoint))+ end+ return num+end++local function addnewline2 (level, buffer, buflen)+ buffer[buflen+1] = "\n"+ buffer[buflen+2] = strrep (" ", level)+ buflen = buflen + 2+ return buflen+end++function json.addnewline (state)+ if state.indent then+ state.bufferlen = addnewline2 (state.level or 0,+ state.buffer, state.bufferlen or #(state.buffer))+ end+end++local encode2 -- forward declaration++local function addpair (key, value, prev, indent, level, buffer, buflen, tables, globalorder, state)+ local kt = type (key)+ if kt ~= 'string' and kt ~= 'number' then+ return nil, "type '" .. kt .. "' is not supported as a key by JSON."+ end+ if prev then+ buflen = buflen + 1+ buffer[buflen] = ","+ end+ if indent then+ buflen = addnewline2 (level, buffer, buflen)+ end+ -- When Lua is compiled with LUA_NOCVTN2S this will fail when+ -- numbers are mixed into the keys of the table. JSON keys are always+ -- strings, so this would be an implicit conversion too and the failure+ -- is intentional.+ buffer[buflen+1] = quotestring (key)+ buffer[buflen+2] = ":"+ return encode2 (value, indent, level, buffer, buflen + 2, tables, globalorder, state)+end++local function appendcustom(res, buffer, state)+ local buflen = state.bufferlen+ if type (res) == 'string' then+ buflen = buflen + 1+ buffer[buflen] = res+ end+ return buflen+end++local function exception(reason, value, state, buffer, buflen, defaultmessage)+ defaultmessage = defaultmessage or reason+ local handler = state.exception+ if not handler then+ return nil, defaultmessage+ else+ state.bufferlen = buflen+ local ret, msg = handler (reason, value, state, defaultmessage)+ if not ret then return nil, msg or defaultmessage end+ return appendcustom(ret, buffer, state)+ end+end++function json.encodeexception(reason, value, state, defaultmessage)+ return quotestring("<" .. defaultmessage .. ">")+end++encode2 = function (value, indent, level, buffer, buflen, tables, globalorder, state)+ local valtype = type (value)+ local valmeta = getmetatable (value)+ valmeta = type (valmeta) == 'table' and valmeta -- only tables+ local valtojson = valmeta and valmeta.__tojson+ if valtojson then+ if tables[value] then+ return exception('reference cycle', value, state, buffer, buflen)+ end+ tables[value] = true+ state.bufferlen = buflen+ local ret, msg = valtojson (value, state)+ if not ret then return exception('custom encoder failed', value, state, buffer, buflen, msg) end+ tables[value] = nil+ buflen = appendcustom(ret, buffer, state)+ elseif value == nil then+ buflen = buflen + 1+ buffer[buflen] = "null"+ elseif valtype == 'number' then+ local s+ if value ~= value or value >= huge or -value >= huge then+ -- This is the behaviour of the original JSON implementation.+ s = "null"+ else+ s = num2str (value)+ end+ buflen = buflen + 1+ buffer[buflen] = s+ elseif valtype == 'boolean' then+ buflen = buflen + 1+ buffer[buflen] = value and "true" or "false"+ elseif valtype == 'string' then+ buflen = buflen + 1+ buffer[buflen] = quotestring (value)+ elseif valtype == 'table' then+ if tables[value] then+ return exception('reference cycle', value, state, buffer, buflen)+ end+ tables[value] = true+ level = level + 1+ local isa, n = isarray (value)+ if n == 0 and valmeta and valmeta.__jsontype == 'object' then+ isa = false+ end+ local msg+ if isa then -- JSON array+ buflen = buflen + 1+ buffer[buflen] = "["+ for i = 1, n do+ buflen, msg = encode2 (value[i], indent, level, buffer, buflen, tables, globalorder, state)+ if not buflen then return nil, msg end+ if i < n then+ buflen = buflen + 1+ buffer[buflen] = ","+ end+ end+ buflen = buflen + 1+ buffer[buflen] = "]"+ else -- JSON object+ local prev = false+ buflen = buflen + 1+ buffer[buflen] = "{"+ local order = valmeta and valmeta.__jsonorder or globalorder+ if order then+ local used = {}+ n = #order+ for i = 1, n do+ local k = order[i]+ local v = value[k]+ if v ~= nil then+ used[k] = true+ buflen, msg = addpair (k, v, prev, indent, level, buffer, buflen, tables, globalorder, state)+ if not buflen then return nil, msg end+ prev = true -- add a seperator before the next element+ end+ end+ for k,v in pairs (value) do+ if not used[k] then+ buflen, msg = addpair (k, v, prev, indent, level, buffer, buflen, tables, globalorder, state)+ if not buflen then return nil, msg end+ prev = true -- add a seperator before the next element+ end+ end+ else -- unordered+ for k,v in pairs (value) do+ buflen, msg = addpair (k, v, prev, indent, level, buffer, buflen, tables, globalorder, state)+ if not buflen then return nil, msg end+ prev = true -- add a seperator before the next element+ end+ end+ if indent then+ buflen = addnewline2 (level - 1, buffer, buflen)+ end+ buflen = buflen + 1+ buffer[buflen] = "}"+ end+ tables[value] = nil+ else+ return exception ('unsupported type', value, state, buffer, buflen,+ "type '" .. valtype .. "' is not supported by JSON.")+ end+ return buflen+end++function json.encode (value, state)+ state = state or {}+ local oldbuffer = state.buffer+ local buffer = oldbuffer or {}+ state.buffer = buffer+ updatedecpoint()+ local ret, msg = encode2 (value, state.indent, state.level or 0,+ buffer, state.bufferlen or 0, state.tables or {}, state.keyorder, state)+ if not ret then+ error (msg, 2)+ elseif oldbuffer == buffer then+ state.bufferlen = ret+ return true+ else+ state.bufferlen = nil+ state.buffer = nil+ return concat (buffer)+ end+end++local function loc (str, where)+ local line, pos, linepos = 1, 1, 0+ while true do+ pos = strfind (str, "\n", pos, true)+ if pos and pos < where then+ line = line + 1+ linepos = pos+ pos = pos + 1+ else+ break+ end+ end+ return strformat ("line %d, column %d", line, where - linepos)+end++local function unterminated (str, what, where)+ return nil, strlen (str) + 1, "unterminated " .. what .. " at " .. loc (str, where)+end++local function scanwhite (str, pos)+ while true do+ pos = strfind (str, "%S", pos)+ if not pos then return nil end+ local sub2 = strsub (str, pos, pos + 1)+ if sub2 == "\239\187" and strsub (str, pos + 2, pos + 2) == "\191" then+ -- UTF-8 Byte Order Mark+ pos = pos + 3+ elseif sub2 == "//" then+ pos = strfind (str, "[\n\r]", pos + 2)+ if not pos then return nil end+ elseif sub2 == "/*" then+ pos = strfind (str, "*/", pos + 2)+ if not pos then return nil end+ pos = pos + 2+ else+ return pos+ end+ end+end++local escapechars = {+ ["\""] = "\"", ["\\"] = "\\", ["/"] = "/", ["b"] = "\b", ["f"] = "\f",+ ["n"] = "\n", ["r"] = "\r", ["t"] = "\t"+}++local function unichar (value)+ if value < 0 then+ return nil+ elseif value <= 0x007f then+ return strchar (value)+ elseif value <= 0x07ff then+ return strchar (0xc0 + floor(value/0x40),+ 0x80 + (floor(value) % 0x40))+ elseif value <= 0xffff then+ return strchar (0xe0 + floor(value/0x1000),+ 0x80 + (floor(value/0x40) % 0x40),+ 0x80 + (floor(value) % 0x40))+ elseif value <= 0x10ffff then+ return strchar (0xf0 + floor(value/0x40000),+ 0x80 + (floor(value/0x1000) % 0x40),+ 0x80 + (floor(value/0x40) % 0x40),+ 0x80 + (floor(value) % 0x40))+ else+ return nil+ end+end++local function scanstring (str, pos)+ local lastpos = pos + 1+ local buffer, n = {}, 0+ while true do+ local nextpos = strfind (str, "[\"\\]", lastpos)+ if not nextpos then+ return unterminated (str, "string", pos)+ end+ if nextpos > lastpos then+ n = n + 1+ buffer[n] = strsub (str, lastpos, nextpos - 1)+ end+ if strsub (str, nextpos, nextpos) == "\"" then+ lastpos = nextpos + 1+ break+ else+ local escchar = strsub (str, nextpos + 1, nextpos + 1)+ local value+ if escchar == "u" then+ value = tonumber (strsub (str, nextpos + 2, nextpos + 5), 16)+ if value then+ local value2+ if 0xD800 <= value and value <= 0xDBff then+ -- we have the high surrogate of UTF-16. Check if there is a+ -- low surrogate escaped nearby to combine them.+ if strsub (str, nextpos + 6, nextpos + 7) == "\\u" then+ value2 = tonumber (strsub (str, nextpos + 8, nextpos + 11), 16)+ if value2 and 0xDC00 <= value2 and value2 <= 0xDFFF then+ value = (value - 0xD800) * 0x400 + (value2 - 0xDC00) + 0x10000+ else+ value2 = nil -- in case it was out of range for a low surrogate+ end+ end+ end+ value = value and unichar (value)+ if value then+ if value2 then+ lastpos = nextpos + 12+ else+ lastpos = nextpos + 6+ end+ end+ end+ end+ if not value then+ value = escapechars[escchar] or escchar+ lastpos = nextpos + 2+ end+ n = n + 1+ buffer[n] = value+ end+ end+ if n == 1 then+ return buffer[1], lastpos+ elseif n > 1 then+ return concat (buffer), lastpos+ else+ return "", lastpos+ end+end++local scanvalue -- forward declaration++local function scantable (what, closechar, str, startpos, nullval, objectmeta, arraymeta)+ local tbl, n = {}, 0+ local pos = startpos + 1+ if what == 'object' then+ setmetatable (tbl, objectmeta)+ else+ setmetatable (tbl, arraymeta)+ end+ while true do+ pos = scanwhite (str, pos)+ if not pos then return unterminated (str, what, startpos) end+ local char = strsub (str, pos, pos)+ if char == closechar then+ return tbl, pos + 1+ end+ local val1, err+ val1, pos, err = scanvalue (str, pos, nullval, objectmeta, arraymeta)+ if err then return nil, pos, err end+ pos = scanwhite (str, pos)+ if not pos then return unterminated (str, what, startpos) end+ char = strsub (str, pos, pos)+ if char == ":" then+ if val1 == nil then+ return nil, pos, "cannot use nil as table index (at " .. loc (str, pos) .. ")"+ end+ pos = scanwhite (str, pos + 1)+ if not pos then return unterminated (str, what, startpos) end+ local val2+ val2, pos, err = scanvalue (str, pos, nullval, objectmeta, arraymeta)+ if err then return nil, pos, err end+ tbl[val1] = val2+ pos = scanwhite (str, pos)+ if not pos then return unterminated (str, what, startpos) end+ char = strsub (str, pos, pos)+ else+ n = n + 1+ tbl[n] = val1+ end+ if char == "," then+ pos = pos + 1+ end+ end+end++scanvalue = function (str, pos, nullval, objectmeta, arraymeta)+ pos = pos or 1+ pos = scanwhite (str, pos)+ if not pos then+ return nil, strlen (str) + 1, "no valid JSON value (reached the end)"+ end+ local char = strsub (str, pos, pos)+ if char == "{" then+ return scantable ('object', "}", str, pos, nullval, objectmeta, arraymeta)+ elseif char == "[" then+ return scantable ('array', "]", str, pos, nullval, objectmeta, arraymeta)+ elseif char == "\"" then+ return scanstring (str, pos)+ else+ local pstart, pend = strfind (str, "^%-?[%d%.]+[eE]?[%+%-]?%d*", pos)+ if pstart then+ local number = str2num (strsub (str, pstart, pend))+ if number then+ return number, pend + 1+ end+ end+ pstart, pend = strfind (str, "^%a%w*", pos)+ if pstart then+ local name = strsub (str, pstart, pend)+ if name == "true" then+ return true, pend + 1+ elseif name == "false" then+ return false, pend + 1+ elseif name == "null" then+ return nullval, pend + 1+ end+ end+ return nil, pos, "no valid JSON value at " .. loc (str, pos)+ end+end++local function optionalmetatables(...)+ if select("#", ...) > 0 then+ return ...+ else+ return {__jsontype = 'object'}, {__jsontype = 'array'}+ end+end++function json.decode (str, pos, nullval, ...)+ local objectmeta, arraymeta = optionalmetatables(...)+ return scanvalue (str, pos, nullval, objectmeta, arraymeta)+end++function json.use_lpeg ()+ local g = require ("lpeg")++ if type(g.version) == 'function' and g.version() == "0.11" then+ error "due to a bug in LPeg 0.11, it cannot be used for JSON matching"+ end++ local pegmatch = g.match+ local P, S, R = g.P, g.S, g.R++ local function ErrorCall (str, pos, msg, state)+ if not state.msg then+ state.msg = msg .. " at " .. loc (str, pos)+ state.pos = pos+ end+ return false+ end++ local function Err (msg)+ return g.Cmt (g.Cc (msg) * g.Carg (2), ErrorCall)+ end++ local function ErrorUnterminatedCall (str, pos, what, state)+ return ErrorCall (str, pos - 1, "unterminated " .. what, state)+ end++ local SingleLineComment = P"//" * (1 - S"\n\r")^0+ local MultiLineComment = P"/*" * (1 - P"*/")^0 * P"*/"+ local Space = (S" \n\r\t" + P"\239\187\191" + SingleLineComment + MultiLineComment)^0++ local function ErrUnterminated (what)+ return g.Cmt (g.Cc (what) * g.Carg (2), ErrorUnterminatedCall)+ end++ local PlainChar = 1 - S"\"\\\n\r"+ local EscapeSequence = (P"\\" * g.C (S"\"\\/bfnrt" + Err "unsupported escape sequence")) / escapechars+ local HexDigit = R("09", "af", "AF")+ local function UTF16Surrogate (match, pos, high, low)+ high, low = tonumber (high, 16), tonumber (low, 16)+ if 0xD800 <= high and high <= 0xDBff and 0xDC00 <= low and low <= 0xDFFF then+ return true, unichar ((high - 0xD800) * 0x400 + (low - 0xDC00) + 0x10000)+ else+ return false+ end+ end+ local function UTF16BMP (hex)+ return unichar (tonumber (hex, 16))+ end+ local U16Sequence = (P"\\u" * g.C (HexDigit * HexDigit * HexDigit * HexDigit))+ local UnicodeEscape = g.Cmt (U16Sequence * U16Sequence, UTF16Surrogate) + U16Sequence/UTF16BMP+ local Char = UnicodeEscape + EscapeSequence + PlainChar+ local String = P"\"" * (g.Cs (Char ^ 0) * P"\"" + ErrUnterminated "string")+ local Integer = P"-"^(-1) * (P"0" + (R"19" * R"09"^0))+ local Fractal = P"." * R"09"^0+ local Exponent = (S"eE") * (S"+-")^(-1) * R"09"^1+ local Number = (Integer * Fractal^(-1) * Exponent^(-1))/str2num+ local Constant = P"true" * g.Cc (true) + P"false" * g.Cc (false) + P"null" * g.Carg (1)+ local SimpleValue = Number + String + Constant+ local ArrayContent, ObjectContent++ -- The functions parsearray and parseobject parse only a single value/pair+ -- at a time and store them directly to avoid hitting the LPeg limits.+ local function parsearray (str, pos, nullval, state)+ local obj, cont+ local start = pos+ local npos+ local t, nt = {}, 0+ repeat+ obj, cont, npos = pegmatch (ArrayContent, str, pos, nullval, state)+ if cont == 'end' then+ return ErrorUnterminatedCall (str, start, "array", state)+ end+ pos = npos+ if cont == 'cont' or cont == 'last' then+ nt = nt + 1+ t[nt] = obj+ end+ until cont ~= 'cont'+ return pos, setmetatable (t, state.arraymeta)+ end++ local function parseobject (str, pos, nullval, state)+ local obj, key, cont+ local start = pos+ local npos+ local t = {}+ repeat+ key, obj, cont, npos = pegmatch (ObjectContent, str, pos, nullval, state)+ if cont == 'end' then+ return ErrorUnterminatedCall (str, start, "object", state)+ end+ pos = npos+ if cont == 'cont' or cont == 'last' then+ t[key] = obj+ end+ until cont ~= 'cont'+ return pos, setmetatable (t, state.objectmeta)+ end++ local Array = P"[" * g.Cmt (g.Carg(1) * g.Carg(2), parsearray)+ local Object = P"{" * g.Cmt (g.Carg(1) * g.Carg(2), parseobject)+ local Value = Space * (Array + Object + SimpleValue)+ local ExpectedValue = Value + Space * Err "value expected"+ local ExpectedKey = String + Err "key expected"+ local End = P(-1) * g.Cc'end'+ local ErrInvalid = Err "invalid JSON"+ ArrayContent = (Value * Space * (P"," * g.Cc'cont' + P"]" * g.Cc'last'+ End + ErrInvalid) + g.Cc(nil) * (P"]" * g.Cc'empty' + End + ErrInvalid)) * g.Cp()+ local Pair = g.Cg (Space * ExpectedKey * Space * (P":" + Err "colon expected") * ExpectedValue)+ ObjectContent = (g.Cc(nil) * g.Cc(nil) * P"}" * g.Cc'empty' + End + (Pair * Space * (P"," * g.Cc'cont' + P"}" * g.Cc'last' + End + ErrInvalid) + ErrInvalid)) * g.Cp()+ local DecodeValue = ExpectedValue * g.Cp ()++ jsonlpeg.version = json.version+ jsonlpeg.encode = json.encode+ jsonlpeg.null = json.null+ jsonlpeg.quotestring = json.quotestring+ jsonlpeg.addnewline = json.addnewline+ jsonlpeg.encodeexception = json.encodeexception+ jsonlpeg.using_lpeg = true++ function jsonlpeg.decode (str, pos, nullval, ...)+ local state = {}+ state.objectmeta, state.arraymeta = optionalmetatables(...)+ local obj, retpos = pegmatch (DecodeValue, str, pos, nullval, state)+ if state.msg then+ return nil, state.pos, state.msg+ else+ return obj, retpos+ end+ end++ -- cache result of this function:+ json.use_lpeg = function () return jsonlpeg end+ jsonlpeg.use_lpeg = json.use_lpeg++ return jsonlpeg+end++if always_use_lpeg then+ return json.use_lpeg()+end++return json+
+ doc/ghci-doc.pdf view
binary file changed (absent → 86148 bytes)
+ doc/ghci-doc.tex view
@@ -0,0 +1,438 @@++\documentclass{article}++%include polycode.fmt++\usepackage[margin=1.7in]{geometry}+\usepackage{xcolor}+\usepackage{listings}+\usepackage{ghci}++\usepackage{tabularx}++\usepackage{hyperref}++\usepackage[most]{tcolorbox}+\tcbuselibrary{listingsutf8}++\newtcolorbox{latexbox}{+ enhanced,+ colback=white,+ colframe=black,+ fonttitle=\bfseries,+ listing only,+ listing options={+ basicstyle=\ttfamily\small,+ breaklines=true,+ columns=fullflexible,+ escapeinside={(*@}{@*)},+ language=[LaTeX]TeX+ },+ sharp corners,+ boxrule=0.8pt,+ breakable+}++\lstset{%+ language=[AlLaTeX]TeX,+ alsolanguage=MetaPost,+ texcsstyle=\color{blue},+ moretexcs={hask },+ basicstyle=\ttfamily,+ alsoother={0123456789$_$},%+}++\newtcolorbox{warningbox}{+ colback=yellow!10,+ colframe=orange!40,+ coltitle=black,+ title=\faExclamationTriangle\quad Warning,+ fonttitle=\bfseries,+ sharp corners,+ boxrule=1pt,+ left=1em,+ right=1em,+ top=0.8em,+ bottom=0.8em,+ breakable+}+++\newtcolorbox{infobox}{+ colback=blue!10,+ colframe=blue!80!black,+ coltitle=black,+ title=\faInfoCircle\quad Information,+ fonttitle=\bfseries,+ sharp corners,+ boxrule=1pt,+ left=1em,+ right=1em,+ top=0.8em,+ bottom=0.8em,+ breakable+}++\newtcolorbox{tipbox}{+ colback=green!7,+ colframe=green!80!black!40,+ coltitle=black,+ title=\faLightbulbO\quad Tip,+ fonttitle=\bfseries,+ sharp corners,+ boxrule=1pt,+ left=1em,+ right=1em,+ top=0.8em,+ bottom=0.8em,+ breakable+}+++\usepackage{fontawesome} % for \faExclamationTriangle icon++++%format ghci4luatex = "\text{GHCi for Lua\TeX}"+%format luatex = "\text{Lua\TeX}"++\title{|ghci4luatex| \\ \vspace{0.4em}+ \large A persistent ghci session in |luatex|}++\author{Alice Rixte}++\begin{document}++\maketitle+\tableofcontents++\newpage++\section{Introduction}+++|ghci4luatex| provides a persistent GHCi session within a \LaTeX\ document. Using the \texttt{ghci} package via \texttt{\textbackslash \tex {\color{blue} usepackage}\{ghci\}}, it mainly provides the \texttt{ghci} environment and the \texttt{hask} command which can be used as follows:++\begin{latexbox}+ \begin{lstlisting}{language=[AlLaTeX]TeX}+\begin{ghci}+x :: Int+x = 4++y :: Int+y = 5+\end{ghci}++The sum of $x$ and $y$ when $x = \hask{x}$+and $y = \hask{y}$ is $\hask{x + y}$.++\end{lstlisting}+\end{latexbox}++\section{Getting started}++In order to execute the Haskell code, the \texttt{ghci4luatex} server must be running. If you are concerned with security issues, you are encouraged to verify the source code at \href{https://github.com/AliceRixte/ghci4luatex/}{github.com/AliceRixte/ghci4luatex/}. In particular, you can make sure that++\begin{itemize}+ \item the \texttt{ghci.sty} package can only connect to the local address \texttt{127.0.0.1} and will not attempt to connect to any external service+ \item the \texttt{ghci4luatex} server only processes the commands sent by \texttt{ghci.sty}+\end{itemize}++\subsection{Installing the \texttt{ghci4luatex} server}++You can install \texttt{ghci4luatex} either using Cabal, Stack, or directly from source. In all cases, you must have Haskell installed as well as cabal or stack.++To check that \texttt{ghci4luatex} is properly installed, run++\begin{verbatim}+ ghci4luatex --version+\end{verbatim}+Modulo the version, this should produce de following output \texttt{ghci4luatex v0.1, (C) Alice Rixte}++\paragraph{Using \href{https://www.haskell.org/cabal/}{cabal}}++\begin{verbatim}+ cabal install ghci4luatex+\end{verbatim}++\paragraph{Using \href{https://docs.haskellstack.org/en/stable/}{stack}}++\begin{verbatim}+ stack install ghci4luatex+\end{verbatim}++\paragraph{From \href{https://github.com/AliceRixte/ghci4luatex/}{source}}++\begin{verbatim}+ git clone https://github.com/AliceRixte/ghci4luatex.git+ cd ghci4luatex+ stack install+\end{verbatim}++\paragraph{Verifying the installation was successful}+To check that \texttt{ghci4luatex} is properly installed, run++\begin{verbatim}+ ghci4luatex --version+\end{verbatim}+Modulo the version, this should produce the following output++\begin{verbatim}+ ghci4luatex v0.1, (C) Alice Rixte+\end{verbatim}+\subsection{Installing the \texttt{ghci} package}++To install the \texttt{ghci} package for Lua\TeX, you can use either your package manager or install it from source.++\paragraph{Using TeX Live (not yet supported).}+\begin{verbatim}+ tlmgr install ghci+\end{verbatim}+\paragraph{Using MiKTeX (not yet supported). }+\begin{verbatim}+ mpm --admin --install=ghci+\end{verbatim}+\paragraph{From source}+Copy both \texttt{ghci.sty} and \texttt{dkjson.lua} inside the root directory of the Latex file you want to use \texttt{ghci4luatex} in.++Both these files can be found at the root of the \texttt{ghci4luatex} repository: \href{https://github.com/AliceRixte/ghci4luatex/}{github.com/AliceRixte/ghci4luatex/}++\subsection{Running the \texttt{ghci4luatex} server}++Once both \texttt{ghci4luatex} and the \texttt{ghci} package are installed, simply run the following in the same directory you will use LuaTeX:++\begin{verbatim}+ ghci4luatex+\end{verbatim}++The server should remain active while you are working on your file. You should not close it between consecutive compilations as it performs memoization to make the compilation faster.++\begin{tipbox}+Always have a terminal with \texttt{ghci4luatex} running, it will give you clearer error messages from GHCi, and will show you which Haskell expressions are recomputed and which are not.+\end{tipbox}+++Once \texttt{ghci4luatex} is running, you can execute LuaTeX with++\begin{verbatim}+ lualatex -shell-escape myFile.tex+\end{verbatim}++or use \texttt{latexmk} using the luatex option:++\begin{verbatim}+ latexmk -lualatex -shell-escape myFile.tex+\end{verbatim}++\begin{warningbox}+ Without the \texttt{-shell-escape} option, the compilation will fail, complaining about not finding the \texttt{'socket'} file.+\end{warningbox}++\section{The \texttt{ghci4luatex} server}++The \texttt{ghci4luatex} provides a few options that can be listed by invoking \texttt{ghci4luatex --help}. In particular:++\begin{description}+ \item[--command] Allows using cabal or stack to run GHCi. For instance, you can run \begin{itemize}+ \item \texttt{ghci4luatex --command="cabal repl"}+ \item \texttt{ghci4luatex --command="stack ghci"}+ \end{itemize}+ \item[--verbose] This will show which commands were memoized.+ \item[--quiet] Except for errors due to the server (not GHCi error dumps), \texttt{ghci4luatex} will be completely silent.+ \item[--host and --port] Change the host address and port. Notice that this requires you to also change the host and port in \texttt{ghci.sty}. Using these options is discouraged.+\end{description}+++\section{The \texttt{ghci.sty} package}++The \texttt{ghci} package can both execute Haskell code snippets and GHCi commands thanks to the \texttt{ghci} environment and print the result to LaTeX with the \texttt{\textbackslash hask} command.++\subsection{Running Haskell code: the \texttt{ghci} environment}++To execute some Haskell code without printing anything to LaTeX, you can use the \texttt{ghci} environment. \texttt{ghci4luatex} will always surround the code between \texttt{\textbackslash \tex {\color{blue} begin}\{ghci\}} and \texttt{\textbackslash \tex {\color{blue} end}\{ghci\}} by \texttt{:\{} and \texttt{:\}} so that GHCi knows this is a multiple line command.++\begin{latexbox}+\begin{lstlisting}{language=[AlLaTeX]TeX}+\begin{ghci}+x :: Int+x = 4++y :: Int+y = 5+\end{ghci}+\end{lstlisting}+\end{latexbox}++\paragraph{Using GHCi commands} You can also send GHCi commands (i.e. starting with `:`), for instance to load extensions:++ \begin{lstlisting}{language=[AlLaTeX]TeX}+ \begin{ghci}+ :set -XOverloadedStrings+ \end{ghci}+ \end{lstlisting}++\begin{warningbox}+ Since the code is always enclosed within \texttt{:\{} and \texttt{:\}}, this means you can only give one GHCi command (i.e. starting with `:`) at a time. The following will fail with the message \texttt{unrecognised flag: :set}+ \begin{lstlisting}{language=[AlLaTeX]TeX}+ \begin{ghci}+ :set -XOverloadedStrings+ :set -XOverloadedLists+ \end{ghci}+ \end{lstlisting}+\end{warningbox}+++\paragraph{Importing modules}+You can use the \texttt{ghci} environment to import any module you need, it will be available throughout the whole file.++\begin{lstlisting}{language=[AlLaTeX]TeX}+\begin{ghci}+import Data.Functor+import Control.Monad+\end{ghci}+\end{lstlisting}++If you need to import modules on Hackage, you can use \texttt{:set -package some-package}. To load your own modules, use \texttt{:l}.++\begin{tipbox}+ You can directly load all the modules of your own package as well as all of the dependencies listed in your \texttt{.cabal} (or \texttt{package.yaml} file) by running \texttt{ghci4luatex --command="cabal repl"} or \texttt{ghci4luatex --command="stack ghci"}.+\end{tipbox}++\subsection{Printing the result: the \texttt{hask} command}++You can use Haskell to output LaTeX code. For instance, \texttt{\$\textbackslash \tex {\color{blue} hask}\{1+2\}\$} will print $\hask{1 + 2}$.+++The result printed by GHCi can also be LaTeX expressions. For instance,++\begin{lstlisting}{language=[AlLaTeX]TeX}+ \hask{putStrLn "\\emph{I was written by GHCi}"}.+\end{lstlisting}+\noindent+will produce \hask{putStrLn "\\emph{I was written by GHCi}"}.++++\subsection{Advanced usage: managing memoization}++To reduce the compilation time of LuaTeX, the result of the execution of Haskell code snippets is stored in the server in order to avoid recomputing them. This is called \emph{memoization}.++You can see this at work in the output of the \texttt{ghci4luatex} server: if you modify your LaTeX document without changing any of the commands, the server will only print++\begin{lstlisting}{language=[AlLaTeX]TeX}+ --- New session : "main"---+\end{lstlisting}++\begin{tipbox}+ To see which results are memoized and which are recomputed, you can use the \texttt{--verbose} option when running \texttt{ghci4luatex}.+\end{tipbox}+++If you modify one of the Haskell snippets, \texttt{ghci4luatex} will have to recompute all of the snippets that appear after the one you modified.++The reason for this is that if you declare a variable, for instance by writing \texttt{x = 4}, and you then modify it to \texttt{x = 5}, all the subsequent code that uses \texttt{x} has to be updated, and therefore recomputed by \texttt{ghci4luatex}.++\medskip++\paragraph{Using \texttt{\textbackslash ghcisession}}+When dealing with big documents that contain a lot of Haskell code that might generate some figures, it can become painfully slow to recompile a document when changing one of the first code snippets that appear in the document.++For this reason, you can tell \texttt{ghci4luatex} to create a new session, by using the command++\begin{lstlisting}{language=[AlLaTeX]TeX}+\ghcisession{mySession}+\end{lstlisting}++This way, if you modify any of the code snippets before you started \texttt{mySession}, the server will not recompile the code snippets that appear \emph{after} \texttt{\textbackslash ghcisession}++\begin{warningbox}+ The \texttt{ghci4luatex} server actually \emph{does not} spawn a new GHCi process for each new session.++ Instead, it only affects the memoization and there is actually only one GHCi process. This means that if you declare a variable \texttt{x = 4} then declare a new session, this variable will still be in the session scope.+\end{warningbox}++\paragraph{Using \texttt{\textbackslash ghcicontinue}} If you want to continue a previously defined session, for instance the default session \texttt{"main"} you can use++\begin{lstlisting}{language=[AlLaTeX]TeX}+\ghcicontinue{main}+\end{lstlisting}++Notice that this only affects memoization and does not actually switch between different GHCi processes.++\begin{tipbox}+ If you want to make sure to recompile all Haskell code of your document, simply kill \texttt{ghci4luatex} and start a new one.+\end{tipbox}+++\section{Usage with Haskell libraries}++Any Haskell library can be used in conjunction with \texttt{ghci4luatex}. Here, we present only a selection along with common usage examples. Feel free to add your own suggestions by opening a pull request \href{https://github.com/AliceRixte/ghci4luatex/}{github.com/AliceRixte/ghci4luatex/}.+++Usage for all these libraries can be found in \texttt{examples/main.tex} at the \texttt{ghci4luatex} repository.++\subsection{\href{https://hackage.haskell.org/package/lhs2tex}{lhs2TeX} and \href{https://daniel-diaz.github.io/projects/haskintex/}{HaskinTeX}}++Any preprocessor can be used in conjunction with \texttt{ghci4luatex}, since it is a proper LaTeX package and not a preprocessor itself.++Simply run the preprocessor and use \texttt{ghci4luatex} as usual.++\subsection{\href{https://hackage.haskell.org/package/HaTeX}{HaTeX}}++You can use HaTeX to generate some LaTeX code. To use it in conjunction with \texttt{ghci4luatex}, you need to print the latex code in GHCi.++A simple way to do so is to write the following:++\begin{latexbox}+ \begin{lstlisting}{language=[AlLaTeX]TeX}+\begin{ghci}+:set -XOverloadedStrings+\end{ghci}++\begin{ghci}+import Text.LaTeX++printTex = putStrLn . prettyLateX+\end{ghci}+\end{lstlisting}+\end{latexbox}++You can then use the \texttt{printTex} function with the \texttt{\textbackslash hask} command:++\begin{lstlisting}{language=[AlLaTeX]TeX}+\hask{printTex (section "A section using HaTeX")}+\end{lstlisting}++\subsection{\href{https://diagrams.github.io/}{Diagrams}}++Diagrams is a domain-specific language for drawing vector graphics. It already has a dedicated LaTeX package, \href{https://archives.haskell.org/projects.haskell.org/diagrams/doc/latex.html}{diagrams-latex} you should definitely consider using. Still, \texttt{ghci4luatex} has some advantage over \texttt{diagrams-latex}, mainly the persistency of the GHCi session. Here is a complete example with the \texttt{svg} package:++\begin{latexbox}+ \begin{lstlisting}{language=[AlLaTeX]TeX}+\begin{ghci}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}++import Diagrams.Prelude hiding (section)+import Diagrams.Backend.SVG++myDia = circle 1 # fc green+\end{ghci}++\begin{ghci}+ renderSVG "myDia.svg" (dims2D 400 300) myDia+\end{ghci}++\begin{figure}[h]+ \centering+ \includesvg[width=0.2\textwidth]{myDia}+ \caption{A circle using Diagrams}+\end{figure}++\end{lstlisting}+\end{latexbox}++++\end{document}
+ ghci.sty view
@@ -0,0 +1,142 @@+\RequirePackage{luatex85}+\RequirePackage{luacode}+\ProvidesPackage{ghci}[2025/06/24 v0.1 GHCi code execution with TCP via Lua]++\newif\ifghciready+\ghcireadyfalse++\newcommand{\ghciserverhost}{localhost}+\newcommand{\ghciserverport}{54123}++\directlua{+ socket = require("socket")+ json = require("dkjson")+ client = socket.connect("\ghciserverhost", \ghciserverport)+}++\begin{luacode*}++function newGhciSession(str)+ local msg = {+ tag = "ServerMsg",+ contents = {+ tag = "NewSession",+ contents = str+ }+ }+ if client then+ client:send(json.encode(msg))+ end+end++function continueGhciSession(str)+ local msg = {+ tag = "ServerMsg",+ contents = {+ tag = "ContinueSession",+ contents = str+ }+ }+ if client then+ client:send(json.encode(msg))+ end+end++newGhciSession("main")++\end{luacode*}+++\begin{luacode*}+function ghciCmd(code)+ local msg = {+ tag = "GhciMsg",+ contents = code+ }+ return json.encode(msg)+end++++function ghci_eval(code)+ if client then+ client:send(ghciCmd(code))+ local response_str, err = client:receive("*l")+ if response_str then+ local response, _ , decode_err = json.decode(response_str)+ if decode_err then+ tex.error("Could not decode JSON from GHCi server : " .. decode_err)+ else+ if response.ghciErr and response.ghciErr ~= '' then+ luatexbase.module_warning+ ("ghci", response.ghciErr)+ end+ return (response.ghciOut:gsub("%s*$", ""))+ -- remove trailing spaces+ end+ else+ tex.error("Reception error from GHCi server : " .. err)+ end+ return response_str+ else+ luatexbase.module_warning("ghci" , "GHCi server is not running. Please start it before using ghci4luatex.")+ return ""+ end+end+\end{luacode*}++\begin{luacode*}+ local mybuf = ""+ local current_end_marker = "\\end{ghci}"++ function readbuf(buf)+ if buf:match('%s*' .. current_end_marker) then+ return buf+ end+ mybuf = mybuf .. buf .. "\n"+ return ""+ end++ function startRecording(envname)+ mybuf = ""+ current_end_marker = "\\end{" .. envname .. "}"+ luatexbase.add_to_callback('process_input_buffer', readbuf, 'readbuf')+ end++ function stopRecording(should_print)+ luatexbase.remove_from_callback('process_input_buffer', 'readbuf')+ local buf_without_end = mybuf:gsub(current_end_marker .. "\n", "")+ local res = ghci_eval(buf_without_end)+ if should_print then+ tex.print(res)+ end+ end+\end{luacode*}++\newenvironment{ghci}+ {\directlua{startRecording("ghci")}}+ {\directlua{stopRecording(false)}}++\newenvironment{printghci}+ {\directlua{startRecording("printghci")}}+ {\directlua{stopRecording(true)}}++\newcommand{\hask}[1]{%+ \directlua{+ local result = ghci_eval([===[#1]===])+ tex.print(result)+ }%+}++\newcommand{\ghcisession}[1]{%+ \directlua{+ newGhciSession([===[#1]===])+ }%+}++\newcommand{\ghcicontinue}[1]{%+ \directlua{+ continueGhciSession([===[#1]===])+ }%+}+
+ ghci4luatex.cabal view
@@ -0,0 +1,102 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.37.0.+--+-- see: https://github.com/sol/hpack++name: ghci4luatex+version: 0.0+synopsis: A GHCi session in LaTeX+description: Please see the README on GitHub at <https://github.com/AliceRixte/pandia/blob/main/ghci4luatex#readme>+category: Latex, Program+homepage: https://github.com/AliceRixte/ghci4luatex#readme+bug-reports: https://github.com/AliceRixte/ghci4luatex/issues+author: Alice Rixte+maintainer: alice.rixte@u-bordeaux.fr+copyright: Copyright (C) 2025 Alice Rixte+license: BSD-3-Clause+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ dkjson.lua+ ghci.sty+extra-doc-files:+ CHANGELOG.md+ doc/ghci-doc.pdf+ doc/ghci-doc.tex++source-repository head+ type: git+ location: https://github.com/AliceRixte/ghci4luatex++library+ exposed-modules:+ Data.Memoizer.Commands+ Data.Memoizer.Sessions+ System.Process.Ghci+ other-modules:+ Paths_ghci4luatex+ autogen-modules:+ Paths_ghci4luatex+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ aeson ==2.2.*+ , base >=4.18 && <5+ , bytestring ==0.12.*+ , cmdargs ==0.10.*+ , containers ==0.6.*+ , network-simple ==0.4.*+ , process >=1.6.25 && <1.7+ , stm ==2.5.*+ , text ==2.1.*+ default-language: Haskell2010++executable ghci4luatex+ main-is: ghci4luatex.hs+ other-modules:+ Paths_ghci4luatex+ autogen-modules:+ Paths_ghci4luatex+ hs-source-dirs:+ app+ ghc-options: -Wall -rtsopts -with-rtsopts=-N -threaded+ build-depends:+ aeson ==2.2.*+ , base >=4.18 && <5+ , bytestring ==0.12.*+ , cmdargs ==0.10.*+ , containers ==0.6.*+ , ghci4luatex+ , network-simple ==0.4.*+ , process >=1.6.25 && <1.7+ , stm ==2.5.*+ , text ==2.1.*+ default-language: Haskell2010++test-suite ghci4luatex-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_ghci4luatex+ autogen-modules:+ Paths_ghci4luatex+ hs-source-dirs:+ test+ ghc-options: -Wall+ build-depends:+ QuickCheck ==2.14.*+ , aeson ==2.2.*+ , base >=4.18 && <5+ , bytestring ==0.12.*+ , cmdargs ==0.10.*+ , containers ==0.6.*+ , ghci4luatex+ , hspec >=2.11+ , network-simple ==0.4.*+ , process >=1.6.25 && <1.7+ , stm ==2.5.*+ , text ==2.1.*+ default-language: Haskell2010
+ src/Data/Memoizer/Commands.hs view
@@ -0,0 +1,141 @@+--------------------------------------------------------------------------------+-- |+--+-- Module : Data.Memoizer.Commands+-- Description : A memoizer for sequences of commands+-- Copyright : (c) Alice Rixte 2024+-- License : BSD 3+-- Maintainer : alice.rixte@u-bordeaux.fr+-- Stability : unstable+-- Portability : portable+--+-- A data structure to memoize the result of the execution of a sequence of+-- commands.+--+-- As long as the sequence of commands is identical to the one memoized, we can+-- avoid executing them. As soon as there is one command that differs from the+-- memoized sequence, then we should discard all remaining memoized results.+--+-- = Usage+--+--+-- Let's store the result of some commands (we alternate between @memo@ and+-- @memo'@ to avoid recursive definitions)+--+-- >>> import Prelude hiding (lookup)+-- >>> memo' = storeResult "x=1" "" empty :: CmdMemoizer String String+-- >>> memo = storeResult "y=2" "" memo'+-- >>> memo' = storeResult "x+y" "3" memo+--+--+--+-- Suppose there are no more commands in the sequence. Now we want to execute+-- that sequence of commands again but some commands may have changed in+-- between. We use memoized commands as long as all commands are equal to the+-- previous ones:+--+-- >>> memo = restart memo'+-- >>> lookup "x=1" memo+-- Just ""+--+-- Since the command was memoized, we avoid executing is again. Now suppose the command @"y=2"@ was replaced by @"y=3"@+--+-- >>> memo' = nextCmd memo+-- >>> lookup "y=3" memo'+-- Nothing+--+-- Since the command was not memoized, we have to execute it:+--+-- >>> memo = storeResult "y=3" "" memo'+--+-- Now none of the subsequent commands will use the memoized version:+--+-- >>> memo' = nextCmd memo+-- >>> lookup "x+y" memo'+-- Nothing+--+--------------------------------------------------------------------------------++module Data.Memoizer.Commands+ ( CmdMemoizer+ , empty+ , storeResult+ , deleteResult+ , lookup+ , restart+ , nextCmd+ )+where+++import Prelude hiding (lookup)++import qualified Data.IntMap as Map++-- | A container for the memoized result of the execution of a sequence of+-- commands+--+-- * @a@ is the type of commands+-- * @b@ is the type of results+--+data CmdMemoizer a b = CmdMemoizer+ { memoizerMap :: Map.IntMap (a,b)+ , currentIndex :: Int+ , foundModif :: Bool+ }+ deriving (Show, Eq)++-- | Memoizer of an empty sequence of commands+--+empty :: CmdMemoizer a b+empty = CmdMemoizer Map.empty 0 False++-- | Restart the sequence of commands+--+-- Memoized results will now be accessible until @'storeResult'@ or+-- @'deleteResult'@ are used.+--+restart :: CmdMemoizer a b -> CmdMemoizer a b+restart m = m {currentIndex = 0, foundModif = False}+++-- | Store the result of the execution of a command.+--+-- This will override the current memoized command, and prevent access to+-- any memoized result until @'restart'@ is used.+--+storeResult :: a -> b -> CmdMemoizer a b -> CmdMemoizer a b+storeResult a b (CmdMemoizer m i _) =+ CmdMemoizer (Map.insert i (a,b) m) (i+1) True++-- | Delete the result of the current memoized command.+--+-- This will override the current memoized command, and prevent access to any+-- memoized result until @'restart'@ is used.+--+deleteResult :: CmdMemoizer a b -> CmdMemoizer a b+deleteResult (CmdMemoizer m i _) = CmdMemoizer (Map.delete i m) (i+1) True+++-- | Access the memoized result of a command if it is equal to the current+-- memoized command+--+lookup :: Eq a => a -> CmdMemoizer a b -> Maybe b+lookup a (CmdMemoizer m i modif) =+ if modif then+ Nothing+ else+ case Map.lookup i m of+ Nothing -> Nothing+ Just (a', b) ->+ if a == a' then+ Just b+ else+ Nothing++-- | Move to the next memoized command+--+nextCmd :: CmdMemoizer a b -> CmdMemoizer a b+nextCmd m = m {currentIndex = currentIndex m + 1 }++
+ src/Data/Memoizer/Sessions.hs view
@@ -0,0 +1,147 @@+--------------------------------------------------------------------------------+-- |+--+-- Module : Data.Memoizer.Session+-- Description : Sessions for command memoizers+-- Copyright : (c) Alice Rixte 2024+-- License : BSD 3+-- Maintainer : alice.rixte@u-bordeaux.fr+-- Stability : unstable+-- Portability : portable+--+-- Memoize several sessions and switch between them.+--+-- This enables the use of the @\\ghcisession{My Session}@ and+-- @\\ghcicontinue{My Session}@ command in the @ghci@ LuaTex package.+--+-- = Usage+--+--+-- Let us store the result of some commands (we alternate between @memo@ and+-- @memo'@ to avoid recursive definitions)+--+-- >>> import Prelude hiding (lookup)+--+-- >>> memo = initSession "main" :: SessionMemoizer String String String+-- >>> memo' = storeResult "x=1" "" memo+-- >>> memo = storeResult "y=2" "" memo'+-- >>> memo' = storeResult "x+y" "3" memo+--+-- Let use create a new session:+--+-- >>> memo = newSession "My Session" memo'+-- >>> memo' = storeResult "a=1" "" memo+--+-- Now if we create a new session called "main" again, we can use the memoized+-- values:+--+-- >>> memo = newSession "main" memo'+-- >>> lookup "x=1" memo+-- Just ""+--+--+-- But we still have some commands to add to "My Session":+--+-- >>> memo' = continueSession "My Session" memo+-- >>> memo = storeResult "a" "1" memo'+--+-- Now let's restart "My Session":+--+-- >>> memo' = newSession "My Session" memo+-- >>> lookup "a=1" memo+-- Just ""+-- >>> memo = nextCmd memo'+-- >>> lookup "a" memo+-- Just "1"+--+--------------------------------------------------------------------------------++module Data.Memoizer.Sessions+ ( SessionMemoizer (..)+ , initSession+ , newSession+ , continueSession+ , storeResult+ , deleteResult+ , lookup+ , nextCmd+ ) where++import Prelude hiding (lookup)+import qualified Data.Memoizer.Commands as Cmd+import qualified Data.Map as Map++-- | A container of memoizers for sequences of commands.+--+-- * @k@ is the key representing the name of a session+-- * @a@ is the type of commands+-- * @b@ is the result of a command+--+data SessionMemoizer k a b = SessionMemoizer+ { sessionMap :: Map.Map k (Cmd.CmdMemoizer a b)+ , currentSession :: k+ }+ deriving (Show,Eq)++undefinedSession :: String+undefinedSession = "UndefinedSession : The current Session does not exist.\+ \ This should never happen. Please report this as a bug."++lookupCmd :: Ord k => SessionMemoizer k a b -> Cmd.CmdMemoizer a b+lookupCmd (SessionMemoizer ms k) = case Map.lookup k ms of+ Nothing -> error $ "lookup : " ++ undefinedSession+ Just m -> m++mapCmd :: Ord k =>+ (Cmd.CmdMemoizer a b -> Cmd.CmdMemoizer a b)+ -> SessionMemoizer k a b -> SessionMemoizer k a b+mapCmd f sm@(SessionMemoizer ms k) =+ sm {sessionMap = Map.insert k (f (lookupCmd sm)) ms }++-------------------------------------------------------------------------------++-- | Create a new session memoizer using a default session.+--+initSession :: Ord k => k -> SessionMemoizer k a b+initSession k = SessionMemoizer (Map.insert k Cmd.empty Map.empty) k++-- | Add a new session to memoize. If that session already existes, it is+-- @'Data.Memoizer.Commands.restart'@ed.+--+newSession :: Ord k => k -> SessionMemoizer k a b -> SessionMemoizer k a b+newSession k (SessionMemoizer ms _) =+ case Map.lookup k ms of+ Nothing -> SessionMemoizer (Map.insert k Cmd.empty ms) k+ Just m -> SessionMemoizer (Map.insert k (Cmd.restart m) ms) k++-- | Continue an existing session.+--+continueSession :: Ord k => k -> SessionMemoizer k a b -> SessionMemoizer k a b+continueSession k m = m {currentSession = k}++-- | Lookup the memoized result of the current session.+--+lookup :: (Eq a, Ord k) => a -> SessionMemoizer k a b -> Maybe b+lookup a = Cmd.lookup a . lookupCmd++-- | Move the current session to the next command.+--+nextCmd :: Ord k => SessionMemoizer k a b -> SessionMemoizer k a b+nextCmd = mapCmd Cmd.nextCmd++-- | Store a result in the current session.+--+-- This will prevent access to any memoized result of the current session until+-- @'newSession'@ is used.+--+storeResult :: Ord k => a -> b -> SessionMemoizer k a b -> SessionMemoizer k a b+storeResult a b = mapCmd (Cmd.storeResult a b)++-- | Delete the current result in the current session.+--+-- This will prevent access to any memoized result of the current session until+-- @'newSession'@ is used.+--+deleteResult :: Ord k+ => SessionMemoizer k a b -> SessionMemoizer k a b+deleteResult = mapCmd Cmd.deleteResult
+ src/System/Process/Ghci.hs view
@@ -0,0 +1,221 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+++--------------------------------------------------------------------------------+-- |+--+-- Module : System.Process.Ghci+-- Description : GHCi as a process+-- Copyright : (c) Alice Rixte 2024+-- License : BSD 3+-- Maintainer : alice.rixte@u-bordeaux.fr+-- Stability : unstable+-- Portability : non-portable (GHC extensions)+--+-- Run GHCi as a process, and execute commands.+--+-- = Usage+--+-- >>> ghci <- startGhci Quiet "ghci" []+-- >>> execGhciCmd ghci Quiet "1+2"+-- GhciResult {ghciErr = "", ghciOut = "3"}+--+--------------------------------------------------------------------------------++module System.Process.Ghci+ ( Ghci (..)+ , startGhci+ , GhciResult (..)+ , execGhciCmd+ )+where++import Control.Exception+import Control.Monad+import Control.Concurrent+import Control.Concurrent.STM+import GHC.Generics+import System.IO+import System.IO.Error+import System.Process+import Data.String+import Data.Text++import System.Console.CmdArgs.Verbosity++++import Data.Aeson++-- | A GHCi process+--+data Ghci = Ghci+ { ghciIn :: Handle -- ^ Standard input+ , ghciErrVar :: TMVar String -- ^ Current line on stderr+ , ghciOutVar :: TMVar String -- ^ Current line on stdout+ , ghciProcess :: ProcessHandle -- ^ Process handle+ , ghciErrId :: ThreadId -- ^ Stderr listener thread+ , ghciOutId :: ThreadId -- ^ Stdout listener thread+ }+++-- | Start a GHCi process.+--+-- >>> ghci = startGhci Normal "ghci" []+--+-- >>> ghci = startGhci Loud "stack" ["ghci"]+--+startGhci ::+ Verbosity -- ^ When @verbosity >= 'Normal'@, the entire output+ -- of GHCi is printed+ -> String -- ^ The command to run (e.g. "ghci", "cabal" or "stack")+ -> [String] -- ^ The list of the command's arguments+ -- (e.g. "repl" for "cabal" or "ghci" for "stack")+ -> IO Ghci+startGhci v cmd args = do+ chans <- createProcess (proc cmd args) { std_in = CreatePipe+ , std_err = CreatePipe+ , std_out = CreatePipe+ }+ case chans of+ (Just hin, Just hout , Just herr , hp) -> do+ verr <- newEmptyTMVarIO+ vout <- newEmptyTMVarIO++ errId <- forkIO $ listenHandle verr herr+ outId <- forkIO $ listenHandle vout hout++ let g = Ghci hin verr vout hp errId outId++ -- the following is very hacky : Sometimes, "stack ghci" may ask some file+ -- to the user. For this reason we send ghci a confirmation for whatever+ -- default values it proposes, then wait for 200 ms to make sur ghci did+ -- receive that answer.+ flushGhciCmd (ghciIn g) "\n"+ threadDelay 2000000 -- wait 200 ms to make sure GHCi is ready to listen++ _ <- waitGhciResult g v++ return g+ _ -> error "Error : Ghci command failed."++-- | Listen to a handle by putting lines into a mutable variable.+--+listenHandle :: TMVar String -> Handle -> IO ()+listenHandle v h =+ catch (forever $ do+ s <- hGetLine h+ atomically $ putTMVar v s) handler+ where+ handler :: IOError -> IO ()+ handler err =+ unless (isEOFError err) $ throw err++-- | Merge stderr and stdout streams.+--+mergeErrOut :: TMVar String -> TMVar String -> IO (Either String String)+mergeErrOut verr vout=+ atomically $ (Left <$> takeTMVar verr) `orElse`+ ( Right . cleanResultString <$> takeTMVar vout)++++-- | The result printed by GHCi.+--+data GhciResult = GhciResult+ { ghciErr :: Text -- Errors and warnings of GHCi+ , ghciOut :: Text -- Output of GHCi+ }+ deriving (Show, Generic)+ deriving Semigroup via Generically GhciResult+ deriving Monoid via Generically GhciResult++instance ToJSON GhciResult where+ toEncoding = genericToEncoding defaultOptions++instance FromJSON GhciResult++-- | Sends a command to ghci and wait for its result.+--+-- >>> execGhciCmd ghci Normal "1+2"+-- GhciResult {ghciErr = "", ghciOut = "3"}+--+execGhciCmd+ :: Ghci -- ^ A GHCi process+ -> Verbosity -- ^ When @verbosity >= Normal@, the entire output+ -- of GHCi is printed+ -> String -- ^ The command to execute+ -> IO GhciResult -- ^ The result of the execution+execGhciCmd g v cmd = do+ flushGhciCmd (ghciIn g) cmd+ waitGhciResult g v++++-- | Wait for GHCi to complete its computation+--+waitGhciResult :: Ghci -> Verbosity -> IO GhciResult+waitGhciResult g v = do++ -- this is a hack : we send a "putStrLn" command to ghci in order to be able+ -- to wait for the result of the command.+ flushGhciCmd (ghciIn g) $ "putStrLn\"" ++ readyString ++ "\"\n"+ loop mempty++ where+ loop acc = do+ s <- mergeErrOut (ghciErrVar g) (ghciOutVar g)+ if s == Right readyString then+ return acc+ else do+ when (v >= Normal) $+ case s of+ Left s' -> do+ hPutStr stderr s'+ hPutChar stderr '\n'+ hFlush stderr+ Right s' -> do+ putStrLn s'+ hFlush stdout+ loop (appendGhciResult acc s)++-- | A very unlikely string that we make ghci print in order to know when ghci+-- is finished.+--+-- This is a hack but it works well. The same hack is used by lhs2tex.+--+readyString :: String+readyString = "`}$/*^`a`('))}{h}"++-- | Flush a string to the standard input of of ghci.+--+-- Multiple line strings are+-- accepted and will be surrounded by ":{" and ":}"+--+flushGhciCmd :: Handle -> String -> IO ()+flushGhciCmd hin cmd = do+ hPutStr hin (":{\n" ++ cmd ++ "\n:}\n") -- TODO optimization when no newline ?+ hFlush hin++-- | Remove the @"ghci> "@ and @"ghci| "@ prefixes from the output stream of+-- ghci.+--+cleanResultString :: String -> String+cleanResultString ('g' : 'h' : 'c' : 'i' : '>': ' ' : s) =+ cleanResultString s+cleanResultString ('g' : 'h' : 'c' : 'i' : '|': ' ' : s) =+ cleanResultString s+cleanResultString s = s+++-- | Utility function that merges the stderr and the stdout streams of+-- ghci.+--+appendGhciResult :: GhciResult -> Either String String -> GhciResult+appendGhciResult acc (Left s) =+ acc { ghciErr = ghciErr acc <> fromString s }+appendGhciResult acc (Right s) =+ acc { ghciOut = ghciOut acc <> fromString s }++
+ test/Spec.hs view
@@ -0,0 +1,49 @@+import Test.Hspec+import Test.QuickCheck++import qualified Data.Memoizer.Commands as Cmd++type CmdResults = [(Int,Int)]++memoizeCommands :: CmdResults -> Cmd.CmdMemoizer Int Int+memoizeCommands = foldl (flip $ uncurry Cmd.storeResult) Cmd.empty++firstDiff :: Int -> CmdResults -> Cmd.CmdMemoizer Int Int -> (Int, Cmd.CmdMemoizer Int Int)+firstDiff acc [] m = (acc, Cmd.deleteResult m)+firstDiff acc ((a,b):q) m =+ case Cmd.lookup a m of+ Nothing -> (acc, Cmd.storeResult a b m)+ Just b' ->+ if b == b' then+ firstDiff (acc + 1) q (Cmd.nextCmd m)+ else+ (acc,Cmd.storeResult a b m)++main :: IO ()+main = hspec $ do+ describe "Data.Memoizer.Commands" $ do+ it "Cannot guess when not memoized" $ property $ \a l->+ Cmd.lookup a (memoizeCommands l) `shouldBe` Nothing+ it "Memoizes first command" $ property $ \a b l ->+ Cmd.lookup a (Cmd.restart (memoizeCommands ((a,b): l)))+ `shouldBe` Just b+ it "Memoizes second command" $ property $ \a b l a' b' ->+ Cmd.lookup a' (Cmd.nextCmd (Cmd.restart (memoizeCommands ((a,b):(a',b'): l))))+ `shouldBe` Just b'+ it "Finds the first modification" $ property $ \a b a' l1 l2 ->+ let l = l1 ++ [(a,b)] ++ l2+ l' = l1 ++ [(a',b)] ++ l2+ in+ if a == a' then+ fst (firstDiff 0 l' (Cmd.restart (memoizeCommands l)))+ `shouldBe` length l'+ else+ fst (firstDiff 0 l' (Cmd.restart (memoizeCommands l)))+ `shouldBe` length l1+ it "Do not memoize after first modif" $ property $ \a'' a b a' l1 l2 ->+ let l = l1 ++ [(a,b)] ++ l2+ l' = l1 ++ [(a',b)] ++ l2+ in+ (Cmd.lookup a'' $+ snd $ firstDiff 0 l' $ Cmd.restart $ memoizeCommands l)+ `shouldBe` Nothing