diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,14 @@ `hslua-module-doclayout` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 1.0.0 + +Released 2021-10-24 + +* Upgraded to hslua-2.0. +* Switched module name from `Foreign.Lua.Module.DocLayout` to + `HsLua.Module.DocLayout`. + ## 0.2.0.1 Released 2020-10-28. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,6 @@ MIT License -Copyright (c) 2020 Albert Krewinkel +Copyright (c) 2020-2021 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 diff --git a/hslua-module-doclayout.cabal b/hslua-module-doclayout.cabal --- a/hslua-module-doclayout.cabal +++ b/hslua-module-doclayout.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: hslua-module-doclayout -version: 0.2.0.1 +version: 1.0.0 synopsis: Lua module wrapping Text.DocLayout. description: Lua module wrapping @Text.DocLayout@. homepage: https://github.com/hslua/hslua-module-doclayout @@ -9,18 +9,19 @@ license-file: LICENSE author: Albert Krewinkel maintainer: Albert Krewinkel -copyright: 2020 Albert Krewinkel +copyright: © 2020-2021 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.4 - GHC == 8.10.1 + , GHC == 8.2.2 + , GHC == 8.4.4 + , GHC == 8.6.5 + , GHC == 8.8.4 + , GHC == 8.10.7 + , GHC == 9.0.1 source-repository head type: git @@ -29,11 +30,11 @@ library build-depends: base >= 4.9 && < 5 , doclayout >= 0.2 && < 0.4 - , hslua >= 1.2 && < 1.4 + , hslua >= 2.0 && < 2.1 , text >= 1.0 && < 1.3 default-language: Haskell2010 hs-source-dirs: src - exposed-modules: Foreign.Lua.Module.DocLayout + exposed-modules: HsLua.Module.DocLayout ghc-options: -Wall -Wcompat -Widentities @@ -56,7 +57,7 @@ , hslua-module-doclayout , tasty , tasty-hunit - , tasty-lua >= 0.2 && < 0.3 + , tasty-lua >= 1.0 && < 1.1 type: exitcode-stdio-1.0 hs-source-dirs: test main-is: test-hslua-module-doclayout.hs diff --git a/src/Foreign/Lua/Module/DocLayout.hs b/src/Foreign/Lua/Module/DocLayout.hs deleted file mode 100644 --- a/src/Foreign/Lua/Module/DocLayout.hs +++ /dev/null @@ -1,577 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} -{-# 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 - , description - , fields - , functions - - -- * 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 Control.Monad (forM_) -import Data.List (intersperse) -import Data.Text (Text) -import Foreign.Lua (Lua, NumResults (..), Peekable, Pushable, StackIndex) -import Foreign.Lua.Call hiding (render) -import Foreign.Lua.Module hiding (preloadModule, pushModule, render) -import Foreign.Lua.Peek - (Peeker, peekIntegral, peekList, peekString, peekText, toPeeker) -import Foreign.Lua.Push (Pusher, pushBool, pushIntegral, pushText) -import Text.DocLayout (Doc, (<+>), ($$), ($+$)) - -import qualified Data.Text as T -import qualified Foreign.Lua as Lua -import qualified Foreign.Lua.Module as Module -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 --- - --- | Textual description of the "doclayout" module. -description :: Text -description = "Plain-text document layouting." - --- | Self-documenting module. -documentedModule :: Module -documentedModule = Module - { moduleName = "doclayout" - , moduleFields = fields - , moduleDescription = description - , moduleFunctions = functions - } - --- | Pushes the @doclayout@ module to the Lua stack. -pushModule :: Lua NumResults -pushModule = 1 <$ pushModule' documentedModule - -pushModule' :: Module -> Lua () -pushModule' mdl = do - Module.pushModule mdl - forM_ (moduleFields mdl) $ \field -> do - pushText (fieldName field) - fieldPushValue field - Lua.rawset (Lua.nth 3) - --- | Add the @doclayout@ module under the given name to the table --- of preloaded packages. -preloadModule :: String -> Lua () -preloadModule name = Module.preloadModule $ - documentedModule { moduleName = T.pack name } - --- --- Fields --- - --- | Exposed fields. -fields :: [Field] -fields = - [ blankline - , cr - , empty - , space - ] - --- | Wrapped and documented 'Doc.blankline' value. -blankline :: Field -blankline = Field - { fieldName = "blankline" - , fieldDescription = "Inserts a blank line unless one exists already." - , fieldPushValue = pushDoc Doc.blankline - } - --- | Wrapped and documented 'Doc.cr' value. -cr :: Field -cr = Field - { fieldName = "cr" - , fieldDescription = "A carriage return. Does nothing if we're at " <> - "the beginning of a line; " <> - "otherwise inserts a newline." - , fieldPushValue = pushDoc Doc.cr - } - --- | Wrapped and documented 'Doc.empty' value. -empty :: Field -empty = Field - { fieldName = "empty" - , fieldDescription = "The empty document." - , fieldPushValue = pushDoc Doc.empty - } - --- | Wrapped and documented 'Doc.space' value. -space :: Field -space = Field - { fieldName = "space" - , fieldDescription = "A breaking (reflowable) space." - , fieldPushValue = pushDoc Doc.space - } - --- --- Functions --- - --- | Exposed module functions. -functions :: [(Text, HaskellFunction)] -functions = - [ -- Constructors - ("after_break", after_break) - , ("before_non_blank", before_non_blank) - , ("blanklines", blanklines) - , ("braces", braces) - , ("brackets", brackets) - , ("cblock", cblock) - , ("chomp", chomp) - , ("concat", concat) - , ("double_quotes", double_quotes) - , ("flush", flush) - , ("hang", hang) - , ("inside", inside) - , ("lblock", lblock) - , ("literal", literal) - , ("nest", nest) - , ("nestle", nestle) - , ("nowrap", nowrap) - , ("parens", parens) - , ("prefixed", prefixed) - , ("quotes", quotes) - , ("rblock", rblock) - , ("vfill", vfill) - -- rendering - , ("render", render) - -- querying - , ("is_empty", is_empty) - , ("height", height) - , ("min_offset", min_offset) - , ("offset", offset) - , ("real_length", real_length) - , ("update_column", update_column) - ] - - --- | 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 :: HaskellFunction -render = toHsFnPrecursor (flip Doc.render) - <#> docParam "doc" - <#> optionalParameter (peekIntegral @Int) "integer" "colwidth" "" - =#> functionResult pushText "Doc" "rendered doc" - #? ("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.") - --- --- Querying --- - --- | @True@ iff the document is empty. -is_empty :: HaskellFunction -is_empty = toHsFnPrecursor Doc.isEmpty - <#> docParam "doc" - =#> booleanResult "`true` iff `doc` is the empty document, `false` otherwise." - #? "Checks whether a doc is empty." - --- | Returns the width of a @'Doc'@. -offset :: HaskellFunction -offset = toHsFnPrecursor Doc.offset - <#> docParam "doc" - =#> intResult "doc width" - #? "Returns the width of a `Doc` as number of characters." - --- | Returns the minimal width of a @'Doc'@ when reflowed at --- breakable spaces. -min_offset :: HaskellFunction -min_offset = toHsFnPrecursor Doc.minOffset - <#> docParam "doc" - =#> intResult "minimal possible width" - #? ("Returns the minimal width of a `Doc` when reflowed at " <> - "breakable spaces.") - --- | Returns the column that would be occupied by the last laid --- out character. -update_column :: HaskellFunction -update_column = toHsFnPrecursor Doc.updateColumn - <#> docParam "doc" - <#> intParam "i" - =#> intResult "column number" - #? ("Returns the column that would be occupied by the last " <> - "laid out character.") - --- | Returns the height of a block or other Doc. -height :: HaskellFunction -height = toHsFnPrecursor Doc.height - <#> docParam "doc" - =#> intResult "doc height" - #? "Returns the height of a block or other Doc." - - --- | 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 :: HaskellFunction -real_length = toHsFnPrecursor Doc.realLength - <#> textParam "str" - =#> intResult "text length" - #? ("Returns the real length of a string in a monospace font: " <> - "0 for a combining chaeracter, 1 for a regular character, " <> - "2 for an East Asian wide character.") - --- --- Constructors --- - --- | Creates a @'Doc'@ which is conditionally included only if it --- comes at the beginning of a line. -after_break :: HaskellFunction -after_break = toHsFnPrecursor Doc.afterBreak - <#> textParam "text" - =#> docResult "new doc" - #? ("Creates a `Doc` which is conditionally included only if it" <> - "comes at the beginning of a line.") - --- | Conditionally includes the given @'Doc'@ unless it is --- followed by a blank space. -before_non_blank :: HaskellFunction -before_non_blank = toHsFnPrecursor Doc.beforeNonBlank - <#> docParam "doc" - =#> docResult "conditional doc" - #? ("Conditionally includes the given `doc` unless it is " <> - "followed by a blank space.") - --- | Insert blank lines unless they exist already. -blanklines :: HaskellFunction -blanklines = toHsFnPrecursor Doc.blanklines - <#> intParam "n" - =#> docResult "conditional blank lines" - #? "Inserts blank lines unless they exist already." - --- | Puts a @'Doc'@ in curly braces. -braces :: HaskellFunction -braces = toHsFnPrecursor Doc.braces - <#> docParam "doc" - =#> docResult "doc enclosed by {}." - #? "Puts the `doc` in curly braces." - --- | Puts a @'Doc'@ in square brackets. -brackets :: HaskellFunction -- Doc Text -> Lua (Doc Text) -brackets = toHsFnPrecursor Doc.brackets - <#> docParam "doc" - =#> docResult "doc enclosed by []." - #? "Puts the `doc` in square brackets" - --- | Like @'lblock'@ but aligned centered. -cblock :: HaskellFunction -cblock = toHsFnPrecursor Doc.cblock - <#> parameter peekIntegral "integer" "width" "block width in chars" - <#> docParam "doc" - =#> docResult ("doc, aligned centered in a block with max" <> - "`width` chars per line.") - #? ("Creates a block with the given width and content, " <> - "aligned centered.") - --- | Chomps trailing blank space off of a @'Doc'@. -chomp :: HaskellFunction -chomp = toHsFnPrecursor Doc.chomp - <#> docParam "doc" - =#> docResult "`doc` without trailing blanks" - #? "Chomps trailing blank space off of the `doc`." - --- | Concatenates a list of @'Doc'@s. -concat :: HaskellFunction -concat = toHsFnPrecursor (\docs optSep -> mconcat $ - maybe docs (`intersperse` docs) optSep) - <#> parameter (peekList peekDoc) "`{Doc,...}`" "docs" "list of Docs" - <#> optionalParameter peekDoc "Doc" "sep" "separator" - =#> docResult "concatenated doc" - #? "Concatenates a list of `Doc`s." - --- | Wraps a @'Doc'@ in double quotes -double_quotes :: HaskellFunction -double_quotes = toHsFnPrecursor Doc.doubleQuotes - <#> docParam "doc" - =#> docResult "`doc` enclosed by `\"` chars" - #? "Wraps a `Doc` in double quotes." - --- | Makes a @'Doc'@ flush against the left margin. -flush :: HaskellFunction -flush = toHsFnPrecursor Doc.flush - <#> docParam "doc" - =#> docResult "flushed `doc`" - #? "Makes a `Doc` flush against the left margin." - --- | Creates a hanging indent. -hang :: HaskellFunction -hang = toHsFnPrecursor Doc.hang - <#> parameter peekIntegral "integer" "ind" "indentation width" - <#> docParam "start" - <#> docParam "doc" - =#> docResult ("`doc` prefixed by `start` on the first line, " <> - "subsequent lines indented by `ind` spaces.") - #? "Creates a hanging indent." - --- | Encloses a @'Doc'@ inside a start and end @'Doc'@. -inside :: HaskellFunction -inside = toHsFnPrecursor Doc.inside - <#> docParam "start" - <#> docParam "end" - <#> docParam "contents" - =#> docResult "enclosed contents" - #? "Encloses a `Doc` inside a start and end `Doc`." - --- | Creates a block with the given width and content, aligned to --- the left. -lblock :: HaskellFunction -lblock = toHsFnPrecursor Doc.lblock - <#> parameter peekIntegral "integer" "width" "block width in chars" - <#> docParam "doc" - =#> docResult "doc put into block with max `width` chars per line." - #? ("Creates a block with the given width and content, " <> - "aligned to the left.") - --- | Creates a @'Doc'@ from a string. -literal :: HaskellFunction -literal = toHsFnPrecursor Doc.literal - <#> textParam "string" - =#> docResult "doc contatining just the literal string" - #? "Creates a `Doc` from a string." - --- | Indents a @'Doc'@ by the specified number of spaces. -nest :: HaskellFunction -nest = toHsFnPrecursor Doc.nest - <#> parameter peekIntegral "integer" "ind" "indentation size" - <#> docParam "doc" - =#> docResult "`doc` indented by `ind` spaces" - #? "Indents a `Doc` by the specified number of spaces." - --- | Removes leading blank lines from a @'Doc'@. -nestle :: HaskellFunction -nestle = toHsFnPrecursor Doc.nestle - <#> docParam "doc" - =#> docResult "`doc` with leading blanks removed" - #? "Removes leading blank lines from a `Doc`." - --- | Makes a @'Doc'@ non-reflowable. -nowrap :: HaskellFunction -nowrap = toHsFnPrecursor Doc.nowrap - <#> docParam "doc" - =#> docResult "same as input, but non-reflowable" - #? "Makes a `Doc` non-reflowable." - --- | Puts a @'Doc'@ in parentheses. -parens :: HaskellFunction -parens = toHsFnPrecursor Doc.parens - <#> docParam "doc" - =#> docResult "doc enclosed by ()." - #? "Puts the `doc` in parentheses." - - --- | 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 :: HaskellFunction -prefixed = toHsFnPrecursor Doc.prefixed - <#> parameter peekString "string" "prefix" "prefix for each line" - <#> docParam "doc" - =#> docResult "prefixed `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).") - --- | Wraps a @'Doc'@ in single quotes. -quotes :: HaskellFunction -quotes = toHsFnPrecursor Doc.quotes - <#> docParam "doc" - =#> docResult "doc enclosed in `'`." - #? "Wraps a `Doc` in single quotes." - --- | Like @'rblock'@ but aligned to the right. -rblock :: HaskellFunction -rblock = toHsFnPrecursor Doc.rblock - <#> parameter peekIntegral "integer" "width" "block width in chars" - <#> docParam "doc" - =#> docResult ("doc, right aligned in a block with max" <> - "`width` chars per line.") - #? ("Creates a block with the given width and content, " <> - "aligned to the right.") - --- | An expandable border that, when placed next to a box, --- expands to the height of the box. Strings cycle through the --- list provided. -vfill :: HaskellFunction -vfill = toHsFnPrecursor Doc.vfill - <#> textParam "border" - =#> docResult "automatically expanding border Doc" - #? ("An expandable border that, when placed next to a box, " <> - "expands to the height of the box. Strings cycle through the " <> - "list provided.") - --- --- 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 - -peekDoc :: Peeker (Doc Text) -peekDoc = toPeeker peekDoc' - -instance Peekable (Doc Text) where - peek = peekDoc' - --- | Push a @Doc Text@ value to the Lua stack. -pushDoc :: Pusher (Doc Text) -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 - --- --- Parameters --- - --- | @Doc@ typed function parameter. -docParam :: Text -> Parameter (Doc Text) -docParam name = parameter peekDoc "Doc" name "" - --- | @Int@ typed function parameter. -intParam :: Text -> Parameter Int -intParam name = parameter (peekIntegral @Int) "integer "name "" - --- | @Text@ typed function parameter. -textParam :: Text -> Parameter Text -textParam name = parameter peekText "string" name "" - --- --- Results --- - --- | Boolean function result. -booleanResult :: Text -- ^ Description - -> FunctionResults Bool -booleanResult = functionResult pushBool "boolean" - --- | Function result of type @'Doc'@. -docResult :: Text -- ^ Description - -> FunctionResults (Doc Text) -docResult = functionResult pushDoc "Doc" - --- | Function result of type @'Int'@. -intResult :: Text -- ^ Description - -> FunctionResults Int -intResult = functionResult (pushIntegral @Int) "integer" - diff --git a/src/HsLua/Module/DocLayout.hs b/src/HsLua/Module/DocLayout.hs new file mode 100644 --- /dev/null +++ b/src/HsLua/Module/DocLayout.hs @@ -0,0 +1,566 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module : HsLua.Module.DocLayout +Copyright : © 2020-2021 Albert Krewinkel +License : MIT +Maintainer : Albert Krewinkel + +Provides a Lua module which wraps @'Text.DocLayout'@. The @Doc' +type is specialized to @'Text'@. + +This module defines orphan instances for @Doc Text@. +-} +module HsLua.Module.DocLayout ( + -- * Module + documentedModule + , pushModule + , preloadModule + , description + , fields + , functions + + -- * 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 HsLua as Lua hiding (concat, render) +import Text.DocLayout (Doc, (<+>), ($$), ($+$)) + +import qualified Data.Text as T +import qualified Text.DocLayout as Doc + +#if ! MIN_VERSION_base(4, 11, 0) +import Data.Monoid ((<>)) +#endif + +-- +-- Module +-- + +-- | Textual description of the "doclayout" module. +description :: Text +description = "Plain-text document layouting." + +-- | Self-documenting module. +documentedModule :: LuaError e => Module e +documentedModule = Module + { moduleName = "doclayout" + , moduleFields = fields + , moduleDescription = description + , moduleFunctions = functions + , moduleOperations = [] + } + +-- +-- Fields +-- + +-- | Exposed fields. +fields :: LuaError e => [Field e] +fields = + [ blankline + , cr + , empty + , space + ] + +-- | Wrapped and documented 'Doc.blankline' value. +blankline :: LuaError e => Field e +blankline = Field + { fieldName = "blankline" + , fieldDescription = "Inserts a blank line unless one exists already." + , fieldPushValue = pushDoc Doc.blankline + } + +-- | Wrapped and documented 'Doc.cr' value. +cr :: LuaError e => Field e +cr = Field + { fieldName = "cr" + , fieldDescription = "A carriage return. Does nothing if we're at " <> + "the beginning of a line; " <> + "otherwise inserts a newline." + , fieldPushValue = pushDoc Doc.cr + } + +-- | Wrapped and documented 'Doc.empty' value. +empty :: LuaError e => Field e +empty = Field + { fieldName = "empty" + , fieldDescription = "The empty document." + , fieldPushValue = pushDoc Doc.empty + } + +-- | Wrapped and documented 'Doc.space' value. +space :: LuaError e => Field e +space = Field + { fieldName = "space" + , fieldDescription = "A breaking (reflowable) space." + , fieldPushValue = pushDoc Doc.space + } + +-- +-- Functions +-- + +-- | Exposed module functions. +functions :: LuaError e => [DocumentedFunction e] +functions = + [ -- Constructors + after_break + , before_non_blank + , blanklines + , braces + , brackets + , cblock + , chomp + , concat + , double_quotes + , flush + , hang + , inside + , lblock + , literal + , nest + , nestle + , nowrap + , parens + , prefixed + , quotes + , rblock + , vfill + -- rendering + , render + -- querying + , is_empty + , height + , min_offset + , offset + , real_length + , update_column + ] + +typeDoc :: LuaError e => DocumentedType e (Doc Text) +typeDoc = deftype "Doc" + [ operation Add $ binaryOp (<+>) + "Concatenated docs, with breakable space between them." + , operation Concat $ binaryOp (<>) "Concatenation of the input docs" + , operation Div $ binaryOp ($$) "Puts a above b" + , operation Eq $ lambda + ### liftPure2 (==) + <#> docParam "a" + <#> docParam "b" + =#> booleanResult "whether the two Docs are equal" + , operation Idiv $ binaryOp ($+$) "Puts a above b" + , operation Tostring $ lambda + ### liftPure (Doc.render Nothing) + <#> docParam "doc" + =#> textResult "Rendered Doc without reflowing." + ] + [] + where + binaryOp op descr = lambda + ### liftPure2 op + <#> docParam "a" + <#> docParam "b" + =#> docResult descr + +-- | 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 :: LuaError e => DocumentedFunction e +render = defun "render" + ### liftPure2 (flip Doc.render) + <#> docParam "doc" + <#> optionalParameter (peekIntegral @Int) "integer" "colwidth" "" + =#> functionResult pushText "Doc" "rendered doc" + #? ("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.") + +-- +-- Querying +-- + +-- | @True@ iff the document is empty. +is_empty :: LuaError e => DocumentedFunction e +is_empty = defun "is_empty" + ### liftPure Doc.isEmpty + <#> docParam "doc" + =#> booleanResult "`true` iff `doc` is the empty document, `false` otherwise." + #? "Checks whether a doc is empty." + +-- | Returns the width of a @'Doc'@. +offset :: LuaError e => DocumentedFunction e +offset = defun "offset" + ### liftPure Doc.offset + <#> docParam "doc" + =#> intResult "doc width" + #? "Returns the width of a `Doc` as number of characters." + +-- | Returns the minimal width of a @'Doc'@ when reflowed at +-- breakable spaces. +min_offset :: LuaError e => DocumentedFunction e +min_offset = defun "min_offset" + ### liftPure Doc.minOffset + <#> docParam "doc" + =#> intResult "minimal possible width" + #? ("Returns the minimal width of a `Doc` when reflowed at " <> + "breakable spaces.") + +-- | Returns the column that would be occupied by the last laid +-- out character. +update_column :: LuaError e => DocumentedFunction e +update_column = defun "update_column" + ### liftPure2 Doc.updateColumn + <#> docParam "doc" + <#> intParam "i" + =#> intResult "column number" + #? ("Returns the column that would be occupied by the last " <> + "laid out character.") + +-- | Returns the height of a block or other Doc. +height :: LuaError e => DocumentedFunction e +height = defun "height" + ### liftPure Doc.height + <#> docParam "doc" + =#> intResult "doc height" + #? "Returns the height of a block or other Doc." + + +-- | 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 :: DocumentedFunction e +real_length = defun "real_length" + ### liftPure Doc.realLength + <#> textParam "str" + =#> intResult "text length" + #? ("Returns the real length of a string in a monospace font: " <> + "0 for a combining chaeracter, 1 for a regular character, " <> + "2 for an East Asian wide character.") + +-- +-- Constructors +-- + +-- | Creates a @'Doc'@ which is conditionally included only if it +-- comes at the beginning of a line. +after_break :: LuaError e => DocumentedFunction e +after_break = defun "after_break" + ### liftPure Doc.afterBreak + <#> textParam "text" + =#> docResult "new doc" + #? ("Creates a `Doc` which is conditionally included only if it" <> + "comes at the beginning of a line.") + +-- | Conditionally includes the given @'Doc'@ unless it is +-- followed by a blank space. +before_non_blank :: LuaError e => DocumentedFunction e +before_non_blank = defun "before_non_blank" + ### liftPure Doc.beforeNonBlank + <#> docParam "doc" + =#> docResult "conditional doc" + #? ("Conditionally includes the given `doc` unless it is " <> + "followed by a blank space.") + +-- | Insert blank lines unless they exist already. +blanklines :: LuaError e => DocumentedFunction e +blanklines = defun "blanklines" + ### liftPure Doc.blanklines + <#> intParam "n" + =#> docResult "conditional blank lines" + #? "Inserts blank lines unless they exist already." + +-- | Puts a @'Doc'@ in curly braces. +braces :: LuaError e => DocumentedFunction e +braces = defun "braces" + ### liftPure Doc.braces + <#> docParam "doc" + =#> docResult "doc enclosed by {}." + #? "Puts the `doc` in curly braces." + +-- | Puts a @'Doc'@ in square brackets. +brackets :: LuaError e => DocumentedFunction e -- Doc Text -> Lua (Doc Text) +brackets = defun "brackets" + ### liftPure Doc.brackets + <#> docParam "doc" + =#> docResult "doc enclosed by []." + #? "Puts the `doc` in square brackets" + +-- | Like @'lblock'@ but aligned centered. +cblock :: LuaError e => DocumentedFunction e +cblock = defun "cblock" + ### liftPure2 Doc.cblock + <#> parameter peekIntegral "integer" "width" "block width in chars" + <#> docParam "doc" + =#> docResult ("doc, aligned centered in a block with max" <> + "`width` chars per line.") + #? ("Creates a block with the given width and content, " <> + "aligned centered.") + +-- | Chomps trailing blank space off of a @'Doc'@. +chomp :: LuaError e => DocumentedFunction e +chomp = defun "chomp" + ### liftPure Doc.chomp + <#> docParam "doc" + =#> docResult "`doc` without trailing blanks" + #? "Chomps trailing blank space off of the `doc`." + +-- | Concatenates a list of @'Doc'@s. +concat :: LuaError e => DocumentedFunction e +concat = defun "concat" + ### liftPure2 (\docs optSep -> mconcat $ + maybe docs (`intersperse` docs) optSep) + <#> parameter (peekList peekDoc) "`{Doc,...}`" "docs" "list of Docs" + <#> optionalParameter peekDoc "Doc" "sep" "separator" + =#> docResult "concatenated doc" + #? "Concatenates a list of `Doc`s." + +-- | Wraps a @'Doc'@ in double quotes +double_quotes :: LuaError e => DocumentedFunction e +double_quotes = defun "double_quotes" + ### liftPure Doc.doubleQuotes + <#> docParam "doc" + =#> docResult "`doc` enclosed by `\"` chars" + #? "Wraps a `Doc` in double quotes." + +-- | Makes a @'Doc'@ flush against the left margin. +flush :: LuaError e => DocumentedFunction e +flush = defun "flush" + ### liftPure Doc.flush + <#> docParam "doc" + =#> docResult "flushed `doc`" + #? "Makes a `Doc` flush against the left margin." + +-- | Creates a hanging indent. +hang :: LuaError e => DocumentedFunction e +hang = defun "hang" + ### liftPure3 Doc.hang + <#> parameter peekIntegral "integer" "ind" "indentation width" + <#> docParam "start" + <#> docParam "doc" + =#> docResult ("`doc` prefixed by `start` on the first line, " <> + "subsequent lines indented by `ind` spaces.") + #? "Creates a hanging indent." + +-- | Encloses a @'Doc'@ inside a start and end @'Doc'@. +inside :: LuaError e => DocumentedFunction e +inside = defun "inside" + ### liftPure3 Doc.inside + <#> docParam "start" + <#> docParam "end" + <#> docParam "contents" + =#> docResult "enclosed contents" + #? "Encloses a `Doc` inside a start and end `Doc`." + +-- | Creates a block with the given width and content, aligned to +-- the left. +lblock :: LuaError e => DocumentedFunction e +lblock = defun "lblock" + ### liftPure2 Doc.lblock + <#> parameter peekIntegral "integer" "width" "block width in chars" + <#> docParam "doc" + =#> docResult "doc put into block with max `width` chars per line." + #? ("Creates a block with the given width and content, " <> + "aligned to the left.") + +-- | Creates a @'Doc'@ from a string. +literal :: LuaError e => DocumentedFunction e +literal = defun "literal" + ### liftPure Doc.literal + <#> textParam "string" + =#> docResult "doc contatining just the literal string" + #? "Creates a `Doc` from a string." + +-- | Indents a @'Doc'@ by the specified number of spaces. +nest :: LuaError e => DocumentedFunction e +nest = defun "nest" + ### liftPure2 Doc.nest + <#> parameter peekIntegral "integer" "ind" "indentation size" + <#> docParam "doc" + =#> docResult "`doc` indented by `ind` spaces" + #? "Indents a `Doc` by the specified number of spaces." + +-- | Removes leading blank lines from a @'Doc'@. +nestle :: LuaError e => DocumentedFunction e +nestle = defun "nestle" + ### liftPure Doc.nestle + <#> docParam "doc" + =#> docResult "`doc` with leading blanks removed" + #? "Removes leading blank lines from a `Doc`." + +-- | Makes a @'Doc'@ non-reflowable. +nowrap :: LuaError e => DocumentedFunction e +nowrap = defun "nowrap" + ### liftPure Doc.nowrap + <#> docParam "doc" + =#> docResult "same as input, but non-reflowable" + #? "Makes a `Doc` non-reflowable." + +-- | Puts a @'Doc'@ in parentheses. +parens :: LuaError e => DocumentedFunction e +parens = defun "parens" + ### liftPure Doc.parens + <#> docParam "doc" + =#> docResult "doc enclosed by ()." + #? "Puts the `doc` in parentheses." + + +-- | 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 :: LuaError e => DocumentedFunction e +prefixed = defun "prefixed" + ### liftPure2 Doc.prefixed + <#> parameter peekString "string" "prefix" "prefix for each line" + <#> docParam "doc" + =#> docResult "prefixed `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).") + +-- | Wraps a @'Doc'@ in single quotes. +quotes :: LuaError e => DocumentedFunction e +quotes = defun "quotes" + ### liftPure Doc.quotes + <#> docParam "doc" + =#> docResult "doc enclosed in `'`." + #? "Wraps a `Doc` in single quotes." + +-- | Like @'rblock'@ but aligned to the right. +rblock :: LuaError e => DocumentedFunction e +rblock = defun "rblock" + ### liftPure2 Doc.rblock + <#> parameter peekIntegral "integer" "width" "block width in chars" + <#> docParam "doc" + =#> docResult ("doc, right aligned in a block with max" <> + "`width` chars per line.") + #? ("Creates a block with the given width and content, " <> + "aligned to the right.") + +-- | An expandable border that, when placed next to a box, +-- expands to the height of the box. Strings cycle through the +-- list provided. +vfill :: LuaError e => DocumentedFunction e +vfill = defun "vfill" + ### liftPure Doc.vfill + <#> textParam "border" + =#> docResult "automatically expanding border Doc" + #? ("An expandable border that, when placed next to a box, " <> + "expands to the height of the box. Strings cycle through the " <> + "list provided.") + +-- +-- Marshaling +-- + +-- | Retrieve a @Doc Text@ value from the Lua stack. Strings are +-- converted to plain @'Doc'@ values. +peekDoc :: LuaError e => Peeker e (Doc Text) +peekDoc idx = liftLua (Lua.ltype idx) >>= \case + Lua.TypeString -> let stringToDoc s = if T.null s + then Doc.empty + else Doc.literal s + in stringToDoc <$> Lua.peekText idx + Lua.TypeNumber -> Doc.literal <$> Lua.peekText idx + _ -> peekUD typeDoc idx + +-- | Push a @Doc Text@ value to the Lua stack. +pushDoc :: LuaError e => Pusher e (Doc Text) +pushDoc = pushUD typeDoc + +instance Peekable (Doc Text) where + peek = forcePeek . peekDoc + +instance Pushable (Doc Text) where + push = pushDoc + +-- +-- Parameters +-- + +-- | @Doc@ typed function parameter. +docParam :: LuaError e => Text -> Parameter e (Doc Text) +docParam name = parameter peekDoc "Doc" name "" + +-- | @Int@ typed function parameter. +intParam :: Text -> Parameter e Int +intParam name = parameter (peekIntegral @Int) "integer "name "" + +-- | @Text@ typed function parameter. +textParam :: Text -> Parameter e Text +textParam name = parameter peekText "string" name "" + +-- +-- Results +-- + +-- | Boolean function result. +booleanResult :: Text -- ^ Description + -> FunctionResults e Bool +booleanResult = functionResult pushBool "boolean" + +-- | Function result of type @'Doc'@. +docResult :: LuaError e + => Text -- ^ Description + -> FunctionResults e (Doc Text) +docResult = functionResult pushDoc "Doc" + +-- | Function result of type @'Int'@. +intResult :: Text -- ^ Description + -> FunctionResults e Int +intResult = functionResult (pushIntegral @Int) "integer" + +-- | Function result of type @'Text'@. +textResult :: Text -- ^ Description + -> FunctionResults e Text +textResult = functionResult pushText "text" diff --git a/test/test-hslua-module-doclayout.hs b/test/test-hslua-module-doclayout.hs --- a/test/test-hslua-module-doclayout.hs +++ b/test/test-hslua-module-doclayout.hs @@ -1,31 +1,30 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} {-| Module : Main -Copyright : © 2020 Albert Krewinkel +Copyright : © 2020-2021 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 HsLua (Lua) +import HsLua.Module.DocLayout (documentedModule) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (assertEqual, testCase) import Test.Tasty.Lua (translateResultsFromFile) -import qualified Foreign.Lua as Lua +import qualified HsLua as Lua main :: IO () main = do - luaTestResults <- Lua.run $ do + luaTestResults <- Lua.run @Lua.Exception $ do Lua.openlibs - Lua.requirehs "doclayout" (void pushModule) + Lua.registerModule documentedModule + Lua.pop 1 -- pop module table translateResultsFromFile "test/test-doclayout.lua" defaultMain $ testGroup "hslua-module-doclayout" [tests, luaTestResults] @@ -33,20 +32,20 @@ tests :: TestTree tests = testGroup "HsLua doclayout module" [ testCase "module can be pushed to the stack" $ - Lua.run (void pushModule) + Lua.run (void (Lua.pushModule documentedModule) :: Lua ()) , testCase "module can be added to the preloader" . Lua.run $ do Lua.openlibs - preloadModule "doclayout" + Lua.preloadModule documentedModule 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 + , testCase "module can be loaded as `layout`" . Lua.run $ do Lua.openlibs - preloadModule "doclayout" + Lua.preloadModuleWithName documentedModule "layout" assertEqual' "loading the module fails " Lua.OK =<< - Lua.dostring "require 'doclayout'" + Lua.dostring "require 'layout'" ] assertEqual' :: (Show a, Eq a) => String -> a -> a -> Lua ()