{-# 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 :: Text
description = Text
"Plain-text document layouting."

-- | Self-documenting module.
documentedModule :: LuaError e => Module e
documentedModule :: Module e
documentedModule = Module :: forall e.
Name
-> Text
-> [Field e]
-> [DocumentedFunction e]
-> [(Operation, DocumentedFunction e)]
-> Module e
Module
  { moduleName :: Name
moduleName = Name
"doclayout"
  , moduleFields :: [Field e]
moduleFields = [Field e]
forall e. LuaError e => [Field e]
fields
  , moduleDescription :: Text
moduleDescription = Text
description
  , moduleFunctions :: [DocumentedFunction e]
moduleFunctions = [DocumentedFunction e]
forall e. LuaError e => [DocumentedFunction e]
functions
  , moduleOperations :: [(Operation, DocumentedFunction e)]
moduleOperations = []
  }

--
-- Fields
--

-- | Exposed fields.
fields :: LuaError e => [Field e]
fields :: [Field e]
fields =
  [ Field e
forall e. LuaError e => Field e
blankline
  , Field e
forall e. LuaError e => Field e
cr
  , Field e
forall e. LuaError e => Field e
empty
  , Field e
forall e. LuaError e => Field e
space
  ]

-- | Wrapped and documented 'Doc.blankline' value.
blankline :: LuaError e => Field e
blankline :: Field e
blankline = Field :: forall e. Text -> Text -> LuaE e () -> Field e
Field
  { fieldName :: Text
fieldName = Text
"blankline"
  , fieldDescription :: Text
fieldDescription = Text
"Inserts a blank line unless one exists already."
  , fieldPushValue :: LuaE e ()
fieldPushValue = Pusher e (Doc Text)
forall e. LuaError e => Pusher e (Doc Text)
pushDoc Doc Text
forall a. Doc a
Doc.blankline
  }

-- | Wrapped and documented 'Doc.cr' value.
cr :: LuaError e => Field e
cr :: Field e
cr = Field :: forall e. Text -> Text -> LuaE e () -> Field e
Field
  { fieldName :: Text
fieldName = Text
"cr"
  , fieldDescription :: Text
fieldDescription = Text
"A carriage return. Does nothing if we're at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                       Text
"the beginning of a line; " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                       Text
"otherwise inserts a newline."
  , fieldPushValue :: LuaE e ()
fieldPushValue = Pusher e (Doc Text)
forall e. LuaError e => Pusher e (Doc Text)
pushDoc Doc Text
forall a. Doc a
Doc.cr
  }

-- | Wrapped and documented 'Doc.empty' value.
empty :: LuaError e => Field e
empty :: Field e
empty = Field :: forall e. Text -> Text -> LuaE e () -> Field e
Field
  { fieldName :: Text
fieldName = Text
"empty"
  , fieldDescription :: Text
fieldDescription = Text
"The empty document."
  , fieldPushValue :: LuaE e ()
fieldPushValue = Pusher e (Doc Text)
forall e. LuaError e => Pusher e (Doc Text)
pushDoc Doc Text
forall a. Doc a
Doc.empty
  }

-- | Wrapped and documented 'Doc.space' value.
space :: LuaError e => Field e
space :: Field e
space = Field :: forall e. Text -> Text -> LuaE e () -> Field e
Field
  { fieldName :: Text
fieldName = Text
"space"
  , fieldDescription :: Text
fieldDescription = Text
"A breaking (reflowable) space."
  , fieldPushValue :: LuaE e ()
fieldPushValue = Pusher e (Doc Text)
forall e. LuaError e => Pusher e (Doc Text)
pushDoc Doc Text
forall a. Doc a
Doc.space
  }

--
-- Functions
--

-- | Exposed module functions.
functions :: LuaError e => [DocumentedFunction e]
functions :: [DocumentedFunction e]
functions =
  [ -- Constructors
    DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
after_break
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
before_non_blank
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
blanklines
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
braces
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
brackets
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
cblock
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
chomp
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
concat
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
double_quotes
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
flush
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
hang
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
inside
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
lblock
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
literal
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
nest
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
nestle
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
nowrap
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
parens
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
prefixed
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
quotes
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
rblock
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
vfill
    -- rendering
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
render
    -- querying
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
is_empty
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
height
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
min_offset
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
offset
  , DocumentedFunction e
forall e. DocumentedFunction e
real_length
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
update_column
  ]

typeDoc :: LuaError e => DocumentedType e (Doc Text)
typeDoc :: DocumentedType e (Doc Text)
typeDoc = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) (Doc Text)]
-> DocumentedType e (Doc Text)
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"Doc"
      [ Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Add    (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Doc Text -> Doc Text -> Doc Text) -> Text -> DocumentedFunction e
forall e.
LuaError e =>
(Doc Text -> Doc Text -> Doc Text) -> Text -> DocumentedFunction e
binaryOp Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
(<+>)
        Text
"Concatenated docs, with breakable space between them."
      , Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Concat (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Doc Text -> Doc Text -> Doc Text) -> Text -> DocumentedFunction e
forall e.
LuaError e =>
(Doc Text -> Doc Text -> Doc Text) -> Text -> DocumentedFunction e
binaryOp Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
(<>) Text
"Concatenation of the input docs"
      , Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Div    (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Doc Text -> Doc Text -> Doc Text) -> Text -> DocumentedFunction e
forall e.
LuaError e =>
(Doc Text -> Doc Text -> Doc Text) -> Text -> DocumentedFunction e
binaryOp Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
($$) Text
"Puts a above b"
      , Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Eq     (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Doc Text -> Doc Text -> LuaE e Bool)
-> HsFnPrecursor e (Doc Text -> Doc Text -> LuaE e Bool)
forall a e. a -> HsFnPrecursor e a
lambda
        ### liftPure2 (==)
        HsFnPrecursor e (Doc Text -> Doc Text -> LuaE e Bool)
-> Parameter e (Doc Text)
-> HsFnPrecursor e (Doc Text -> LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"a"
        HsFnPrecursor e (Doc Text -> LuaE e Bool)
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"b"
        HsFnPrecursor e (LuaE e Bool)
-> FunctionResults e Bool -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Bool
forall e. Text -> FunctionResults e Bool
booleanResult Text
"whether the two Docs are equal"
      , Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Idiv   (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Doc Text -> Doc Text -> Doc Text) -> Text -> DocumentedFunction e
forall e.
LuaError e =>
(Doc Text -> Doc Text -> Doc Text) -> Text -> DocumentedFunction e
binaryOp Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
($+$) Text
"Puts a above b"
      , Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Doc Text -> LuaE e Text)
-> HsFnPrecursor e (Doc Text -> LuaE e Text)
forall a e. a -> HsFnPrecursor e a
lambda
        ### liftPure (Doc.render Nothing)
        HsFnPrecursor e (Doc Text -> LuaE e Text)
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e Text)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
        HsFnPrecursor e (LuaE e Text)
