diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,11 @@ +# Changelog + +`hslua-module-doclayout` uses [PVP Versioning][1]. +The changelog is available [on GitHub][2]. + +## 0.1.0 + +* Initial release. + +[1]: https://pvp.haskell.org +[2]: https://github.com/hslua/hslua-module-doclayout/releases diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2020 Albert Krewinkel + +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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,373 @@ +# hslua-module-doclayout + +[![GitHub CI][CI badge]](https://github.com/hslua/hslua-module-doclayout/actions) +[![Build status][Travis badge]](https://travis-ci.org/hslua/hslua-module-doclayout) +[![Hackage][Hackage badge]](https://hackage.haskell.org/package/hslua-module-doclayout) +[![Stackage Lts][Stackage Lts badge]](http://stackage.org/lts/package/hslua-module-doclayout) +[![Stackage Nightly][Stackage Nightly badge]](http://stackage.org/nightly/package/hslua-module-doclayout) +[![MIT license][License badge]](LICENSE) + +Lua module wrapping the [doclayout] Haskell package. + +[doclayout]: https://hackage.haskell.org/package/doclayout +[CI badge]: https://github.com/hslua/hslua-module-doclayout/workflows/CI/badge.svg +[Travis badge]: https://img.shields.io/travis/hslua/hslua-module-doclayout.svg?logo=travis +[Hackage badge]: https://img.shields.io/hackage/v/hslua-module-doclayout.svg?logo=haskell +[Stackage Lts badge]: http://stackage.org/package/hslua-module-doclayout/badge/lts +[Stackage Nightly badge]: http://stackage.org/package/hslua-module-doclayout/badge/nightly +[License badge]: https://img.shields.io/badge/license-MIT-blue.svg + + +Example +------- + +``` haskell +loadProg :: Lua Status +loadProg = do + openlibs + preloadModule "doclayout" + dostring $ unlines + [ "doc = require 'doclayout'" + , "local example_doc = (doc.literal 'Line' + 'One')" + , " // (doc.literal 'Line' + 'Two')" + , "-- prints:" + , "-- Line One" + , "--" + , "-- Line Two" + , "print(doc.render(example_doc))" + , "" + , "-- prints:" + , "-- Line" + , "-- One" + , "--" + , "-- Line" + , "-- Two" + , "local columns = 5" + , "print(doc.render(example_doc, columns))" + ] +``` + + +Documentation +------------- + +### Functions + +#### render + +`render (doc[, colwidth])` + +Render the `Doc` using the given column width. + +Parameters: + +`doc` +: Doc to render + +`colwidth` +: Maximum number of characters per line + +### Doc construction + +All functions return a fresh `Doc` element. + +#### after_break + +`after_break` + +Creates a `Doc` which is conditionally included only if it +comes at the beginning of a line. + +#### before_non_blank + +`before_non_blank (doc)` + +Conditionally includes the given `Doc` unless it is followed by +a blank space. + +#### blankline + +`blankline` + +Inserts a blank line unless one exists already. + +#### blanklines + +`blanklines (n)` + +Insert blank lines unless they exist already. + +Parameters: + +`n` +: Number of blank lines to insert. + +#### braces + +`braces (doc)` + +Puts a `Doc` in curly braces. + +#### brackets + +`brackets (doc)` + +Puts a `Doc` in square brackets. + +#### cblock + +`cblock (width, doc)` + +Like `lblock` but aligned centered. + +Parameters: + +`width` +: Width of the created block, in characters + +`doc` +: Contents of the block ([Doc]) + +#### chomp + +`chomp (doc)` + +Chomps trailing blank space off of a `Doc`. + +#### concat + +`concat (docs[, sep])` + +Concatenate the given `Doc`s, interspersing `sep` if specified. + +Parameters: + +`docs` +: List of `Doc`s + +`sep` +: Separator `Doc` + +#### cr + +A carriage return. Does nothing if we're at the beginning of a +line; otherwise inserts a newline. + +#### double_quotes + +`double_quotes (doc)` + +Wraps a `Doc` in double quotes + +#### empty + +The empty document. + +#### flush + +`flush (doc)` + +Makes a `Doc` flush against the left margin. + +#### hang + +`hang (indent, start, doc)` + +Creates a hanging indent. + +Parameters: + +`indent` +: Indentation width in characters + +`start` +: Start, printed unindented + +`doc` +: Doc which is indented by `indent` spaces on every line. + +#### inside + +`inside (start, end, contents)` + +Encloses a `Doc` inside a start and end `Doc`. + +Parameters: + +`start` +: Doc before contents + +`end` +: Doc after contents + +`contents` +: Contents Doc + +#### lblock + +`lblock (width, doc)` + +Creates a block with the given width and content, aligned to the left. + +Parameters: + +`width` +: Width of the created block, in characters + +`doc` +: Contents of the block ([Doc]) + + +#### literal + +`literal (string)` + +Creates a `Doc` from a string. + +#### nest + +`nest (indent)` + +Indents a `Doc` by the specified number of spaces. + +Parameters: + +`indent` +: Indentation width. + +#### nestle + +`nestle (doc)` + +Removes leading blank lines from a `Doc`. + +#### nowrap + +`nowrap (doc)` + +Makes a `Doc` non-reflowable. + +#### parens + +`parens (doc)` + +Puts a `Doc` in parentheses. + +#### prefixed + +`prefixed (prefix, doc)` + +Uses the specified string as a prefix for every line of the +inside document (except the first, if not at the beginning of the +line). + +Parameters: + +`prefix` +: Prefix to prepend to each line + +`doc` +: Inside Doc. + +#### quotes + +`quotes (doc)` + +Wraps a `Doc` in single quotes. + +#### rblock + +`rblock (indent, doc)` + +Like `lblock` but aligned to the right. + +Parameters: + +`width` +: Width of the created block, in characters + +`doc` +: Contents of the block ([Doc]) + +#### space + +A breaking (reflowable) space. + +#### vfill + +`vfill` + +Creates an expandable border that, when placed next to a box, +expands to the height of the box. + +Parameters: + +`text` +: Border text + +### Operators + +#### `..` + +Concatenate two `Doc` elements. + +#### `+` + +Concatenate two `Doc`s, inserting a reflowable space between them. + +#### `/` + +If `a` and `b` are `Doc` elements, then `a / b` puts `a` above `b`. + +#### `//` + +If `a` and `b` are `Doc` elements, then `a // b` puts `a` above +`b`, inserting a blank line between them. + +### Document Querying + +#### is_empty + +`is_empty (doc)` + +Returns `true` iff `doc` is the empty document, `false` otherwise. + +#### min_offset + +`min_offset (doc)` + +Returns the minimal width of a @'Doc'@ when reflowed at breakable +spaces. + +#### update_column + +`update_column (doc, i)` + +Returns the column that would be occupied by the last laid out character. + +#### height + +`height (doc)` + +Returns the height of a block or other Doc. + +#### real_length + +`real_length (str)` + +Returns the real length of a string in a monospace font: 0 for a +combining character, 1, for a regular character, 2 for an East +Asian wide character. + +#### offset + +`offset (doc)` + +Returns the width of a `Doc` (as number of characters). + + +License +------- + +This package is made available under the MIT license. See [`LICENSE`](LICENSE) +for details. diff --git a/hslua-module-doclayout.cabal b/hslua-module-doclayout.cabal new file mode 100644 --- /dev/null +++ b/hslua-module-doclayout.cabal @@ -0,0 +1,80 @@ +cabal-version: 2.0 +name: hslua-module-doclayout +version: 0.1.0 +synopsis: Lua module wrapping Text.DocLayout. +description: Lua module wrapping @Text.DocLayout@. +homepage: https://github.com/hslua/hslua-module-doclayout +bug-reports: https://github.com/hslua/hslua-module-doclayout/issues +license: MIT +license-file: LICENSE +author: Albert Krewinkel +maintainer: Albert Krewinkel +copyright: 2020 Albert Krewinkel +category: Foreign +build-type: Simple +extra-doc-files: README.md + CHANGELOG.md +extra-source-files: test/test-doclayout.lua +tested-with: GHC == 8.0.2 + GHC == 8.2.2 + GHC == 8.4.4 + GHC == 8.6.5 + GHC == 8.8.3 + +source-repository head + type: git + location: https://github.com/hslua/hslua-module-doclayout.git + +library + build-depends: base >= 4.9 && < 5 + , doclayout >= 0.2 && < 0.4 + , hslua >= 1.0 && < 1.2 + , text >= 1.0 && < 1.3 + default-language: Haskell2010 + hs-source-dirs: src + exposed-modules: Foreign.Lua.Module.DocLayout + ghc-options: -Wall + -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + if impl(ghc >= 8.0) + ghc-options: -Wredundant-constraints + if impl(ghc >= 8.2) + ghc-options: -fhide-source-paths + if impl(ghc >= 8.4) + ghc-options: -Wmissing-export-lists + -Wpartial-fields + if impl(ghc >= 8.8) + ghc-options: -Wmissing-deriving-strategies + +test-suite hslua-module-doclayout-test + build-depends: base >= 4.9 && < 5 + , doclayout >= 0.2 && < 0.4 + , hslua + , hslua-module-doclayout + , tasty + , tasty-hunit + , tasty-lua >= 0.2 && < 0.3 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: test-hslua-module-doclayout.hs + build-depends: hslua-module-doclayout + default-language: Haskell2010 + ghc-options: -threaded + -rtsopts + -with-rtsopts=-N + -Wall + -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + if impl(ghc >= 8.0) + ghc-options: -Wredundant-constraints + if impl(ghc >= 8.2) + ghc-options: -fhide-source-paths + if impl(ghc >= 8.4) + ghc-options: -Wmissing-export-lists + -Wpartial-fields + if impl(ghc >= 8.8) + ghc-options: -Wmissing-deriving-strategies diff --git a/src/Foreign/Lua/Module/DocLayout.hs b/src/Foreign/Lua/Module/DocLayout.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Lua/Module/DocLayout.hs @@ -0,0 +1,352 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module : Foreign.Lua.Module.DocLayout +Copyright : © 2020 Albert Krewinkel +License : MIT +Maintainer : Albert Krewinkel +Stability : alpha +Portability : Requires GHC 8 or later. + +Provides a Lua module which wraps @'Text.DocLayout'@. The @Doc' +type is specialized to @'Text'@. + +This module defines orphan instances for @Doc Text@. +-} +module Foreign.Lua.Module.DocLayout ( + -- * Module + pushModule + , preloadModule + + -- * Doc constructors and combinators + , after_break + , before_non_blank + , blankline + , blanklines + , braces + , brackets + , cblock + , chomp + , concat + , cr + , double_quotes + , empty + , flush + , hang + , inside + , lblock + , literal + , nest + , nestle + , nowrap + , parens + , prefixed + , quotes + , rblock + , space + , vfill + + -- * Rendering + , render + + -- * Document Querying + , is_empty + , height + , min_offset + , offset + , real_length + , update_column + + -- * Marshaling + , peekDoc + , pushDoc + ) +where + +import Prelude hiding (concat) +import Data.List (intersperse) +import Data.Text (Text) +import Foreign.Lua (Lua, NumResults (..), Optional, + Peekable, Pushable, StackIndex) +import Text.DocLayout (Doc, (<+>), ($$), ($+$)) + +import qualified Data.Text as T +import qualified Foreign.Lua as Lua +import qualified Foreign.Lua.Types.Peekable as Lua +import qualified Foreign.Lua.Userdata as Lua +import qualified Text.DocLayout as Doc + +#if ! MIN_VERSION_base(4, 11, 0) +import Data.Monoid ((<>)) +#endif + +-- +-- Module +-- + +-- | Pushes the @doclayout@ module to the Lua stack. +pushModule :: Lua NumResults +pushModule = do + Lua.newtable + -- constructors + Lua.addfield "empty" empty + Lua.addfield "blankline" blankline + Lua.addfield "cr" cr + Lua.addfield "space" space + Lua.addfunction "after_break" after_break + Lua.addfunction "before_non_blank" before_non_blank + Lua.addfunction "blanklines" blanklines + Lua.addfunction "braces" braces + Lua.addfunction "brackets" brackets + Lua.addfunction "cblock" cblock + Lua.addfunction "chomp" chomp + Lua.addfunction "concat" concat + Lua.addfunction "double_quotes" double_quotes + Lua.addfunction "flush" flush + Lua.addfunction "hang" hang + Lua.addfunction "inside" inside + Lua.addfunction "lblock" lblock + Lua.addfunction "literal" literal + Lua.addfunction "nest" nest + Lua.addfunction "nestle" nestle + Lua.addfunction "nowrap" nowrap + Lua.addfunction "parens" parens + Lua.addfunction "quotes" quotes + Lua.addfunction "prefixed" prefixed + Lua.addfunction "rblock" rblock + Lua.addfunction "vfill" vfill + -- querying + Lua.addfunction "is_empty" is_empty + Lua.addfunction "offset" offset + Lua.addfunction "height" height + Lua.addfunction "min_offset" min_offset + Lua.addfunction "offset" offset + Lua.addfunction "real_length" real_length + Lua.addfunction "update_column" update_column + -- rendering + Lua.addfunction "render" render + return 1 + +-- | Add the @doclayout@ module under the given name to the table +-- of preloaded packages. +preloadModule :: String -> Lua () +preloadModule = flip Lua.preloadhs pushModule + +-- | Render a @'Doc'@. The text is reflowed on breakable spaces +-- to match the given line length. Text is not reflowed if the +-- line length parameter is omitted or nil. +render :: Doc Text -> Optional Int -> Lua Text +render doc optLength = return $ Doc.render (Lua.fromOptional optLength) doc + +-- +-- Querying +-- + +-- | @True@ iff the document is empty. +is_empty :: Doc Text -> Lua Bool +is_empty = return . Doc.isEmpty + +-- | Returns the width of a @'Doc'@. +offset :: Doc Text -> Lua Int +offset = return . Doc.offset + +-- | Returns the minimal width of a @'Doc'@ when reflowed at +-- breakable spaces. +min_offset :: Doc Text -> Lua Int +min_offset = return . Doc.minOffset + +-- | Returns the column that would be occupied by the last laid +-- out character. +update_column :: Doc Text -> Int -> Lua Int +update_column doc = return . Doc.updateColumn doc + +-- | Returns the height of a block or other Doc. +height :: Doc Text -> Lua Int +height = return . Doc.height + +-- | Returns the real length of a string in a monospace font: 0 +-- for a combining character, 1, for a regular character, 2 for +-- an East Asian wide character. +real_length :: Text -> Lua Int +real_length = return . Doc.realLength + +-- +-- Constructors +-- + +-- | Creates a @'Doc'@ which is conditionally included only if it +-- comes at the beginning of a line. +after_break :: Text -> Lua (Doc Text) +after_break = return . Doc.afterBreak + +-- | Conditionally includes the given @'Doc'@ unless it is +-- followed by a blank space. +before_non_blank :: Doc Text -> Lua (Doc Text) +before_non_blank = return . Doc.beforeNonBlank + +-- | Inserts a blank line unless one exists already. +blankline :: Doc Text +blankline = Doc.blankline + +-- | Insert blank lines unless they exist already. +blanklines :: Int -> Lua (Doc Text) +blanklines = return . Doc.blanklines + +-- | Puts a @'Doc'@ in curly braces. +braces :: Doc Text -> Lua (Doc Text) +braces = return . Doc.braces + +-- | Puts a @'Doc'@ in square brackets. +brackets :: Doc Text -> Lua (Doc Text) +brackets = return . Doc.brackets + +-- | Like @'lblock'@ but aligned centered. +cblock :: Int -> Doc Text -> Lua (Doc Text) +cblock width = return . Doc.cblock width + +-- | Chomps trailing blank space off of a @'Doc'@. +chomp :: Doc Text -> Lua (Doc Text) +chomp = return . Doc.chomp + +-- | Concatenates a list of @'Doc'@s. +concat :: [Doc Text] -> Optional (Doc Text) -> Lua (Doc Text) +concat docs optSep = return $ + case Lua.fromOptional optSep of + Nothing -> mconcat docs + Just sep -> mconcat $ intersperse sep docs + +-- | A carriage return. Does nothing if we're at the beginning of +-- a line; otherwise inserts a newline. +cr :: Doc Text +cr = Doc.cr + +-- | Wraps a @'Doc'@ in double quotes +double_quotes :: Doc Text -> Lua (Doc Text) +double_quotes = return . Doc.doubleQuotes + +-- | The empty document. +empty :: Doc Text +empty = Doc.empty + +-- | Makes a @'Doc'@ flush against the left margin. +flush :: Doc Text -> Lua (Doc Text) +flush = return . Doc.flush + +-- | Creates a hanging indent. +hang :: Int -> Doc Text -> Doc Text -> Lua (Doc Text) +hang ind start doc = return $ Doc.hang ind start doc + +-- | Encloses a @'Doc'@ inside a start and end @'Doc'@. +inside :: Doc Text -> Doc Text -> Doc Text -> Lua (Doc Text) +inside start end contents = return $ Doc.inside start end contents + +-- | Creates a block with the given width and content, aligned to the left. +lblock :: Int -> Doc Text -> Lua (Doc Text) +lblock width = return . Doc.lblock width + +-- | Creates a @'Doc'@ from a string. +literal :: Text -> Lua (Doc Text) +literal = return . Doc.literal + +-- | Indents a @'Doc'@ by the specified number of spaces. +nest :: Int -> Doc Text -> Lua (Doc Text) +nest ind = return . Doc.nest ind + +-- | Removes leading blank lines from a @'Doc'@. +nestle :: Doc Text -> Lua (Doc Text) +nestle = return . Doc.nestle + +-- | Makes a @'Doc'@ non-reflowable. +nowrap :: Doc Text -> Lua (Doc Text) +nowrap = return . Doc.nowrap + +-- | Puts a @'Doc'@ in parentheses. +parens :: Doc Text -> Lua (Doc Text) +parens = return . Doc.parens + +-- | Uses the specified string as a prefix for every line of the +-- inside document (except the first, if not at the beginning of +-- the line). +prefixed :: Text -> Doc Text -> Lua (Doc Text) +prefixed prefix = return . Doc.prefixed (T.unpack prefix) + +-- | Wraps a @'Doc'@ in single quotes. +quotes :: Doc Text -> Lua (Doc Text) +quotes = return . Doc.quotes + +-- | Like @'lblock'@ but aligned to the right. +rblock :: Int -> Doc Text -> Lua (Doc Text) +rblock width = return . Doc.rblock width + +-- | A breaking (reflowable) space. +space :: Doc Text +space = Doc.space + +vfill :: Text -> Lua (Doc Text) +vfill = return . Doc.vfill + + +-- +-- Marshaling +-- + +-- | Name used for the @Doc@ Lua userdata values. +docTypeName :: String +docTypeName = "HsLua DocLayout.Doc" + +-- | Retrieve a @Doc Text@ value from the Lua stack. Strings are +-- converted to plain @'Doc'@ values. +peekDoc :: StackIndex -> Lua (Doc Text) +peekDoc idx = Lua.ltype idx >>= \case + Lua.TypeString -> let stringToDoc s = if T.null s + then Doc.empty + else Doc.literal s + in stringToDoc <$> Lua.peek idx + Lua.TypeNumber -> Doc.literal <$> Lua.peek idx + _ -> Lua.reportValueOnFailure docTypeName + (`Lua.toAnyWithName` docTypeName) + idx + +instance Peekable (Doc Text) where + peek = peekDoc + +-- | Push a @Doc Text@ value to the Lua stack. +pushDoc :: Doc Text -> Lua () +pushDoc = Lua.pushAnyWithMetatable pushDocMT + where + pushDocMT = Lua.ensureUserdataMetatable docTypeName $ do + Lua.addfunction "__add" __add + Lua.addfunction "__concat" __concat + Lua.addfunction "__div" __div + Lua.addfunction "__eq" __eq + Lua.addfunction "__idiv" __idiv + Lua.addfunction "__tostring" __tostring + +instance Pushable (Doc Text) where + push = pushDoc + +-- | Concatenate two @'Doc'@s, putting breakable spaces between them. +__add :: Doc Text -> Doc Text -> Lua (Doc Text) +__add a b = return (a <+> b) + +-- | Concatenate two @'Doc'@. +__concat :: Doc Text -> Doc Text -> Lua (Doc Text) +__concat a b = return (a <> b) + +-- | @a / b@ puts @a@ above @b@. +__div :: Doc Text -> Doc Text -> Lua (Doc Text) +__div a b = return (a $$ b) + +-- | Test @'Doc'@ equality. +__eq :: Doc Text -> Doc Text -> Lua Bool +__eq a b = return (a == b) + +-- | @a // b@ puts @a@ above @b@. +__idiv :: Doc Text -> Doc Text -> Lua (Doc Text) +__idiv a b = return (a $+$ b) + +-- | Convert to string by rendering without reflowing. +__tostring :: Doc Text -> Lua Text +__tostring d = return $ Doc.render Nothing d diff --git a/test/test-doclayout.lua b/test/test-doclayout.lua new file mode 100644 --- /dev/null +++ b/test/test-doclayout.lua @@ -0,0 +1,139 @@ +-- +-- Tests for the doclayout module +-- +local doclayout = require 'doclayout' +local tasty = require 'tasty' + +local group = tasty.test_group +local test = tasty.test_case +local assert = tasty.assert + +-- Check existence static fields +return { + group 'constructors' { + test('empty', function () + assert.are_equal(type(doclayout.empty), 'userdata') + end), + test('blankline', function () + assert.are_equal(type(doclayout.blankline), 'userdata') + end), + test('cr', function () + assert.are_equal(type(doclayout.cr), 'userdata') + end), + test('space', function () + assert.are_equal(type(doclayout.space), 'userdata') + end), + + group 'concat' { + test('without sep', function () + local list = { + doclayout.literal 'one', + doclayout.literal 'two', + doclayout.literal 'three' + } + local sep = doclayout.cr + assert.are_equal( + doclayout.concat(list, sep), + list[1] .. sep .. list[2] .. sep .. list[3]) + end), + test('without sep', function () + local list = { + doclayout.literal 'one', + doclayout.literal 'two', + doclayout.literal 'three' + } + assert.are_equal(doclayout.concat(list), list[1] .. list[2] .. list[3]) + end), + } + }, + + group 'render' { + test('empty doc', function () + assert.are_equal(doclayout.render(doclayout.empty), '') + end) + }, + + group 'document querying' { + test('is_empty', function () + assert.is_truthy(doclayout.is_empty(doclayout.empty)) + assert.is_truthy(doclayout.is_empty('')) + assert.is_falsy(doclayout.is_empty('non-empty')) + end), + + test('height', function () + assert.are_equal(doclayout.height(doclayout.empty), 1) + assert.are_equal(doclayout.height('line'), 1) + assert.are_equal(doclayout.height(doclayout.literal 'p' / 'q'), 2) + assert.are_equal(doclayout.height(doclayout.literal 'p' // 'q'), 3) + end), + + test('min_offset', function () + assert.are_equal(doclayout.min_offset 'four', 4) + assert.are_equal( + doclayout.min_offset(doclayout.literal 'four' + 'radio'), + 5 + ) + end), + + test('offset', function () + assert.are_equal(doclayout.offset 'four', 4) + assert.are_equal(doclayout.offset(doclayout.literal 'four' / 'radio'), 5) + end), + + test('real_length', function () + assert.are_equal(doclayout.real_length(''), 0) + assert.are_equal(doclayout.real_length('a'), 1) + assert.are_equal(doclayout.real_length('❄'), 1) + assert.are_equal(doclayout.real_length('シ'), 2) + end), + }, + + group 'Doc type' { + test('empty strings equal the empty Doc', function () + assert.are_equal(doclayout.empty .. '', doclayout.empty) + end), + + test('strings can be used as Doc values', function () + assert.are_equal(doclayout.render('hello world'), 'hello world') + end), + + test('numbers can be used as Doc values', function () + assert.are_equal(doclayout.render(42), '42') + end), + + test('equality', function () + assert.is_truthy(doclayout.literal "true", doclayout.literal "true") + end), + + test('concatenate docs', function () + assert.are_equal( + tostring(doclayout.literal 'Rock-' .. doclayout.literal 'Ola'), + 'Rock-Ola' + ) + end), + + test('has tostring method', function () + local str = 'just a literal string for now' + assert.are_equal(tostring(str), str) + end), + + test('adding concatenates with space', function () + local helloworld = doclayout.literal 'Hello,' + .. doclayout.space + .. doclayout.literal 'World' + assert.are_equal(doclayout.literal 'Hello,' + 'World', helloworld) + end), + + test('dividing sets the first above the second', function () + local first = doclayout.literal 'first' + local second = doclayout.literal 'second' + assert.are_equal(first / second, first .. doclayout.cr .. second) + end), + + test('// separates docs with blank line', function () + local first = doclayout.literal 'first' + local second = doclayout.literal 'second' + assert.are_equal(first // second, first .. doclayout.blankline .. second) + end), + } +} diff --git a/test/test-hslua-module-doclayout.hs b/test/test-hslua-module-doclayout.hs new file mode 100644 --- /dev/null +++ b/test/test-hslua-module-doclayout.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} +{-| +Module : Main +Copyright : © 2020 Albert Krewinkel +License : MIT +Maintainer : Albert Krewinkel +Stability : alpha +Portability : Requires language extensions ForeignFunctionInterface, + OverloadedStrings. + +Tests for the `doclayout` Lua module. +-} +module Main (main) where + +import Control.Monad (void) +import Foreign.Lua (Lua) +import Foreign.Lua.Module.DocLayout (preloadModule, pushModule) +import Test.Tasty (TestTree, defaultMain, testGroup) +import Test.Tasty.HUnit (assertEqual, testCase) +import Test.Tasty.Lua (translateResultsFromFile) + +import qualified Foreign.Lua as Lua + +main :: IO () +main = do + luaTestResults <- Lua.run $ do + Lua.openlibs + Lua.requirehs "doclayout" (void pushModule) + translateResultsFromFile "test/test-doclayout.lua" + defaultMain $ testGroup "hslua-module-doclayout" [tests, luaTestResults] + +-- | HSpec tests for the Lua 'system' module +tests :: TestTree +tests = testGroup "HsLua doclayout module" + [ testCase "module can be pushed to the stack" $ + Lua.run (void pushModule) + + , testCase "module can be added to the preloader" . Lua.run $ do + Lua.openlibs + preloadModule "doclayout" + assertEqual' "function not added to preloader" Lua.TypeFunction =<< do + Lua.getglobal' "package.preload.doclayout" + Lua.ltype (-1) + + , testCase "module can be loaded via preloader" . Lua.run $ do + Lua.openlibs + preloadModule "doclayout" + assertEqual' "loading the module fails " Lua.OK =<< + Lua.dostring "require 'doclayout'" + ] + +assertEqual' :: (Show a, Eq a) => String -> a -> a -> Lua () +assertEqual' msg expected = Lua.liftIO . assertEqual msg expected