diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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 + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,126 @@ +# ghci4luatex : a GHCi session in LuaTeX + +[![Haskell](https://img.shields.io/badge/language-Haskell-orange.svg)](https://haskell.org) [![Hackage](https://img.shields.io/hackage/v/ghci4luatex.svg)](https://hackage.haskell.org/package/ghci4luatex) [![BSD3 License](https://img.shields.io/badge/license-BSD3-blue.svg)](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": {} + } + ], +``` + diff --git a/app/ghci4luatex.hs b/app/ghci4luatex.hs new file mode 100644 --- /dev/null +++ b/app/ghci4luatex.hs @@ -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" diff --git a/dkjson.lua b/dkjson.lua new file mode 100644 --- /dev/null +++ b/dkjson.lua @@ -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 +. + +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 + diff --git a/doc/ghci-doc.pdf b/doc/ghci-doc.pdf new file mode 100644 Binary files /dev/null and b/doc/ghci-doc.pdf differ diff --git a/doc/ghci-doc.tex b/doc/ghci-doc.tex new file mode 100644 --- /dev/null +++ b/doc/ghci-doc.tex @@ -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} diff --git a/ghci.sty b/ghci.sty new file mode 100644 --- /dev/null +++ b/ghci.sty @@ -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]===]) + }% +} + diff --git a/ghci4luatex.cabal b/ghci4luatex.cabal new file mode 100644 --- /dev/null +++ b/ghci4luatex.cabal @@ -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 +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 diff --git a/src/Data/Memoizer/Commands.hs b/src/Data/Memoizer/Commands.hs new file mode 100644 --- /dev/null +++ b/src/Data/Memoizer/Commands.hs @@ -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 } + + diff --git a/src/Data/Memoizer/Sessions.hs b/src/Data/Memoizer/Sessions.hs new file mode 100644 --- /dev/null +++ b/src/Data/Memoizer/Sessions.hs @@ -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 diff --git a/src/System/Process/Ghci.hs b/src/System/Process/Ghci.hs new file mode 100644 --- /dev/null +++ b/src/System/Process/Ghci.hs @@ -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 } + + diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -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