-> FunctionResults e Text -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Text
forall e. Text -> FunctionResults e Text
textResult Text
"Rendered Doc without reflowing."
      ]
      []
  where
    binaryOp :: (Doc Text -> Doc Text -> Doc Text) -> Text -> DocumentedFunction e
binaryOp Doc Text -> Doc Text -> Doc Text
op Text
descr = (Doc Text -> Doc Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (Doc Text -> Doc Text -> LuaE e (Doc Text))
forall a e. a -> HsFnPrecursor e a
lambda
      ### liftPure2 op
      HsFnPrecursor e (Doc Text -> Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text)
-> HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"a"
      HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"b"
      HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
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 :: DocumentedFunction e
render = Name
-> (Doc Text -> Maybe Int -> LuaE e Text)
-> HsFnPrecursor e (Doc Text -> Maybe Int -> LuaE e Text)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"render"
  ### liftPure2 (flip Doc.render)
  HsFnPrecursor e (Doc Text -> Maybe Int -> LuaE e Text)
-> Parameter e (Doc Text)
-> HsFnPrecursor e (Maybe Int -> LuaE e Text)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (Maybe Int -> LuaE e Text)
-> Parameter e (Maybe Int) -> HsFnPrecursor e (LuaE e Text)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Int -> Text -> Text -> Text -> Parameter e (Maybe Int)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter (forall e. (Integral Int, Read Int) => Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral @Int) Text
"integer" Text
"colwidth" Text
""
  HsFnPrecursor e (LuaE e Text)
-> FunctionResults e Text -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Text -> Text -> Text -> FunctionResults e Text
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Text
forall e. Pusher e Text
pushText Text
"Doc" Text
"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 :: DocumentedFunction e
is_empty = Name
-> (Doc Text -> LuaE e Bool)
-> HsFnPrecursor e (Doc Text -> LuaE e Bool)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"is_empty"
  ### liftPure Doc.isEmpty
  HsFnPrecursor e (Doc Text -> LuaE e Bool)
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e Bool)
-> FunctionResults e Bool -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Bool
forall e. Text -> FunctionResults e Bool
booleanResult Text
"`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 :: DocumentedFunction e
offset = Name
-> (Doc Text -> LuaE e Int)
-> HsFnPrecursor e (Doc Text -> LuaE e Int)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"offset"
  ### liftPure Doc.offset
  HsFnPrecursor e (Doc Text -> LuaE e Int)
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e Int)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e Int)
-> FunctionResults e Int -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Int
forall e. Text -> FunctionResults e Int
intResult Text
"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 :: DocumentedFunction e
min_offset = Name
-> (Doc Text -> LuaE e Int)
-> HsFnPrecursor e (Doc Text -> LuaE e Int)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"min_offset"
  ### liftPure Doc.minOffset
  HsFnPrecursor e (Doc Text -> LuaE e Int)
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e Int)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e Int)
-> FunctionResults e Int -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Int
forall e. Text -> FunctionResults e Int
intResult Text
"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 :: DocumentedFunction e
update_column = Name
-> (Doc Text -> Int -> LuaE e Int)
-> HsFnPrecursor e (Doc Text -> Int -> LuaE e Int)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"update_column"
  ### liftPure2 Doc.updateColumn
  HsFnPrecursor e (Doc Text -> Int -> LuaE e Int)
