hslua-module-doclayout 0.2.0.1 → 1.0.0

raw patch · 6 files changed

+599/−602 lines, 6 filesdep ~hsluadep ~tasty-luaPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hslua, tasty-lua

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• LICENSE +1/−1
• hslua-module-doclayout.cabal +11/−10
• src/Foreign/Lua/Module/DocLayout.hs +0/−577
• src/HsLua/Module/DocLayout.hs +566/−0
• test/test-hslua-module-doclayout.hs +13/−14

@@ -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.

@@ -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

@@ -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 <albert@zeitkraut.de>-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

@@ -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 <albert+hslua@zeitkraut.de>-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"-

@@ -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 <albert+hslua@zeitkraut.de>++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"

@@ -1,31 +1,30 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications  #-} {-| Module      : Main-Copyright   : © 2020 Albert Krewinkel+Copyright   : © 2020-2021 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <albert+hslua@zeitkraut.de>-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 ()