ghci4luatex 0.1.1 → 0.1.2
raw patch · 12 files changed
+2265/−2260 lines, 12 filesdep ~aesondep ~basedep ~bytestringPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: aeson, base, bytestring, hspec, process, text
API changes (from Hackage documentation)
- Data.Memoizer.Commands: instance (GHC.Internal.Show.Show a, GHC.Internal.Show.Show b) => GHC.Internal.Show.Show (Data.Memoizer.Commands.CmdMemoizer a b)
- Data.Memoizer.Sessions: instance (GHC.Internal.Show.Show a, GHC.Internal.Show.Show b, GHC.Internal.Show.Show k) => GHC.Internal.Show.Show (Data.Memoizer.Sessions.SessionMemoizer k a b)
- System.Process.Ghci: instance GHC.Internal.Base.Monoid System.Process.Ghci.GhciResult
- System.Process.Ghci: instance GHC.Internal.Base.Semigroup System.Process.Ghci.GhciResult
- System.Process.Ghci: instance GHC.Internal.Generics.Generic System.Process.Ghci.GhciResult
- System.Process.Ghci: instance GHC.Internal.Show.Show System.Process.Ghci.GhciResult
+ Data.Memoizer.Commands: instance (GHC.Show.Show a, GHC.Show.Show b) => GHC.Show.Show (Data.Memoizer.Commands.CmdMemoizer a b)
+ Data.Memoizer.Sessions: instance (GHC.Show.Show a, GHC.Show.Show b, GHC.Show.Show k) => GHC.Show.Show (Data.Memoizer.Sessions.SessionMemoizer k a b)
+ System.Process.Ghci: instance GHC.Base.Monoid System.Process.Ghci.GhciResult
+ System.Process.Ghci: instance GHC.Base.Semigroup System.Process.Ghci.GhciResult
+ System.Process.Ghci: instance GHC.Generics.Generic System.Process.Ghci.GhciResult
+ System.Process.Ghci: instance GHC.Show.Show System.Process.Ghci.GhciResult
Files
- CHANGELOG.md +25/−20
- LICENSE +28/−28
- README.md +159/−159
- app/ghci4luatex.hs +141/−141
- dkjson.lua +752/−752
- doc/ghci-doc.tex +441/−441
- ghci.sty +142/−142
- ghci4luatex.cabal +19/−19
- src/Data/Memoizer/Commands.hs +141/−141
- src/Data/Memoizer/Sessions.hs +147/−147
- src/System/Process/Ghci.hs +221/−221
- test/Spec.hs +49/−49
CHANGELOG.md view
@@ -1,20 +1,25 @@-# 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--## 0.1 - 2025-07-07--* Fix missing test for `cabal install ghci4luatex`--## 0.1.1 - 2025-07-10--* Bump Quickcheck version for stackage upload+# 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 + +## 0.1 - 2025-07-07 + +* Fix missing test for `cabal install ghci4luatex` + +## 0.1.1 - 2025-07-10 + +* Bump Quickcheck version for stackage upload + +## 0.1.2 - 2025-07-10 + +* Windows compatibility +* Loosen lower bounds
LICENSE view
@@ -1,28 +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.+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
@@ -1,159 +1,159 @@-# ghci4luatex : a GHCi session in LuaTeX--[](https://haskell.org) [](https://github.com/AliceRixte/ghci4luatex/LICENSE) [](https://hackage.haskell.org/package/ghci4luatex) [](https://www.stackage.org/nightly/package/ghci4luatex) [](https://www.stackage.org/lts/package/ghci4luatex) --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}$.-```---## Documentation--You can find the full pdf documentation in [here](./doc/ghci-doc.pdf)--## 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-```--## Use any Haskell library--### HaTeX--```latex--\begin{ghci}-:set -XOverloadedStrings-\end{ghci}--\begin{ghci}-import Text.LaTeX-import Text.LaTeX.Base.Pretty--printTex = putStrLn . prettyLaTeX-\end{ghci}--\hask{printTex (section "A section using HaTeX")}-```--### Diagrams--```latex--\usepackage{svg}--\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}-```--## 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": {}- }- ],-```-+# ghci4luatex : a GHCi session in LuaTeX + +[](https://haskell.org) [](https://github.com/AliceRixte/ghci4luatex/LICENSE) [](https://hackage.haskell.org/package/ghci4luatex) [](https://www.stackage.org/nightly/package/ghci4luatex) [](https://www.stackage.org/lts/package/ghci4luatex) + +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}$. +``` + + +## Documentation + +You can find the full pdf documentation in [here](./doc/ghci-doc.pdf) + +## 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 +``` + +## Use any Haskell library + +### HaTeX + +```latex + +\begin{ghci} +:set -XOverloadedStrings +\end{ghci} + +\begin{ghci} +import Text.LaTeX +import Text.LaTeX.Base.Pretty + +printTex = putStrLn . prettyLaTeX +\end{ghci} + +\hask{printTex (section "A section using HaTeX")} +``` + +### Diagrams + +```latex + +\usepackage{svg} + +\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} +``` + +## 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
@@ -1,141 +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"+{-# 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
@@ -1,752 +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-+-- 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.tex view
@@ -1,441 +1,441 @@--\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--\def\version{v0.1}--\date{\today \\[0.5em]\normalsize \texttt{\version}}-%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}- {-# LANGUAGE OverloadedStrings #-}- {-# LANGUAGE OverloadedLists #-}- \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}+ +\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 + +\def\version{v0.1} + +\date{\today \\[0.5em]\normalsize \texttt{\version}} +%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} + {-# LANGUAGE OverloadedStrings #-} + {-# LANGUAGE OverloadedLists #-} + \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
@@ -1,142 +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]===])- }%-}-+\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
@@ -1,13 +1,13 @@-cabal-version: 2.2+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.1.1+version: 0.1.2 synopsis: A GHCi session in LaTeX-description: Please see the README on GitHub at <https://github.com/AliceRixte/pandia/blob/main/ghci4luatex#readme>+description: Please see the README on GitHub at <https://github.com/AliceRixte/ghci4luatex#readme> category: Latex, Program homepage: https://github.com/AliceRixte/ghci4luatex#readme bug-reports: https://github.com/AliceRixte/ghci4luatex/issues@@ -43,15 +43,15 @@ src ghc-options: -Wall build-depends:- aeson ==2.2.*- , base >=4.18 && <5- , bytestring ==0.12.*+ aeson >=2.1 && <2.3+ , base >=4.17 && <5+ , bytestring >=0.11 && <0.13 , cmdargs ==0.10.* , containers >=0.6 && <0.8 , network-simple ==0.4.*- , process >=1.6.25 && <1.7+ , process >=1.6.18 && <1.7 , stm ==2.5.*- , text ==2.1.*+ , text >=2.0 && <2.2 default-language: Haskell2010 executable ghci4luatex@@ -64,16 +64,16 @@ app ghc-options: -Wall -rtsopts -with-rtsopts=-N -threaded build-depends:- aeson ==2.2.*- , base >=4.18 && <5- , bytestring ==0.12.*+ aeson >=2.1 && <2.3+ , base >=4.17 && <5+ , bytestring >=0.11 && <0.13 , cmdargs ==0.10.* , containers >=0.6 && <0.8 , ghci4luatex , network-simple ==0.4.*- , process >=1.6.25 && <1.7+ , process >=1.6.18 && <1.7 , stm ==2.5.*- , text ==2.1.*+ , text >=2.0 && <2.2 default-language: Haskell2010 test-suite ghci4luatex-test@@ -88,15 +88,15 @@ ghc-options: -Wall build-depends: QuickCheck >=2.14 && <2.17- , aeson ==2.2.*- , base >=4.18 && <5- , bytestring ==0.12.*+ , aeson >=2.1 && <2.3+ , base >=4.17 && <5+ , bytestring >=0.11 && <0.13 , cmdargs ==0.10.* , containers >=0.6 && <0.8 , ghci4luatex- , hspec ==2.11.*+ , hspec >=2.10 && <2.12 , network-simple ==0.4.*- , process >=1.6.25 && <1.7+ , process >=1.6.18 && <1.7 , stm ==2.5.*- , text ==2.1.*+ , text >=2.0 && <2.2 default-language: Haskell2010
src/Data/Memoizer/Commands.hs view
@@ -1,141 +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 }--+-------------------------------------------------------------------------------- +-- | +-- +-- 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
@@ -1,147 +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+-------------------------------------------------------------------------------- +-- | +-- +-- 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
@@ -1,221 +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 }--+{-# 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
@@ -1,49 +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+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