-> Parameter e (Doc Text) -> HsFnPrecursor e (Int -> LuaE e Int)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (Int -> LuaE e Int)
-> Parameter e Int -> HsFnPrecursor e (LuaE e Int)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e Int
forall e. Text -> Parameter e Int
intParam Text
"i"
  HsFnPrecursor e (LuaE e Int)
-> FunctionResults e Int -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Int
forall e. Text -> FunctionResults e Int
intResult Text
"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 :: DocumentedFunction e
height = Name
-> (Doc Text -> LuaE e Int)
-> HsFnPrecursor e (Doc Text -> LuaE e Int)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"height"
  ### liftPure Doc.height
  HsFnPrecursor e (Doc Text -> LuaE e Int)
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e Int)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e Int)
-> FunctionResults e Int -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Int
forall e. Text -> FunctionResults e Int
intResult Text
"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 :: DocumentedFunction e
real_length = Name
-> (Text -> LuaE e Int) -> HsFnPrecursor e (Text -> LuaE e Int)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"real_length"
  ### liftPure Doc.realLength
  HsFnPrecursor e (Text -> LuaE e Int)
-> Parameter e Text -> HsFnPrecursor e (LuaE e Int)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e Text
forall e. Text -> Parameter e Text
textParam Text
"str"
  HsFnPrecursor e (LuaE e Int)
-> FunctionResults e Int -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Int
forall e. Text -> FunctionResults e Int
intResult Text
"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 :: DocumentedFunction e
after_break = Name
-> (Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"after_break"
  ### liftPure Doc.afterBreak
  HsFnPrecursor e (Text -> LuaE e (Doc Text))
-> Parameter e Text -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e Text
forall e. Text -> Parameter e Text
textParam Text
"text"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"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 :: DocumentedFunction e
before_non_blank = Name
-> (Doc Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"before_non_blank"
  ### liftPure Doc.beforeNonBlank
  HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"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 :: DocumentedFunction e
blanklines = Name
-> (Int -> LuaE e (Doc Text))
-> HsFnPrecursor e (Int -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"blanklines"
  ### liftPure Doc.blanklines
  HsFnPrecursor e (Int -> LuaE e (Doc Text))
-> Parameter e Int -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e Int
forall e. Text -> Parameter e Int
intParam Text
"n"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"conditional blank lines"
  #? "Inserts blank lines unless they exist already."

-- | Puts a @'Doc'@ in curly braces.
braces :: LuaError e => DocumentedFunction e
braces :: DocumentedFunction e
braces = Name
-> (Doc Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"braces"
  ### liftPure Doc.braces
  HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"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 :: DocumentedFunction e
brackets = Name
-> (Doc Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"brackets"
  ### liftPure Doc.brackets
  HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"doc enclosed by []."
  #? "Puts the `doc` in square brackets"

-- | Like @'lblock'@ but aligned centered.
cblock :: LuaError e => DocumentedFunction e
cblock :: DocumentedFunction e
cblock = Name
-> (Int -> Doc Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (Int -> Doc Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"cblock"
  ### liftPure2 Doc.cblock
  HsFnPrecursor e (Int -> Doc Text -> LuaE e (Doc Text))
-> Parameter e Int
-> HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Int -> Text -> Text -> Text -> Parameter e Int
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Text
"integer" Text
"width" Text
"block width in chars"
  HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult (Text
"doc, aligned centered in a block with max" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                 Text
"`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 :: DocumentedFunction e
chomp = Name
-> (Doc Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"chomp"
  ### liftPure Doc.chomp
  HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"`doc` without trailing blanks"
  #? "Chomps trailing blank space off of the `doc`."

-- | Concatenates a list of @'Doc'@s.
concat :: LuaError e => DocumentedFunction e
concat :: DocumentedFunction e
concat = Name
-> ([Doc Text] -> Maybe (Doc Text) -> LuaE e (Doc Text))
-> HsFnPrecursor
     e ([Doc Text] -> Maybe (Doc Text) -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"concat"
  ### liftPure2 (\docs optSep -> mconcat $
                  maybe docs (`intersperse` docs) optSep)
  HsFnPrecursor
  e ([Doc Text] -> Maybe (Doc Text) -> LuaE e (Doc Text))
-> Parameter e [Doc Text]
-> HsFnPrecursor e (Maybe (Doc Text) -> LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Doc Text]
-> Text -> Text -> Text -> Parameter e [Doc Text]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (Peeker e (Doc Text) -> Peeker e [Doc Text]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e (Doc Text)
forall e. LuaError e => Peeker e (Doc Text)
peekDoc) Text
"`{Doc,...}`" Text
"docs" Text
"list of Docs"
  HsFnPrecursor e (Maybe (Doc Text) -> LuaE e (Doc Text))
-> Parameter e (Maybe (Doc Text))
-> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Doc Text)
-> Text -> Text -> Text -> Parameter e (Maybe (Doc Text))
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e (Doc Text)
forall e. LuaError e => Peeker e (Doc Text)
peekDoc Text
"Doc" Text
"sep" Text
"separator"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"concatenated doc"
  #? "Concatenates a list of `Doc`s."

-- | Wraps a @'Doc'@ in double quotes
double_quotes :: LuaError e => DocumentedFunction e
double_quotes :: DocumentedFunction e
double_quotes = Name
-> (Doc Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"double_quotes"
  ### liftPure Doc.doubleQuotes
  HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"`doc` enclosed by `\"` chars"
  #? "Wraps a `Doc` in double quotes."

-- | Makes a @'Doc'@ flush against the left margin.
flush :: LuaError e => DocumentedFunction e
flush :: DocumentedFunction e
flush = Name
-> (Doc Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"flush"
  ### liftPure Doc.flush
  HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"flushed `doc`"
  #? "Makes a `Doc` flush against the left margin."

-- | Creates a hanging indent.
hang :: LuaError e => DocumentedFunction e
hang :: DocumentedFunction e
hang = Name
-> (Int -> Doc Text -> Doc Text -> LuaE e (Doc Text))
-> HsFnPrecursor
     e (Int -> Doc Text -> Doc Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"hang"
  ### liftPure3 Doc.hang
  HsFnPrecursor e (Int -> Doc Text -> Doc Text -> LuaE e (Doc Text))
-> Parameter e Int
-> HsFnPrecursor e (Doc Text -> Doc Text -> LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Int -> Text -> Text -> Text -> Parameter e Int
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Text
"integer" Text
"ind" Text
"indentation width"
  HsFnPrecursor e (Doc Text -> Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text)
-> HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"start"
  HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult (Text
"`doc` prefixed by `start` on the first line, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                 Text
"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 :: DocumentedFunction e
inside = Name
-> (Doc Text -> Doc Text -> Doc Text -> LuaE e (Doc Text))
-> HsFnPrecursor
     e (Doc Text -> Doc Text -> Doc Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"inside"
  ### liftPure3 Doc.inside
  HsFnPrecursor
  e (Doc Text -> Doc Text -> Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text)
-> HsFnPrecursor e (Doc Text -> Doc Text -> LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"start"
  HsFnPrecursor e (Doc Text -> Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text)
-> HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"end"
  HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"contents"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"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 :: DocumentedFunction e
lblock = Name
-> (Int -> Doc Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (Int -> Doc Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"lblock"
  ### liftPure2 Doc.lblock
  HsFnPrecursor e (Int -> Doc Text -> LuaE e (Doc Text))
-> Parameter e Int
-> HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Int -> Text -> Text -> Text -> Parameter e Int
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Text
"integer" Text
"width" Text
"block width in chars"
  HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"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 :: DocumentedFunction e
literal = Name
-> (Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"literal"
  ### liftPure Doc.literal
  HsFnPrecursor e (Text -> LuaE e (Doc Text))
-> Parameter e Text -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e Text
forall e. Text -> Parameter e Text
textParam Text
"string"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"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 :: DocumentedFunction e
nest = Name
-> (Int -> Doc Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (Int -> Doc Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"nest"
  ### liftPure2 Doc.nest
  HsFnPrecursor e (Int -> Doc Text -> LuaE e (Doc Text))
-> Parameter e Int
-> HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Int -> Text -> Text -> Text -> Parameter e Int
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Text
"integer" Text
"ind" Text
"indentation size"
  HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"`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 :: DocumentedFunction e
nestle = Name
-> (Doc Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"nestle"
  ### liftPure Doc.nestle
  HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"`doc` with leading blanks removed"
  #? "Removes leading blank lines from a `Doc`."

-- | Makes a @'Doc'@ non-reflowable.
nowrap :: LuaError e => DocumentedFunction e
nowrap :: DocumentedFunction e
nowrap = Name
-> (Doc Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"nowrap"
  ### liftPure Doc.nowrap
  HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"same as input, but non-reflowable"
  #? "Makes a `Doc` non-reflowable."

-- | Puts a @'Doc'@ in parentheses.
parens :: LuaError e => DocumentedFunction e
parens :: DocumentedFunction e
parens = Name
-> (Doc Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"parens"
  ### liftPure Doc.parens
  HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"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 :: DocumentedFunction e
prefixed = Name
-> (String -> Doc Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (String -> Doc Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"prefixed"
  ### liftPure2 Doc.prefixed
  HsFnPrecursor e (String -> Doc Text -> LuaE e (Doc Text))
-> Parameter e String
-> HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e String -> Text -> Text -> Text -> Parameter e String
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e String
forall e. Peeker e String
peekString Text
"string" Text
"prefix" Text
"prefix for each line"
  HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"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 :: DocumentedFunction e
quotes = Name
-> (Doc Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"quotes"
  ### liftPure Doc.quotes
  HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"doc enclosed in `'`."
  #? "Wraps a `Doc` in single quotes."

-- | Like @'rblock'@ but aligned to the right.
rblock :: LuaError e => DocumentedFunction e
rblock :: DocumentedFunction e
rblock = Name
-> (Int -> Doc Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (Int -> Doc Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"rblock"
  ### liftPure2 Doc.rblock
  HsFnPrecursor e (Int -> Doc Text -> LuaE e (Doc Text))
-> Parameter e Int
-> HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Int -> Text -> Text -> Text -> Parameter e Int
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Text
"integer" Text
"width" Text
"block width in chars"
  HsFnPrecursor e (Doc Text -> LuaE e (Doc Text))
-> Parameter e (Doc Text) -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e (Doc Text)
forall e. LuaError e => Text -> Parameter e (Doc Text)
docParam Text
"doc"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult (Text
"doc, right aligned in a block with max" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                 Text
"`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 :: DocumentedFunction e
vfill = Name
-> (Text -> LuaE e (Doc Text))
-> HsFnPrecursor e (Text -> LuaE e (Doc Text))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"vfill"
  ### liftPure Doc.vfill
  HsFnPrecursor e (Text -> LuaE e (Doc Text))
-> Parameter e Text -> HsFnPrecursor e (LuaE e (Doc Text))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e Text
forall e. Text -> Parameter e Text
textParam Text
"border"
  HsFnPrecursor e (LuaE e (Doc Text))
-> FunctionResults e (Doc Text) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e (Doc Text)
forall e. LuaError e => Text -> FunctionResults e (Doc Text)
docResult Text
"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 :: Peeker e (Doc Text)
peekDoc StackIndex
idx = LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
Lua.ltype StackIndex
idx) Peek e Type -> (Type -> Peek e (Doc Text)) -> Peek e (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
Lua.TypeString   -> let stringToDoc :: Text -> Doc Text
stringToDoc Text
s = if Text -> Bool
T.null Text
s
                                          then Doc Text
forall a. Doc a
Doc.empty
                                          else Text -> Doc Text
forall a. HasChars a => a -> Doc a
Doc.literal Text
s
                      in Text -> Doc Text
stringToDoc (Text -> Doc Text) -> Peek e Text -> Peek e (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker e Text
forall e. Peeker e Text
Lua.peekText StackIndex
idx
  Type
Lua.TypeNumber   -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
Doc.literal (Text -> Doc Text) -> Peek e Text -> Peek e (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker e Text
forall e. Peeker e Text
Lua.peekText StackIndex
idx
  Type
_                -> UDTypeWithList e (DocumentedFunction e) (Doc Text) Void
-> Peeker e (Doc Text)
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e (DocumentedFunction e) (Doc Text) Void
forall e. LuaError e => DocumentedType e (Doc Text)
typeDoc StackIndex
idx

-- | Push a @Doc Text@ value to the Lua stack.
pushDoc :: LuaError e => Pusher e (Doc Text)
pushDoc :: Pusher e (Doc Text)
pushDoc = UDTypeWithList e (DocumentedFunction e) (Doc Text) Void
-> Pusher e (Doc Text)
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e (DocumentedFunction e) (Doc Text) Void
forall e. LuaError e => DocumentedType e (Doc Text)
typeDoc

instance Peekable (Doc Text) where
  peek :: StackIndex -> LuaE e (Doc Text)
peek = Peek e (Doc Text) -> LuaE e (Doc Text)
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e (Doc Text) -> LuaE e (Doc Text))
-> (StackIndex -> Peek e (Doc Text))
-> StackIndex
-> LuaE e (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e (Doc Text)
forall e. LuaError e => Peeker e (Doc Text)
peekDoc

instance Pushable (Doc Text) where
  push :: Doc Text -> LuaE e ()
push = Doc Text -> LuaE e ()
forall e. LuaError e => Pusher e (Doc Text)
pushDoc

--
-- Parameters
--

-- | @Doc@ typed function parameter.
docParam :: LuaError e => Text -> Parameter e (Doc Text)
docParam :: Text -> Parameter e (Doc Text)
docParam Text
name = Peeker e (Doc Text)
-> Text -> Text -> Text -> Parameter e (Doc Text)
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e (Doc Text)
forall e. LuaError e => Peeker e (Doc Text)
peekDoc Text
"Doc" Text
name Text
""

-- | @Int@ typed function parameter.
intParam :: Text -> Parameter e Int
intParam :: Text -> Parameter e Int
intParam Text
name = Peeker e Int -> Text -> Text -> Text -> Parameter e Int
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (forall e. (Integral Int, Read Int) => Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral @Int) Text
"integer "Text
name Text
""

-- | @Text@ typed function parameter.
textParam :: Text -> Parameter e Text
textParam :: Text -> Parameter e Text
textParam Text
name = Peeker e Text -> Text -> Text -> Text -> Parameter e Text
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Text
forall e. Peeker e Text
peekText Text
"string" Text
name Text
""

--
-- Results
--

-- | Boolean function result.
booleanResult :: Text -- ^ Description
              -> FunctionResults e Bool
booleanResult :: Text -> FunctionResults e Bool
booleanResult = Pusher e Bool -> Text -> Text -> FunctionResults e Bool
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Bool
forall e. Pusher e Bool
pushBool Text
"boolean"

-- | Function result of type @'Doc'@.
docResult :: LuaError e
          => Text -- ^ Description
          -> FunctionResults e (Doc Text)
docResult :: Text -> FunctionResults e (Doc Text)
docResult = Pusher e (Doc Text) -> Text -> Text -> FunctionResults e (Doc Text)
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e (Doc Text)
forall e. LuaError e => Pusher e (Doc Text)
pushDoc Text
"Doc"

-- | Function result of type @'Int'@.
intResult :: Text -- ^ Description
          -> FunctionResults e Int
intResult :: Text -> FunctionResults e Int
intResult = Pusher e Int -> Text -> Text -> FunctionResults e Int
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult (forall e. (Integral Int, Show Int) => Int -> LuaE e ()
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral @Int) Text
"integer"

-- | Function result of type @'Text'@.
textResult :: Text -- ^ Description
           -> FunctionResults e Text
textResult :: Text -> FunctionResults e Text
textResult = Pusher e Text -> Text -> Text -> FunctionResults e Text
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Text
forall e. Pusher e Text
pushText Text
"text"