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

-- | Self-documenting module.
documentedModule :: Module
documentedModule :: Module
documentedModule = Module :: Text -> Text -> [Field] -> [(Text, HaskellFunction)] -> Module
Module
  { moduleName :: Text
moduleName = Text
"doclayout"
  , moduleFields :: [Field]
moduleFields = [Field]
fields
  , moduleDescription :: Text
moduleDescription = Text
description
  , moduleFunctions :: [(Text, HaskellFunction)]
moduleFunctions = [(Text, HaskellFunction)]
functions
  }

-- | Pushes the @doclayout@ module to the Lua stack.
pushModule :: Lua NumResults
pushModule :: Lua NumResults
pushModule = NumResults
1 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Module -> Lua ()
pushModule' Module
documentedModule

pushModule' :: Module -> Lua ()
pushModule' :: Module -> Lua ()
pushModule' Module
mdl = do
  Module -> Lua ()
Module.pushModule Module
mdl
  [Field] -> (Field -> Lua ()) -> Lua ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Module -> [Field]
moduleFields Module
mdl) ((Field -> Lua ()) -> Lua ()) -> (Field -> Lua ()) -> Lua ()
forall a b. (a -> b) -> a -> b
$ \Field
field -> do
    Pusher Text
pushText (Field -> Text
fieldName Field
field)
    Field -> Lua ()
fieldPushValue Field
field
    StackIndex -> Lua ()
Lua.rawset (CInt -> StackIndex
Lua.nth CInt
3)

-- | Add the @doclayout@ module under the given name to the table
-- of preloaded packages.
preloadModule :: String -> Lua ()
preloadModule :: String -> Lua ()
preloadModule String
name = Module -> Lua ()
Module.preloadModule (Module -> Lua ()) -> Module -> Lua ()
forall a b. (a -> b) -> a -> b
$
  Module
documentedModule { moduleName :: Text
moduleName = String -> Text
T.pack String
name }

--
-- Fields
--

-- | Exposed fields.
fields :: [Field]
fields :: [Field]
fields =
  [ Field
blankline
  , Field
cr
  , Field
empty
  , Field
space
  ]

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

-- | Wrapped and documented 'Doc.cr' value.
cr :: Field
cr :: Field
cr = Field :: Text -> Text -> Lua () -> Field
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 :: Lua ()
fieldPushValue = Pusher (Doc Text)
pushDoc Doc Text
forall a. Doc a
Doc.cr
  }

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

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

--
-- Functions
--

-- | Exposed module functions.
functions :: [(Text, HaskellFunction)]
functions :: [(Text, HaskellFunction)]
functions =
  [ -- Constructors
    (Text
"after_break", HaskellFunction
after_break)
  , (Text
"before_non_blank", HaskellFunction
before_non_blank)
  , (Text
"blanklines", HaskellFunction
blanklines)
  , (Text
"braces", HaskellFunction
braces)
  , (Text
"brackets", HaskellFunction
brackets)
  , (Text
"cblock", HaskellFunction
cblock)
  , (Text
"chomp", HaskellFunction
chomp)
  , (Text
"concat", HaskellFunction
concat)
  , (Text
"double_quotes", HaskellFunction
double_quotes)
  , (Text
"flush", HaskellFunction
flush)
  , (Text
"hang", HaskellFunction
hang)
  , (Text
"inside", HaskellFunction
inside)
  , (Text
"lblock", HaskellFunction
lblock)
  , (Text
"literal", HaskellFunction
literal)
  , (Text
"nest", HaskellFunction
nest)
  , (Text
"nestle", HaskellFunction
nestle)
  , (Text
"nowrap", HaskellFunction
nowrap)
  , (Text
"parens", HaskellFunction
parens)
  , (Text
"prefixed", HaskellFunction
prefixed)
  , (Text
"quotes", HaskellFunction
quotes)
  , (Text
"rblock", HaskellFunction
rblock)
  , (Text
"vfill", HaskellFunction
vfill)
    -- rendering
  , (Text
"render", HaskellFunction
render)
    -- querying
  , (Text
"is_empty", HaskellFunction
is_empty)
  , (Text
"height", HaskellFunction
height)
  , (Text
"min_offset", HaskellFunction
min_offset)
  , (Text
"offset", HaskellFunction
offset)
  , (Text
"real_length", HaskellFunction
real_length)
  , (Text
"update_column", HaskellFunction
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 :: HaskellFunction
render = (Doc Text -> Maybe Int -> Text)
-> HsFnPrecursor (Doc Text -> Maybe Int -> Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor ((Maybe Int -> Doc Text -> Text) -> Doc Text -> Maybe Int -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
Doc.render)
  HsFnPrecursor (Doc Text -> Maybe Int -> Text)
-> Parameter (Doc Text) -> HsFnPrecursor (Maybe Int -> Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"doc"
  HsFnPrecursor (Maybe Int -> Text)
-> Parameter (Maybe Int) -> HsFnPrecursor Text
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Peeker Int -> Text -> Text -> Text -> Parameter (Maybe Int)
forall a. Peeker a -> Text -> Text -> Text -> Parameter (Maybe a)
optionalParameter ((Integral Int, Read Int) => Peeker Int
forall a. (Integral a, Read a) => Peeker a
peekIntegral @Int) Text
"integer" Text
"colwidth" Text
""
  HsFnPrecursor Text -> FunctionResults Text -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Pusher Text -> Text -> Text -> FunctionResults Text
forall a. Pusher a -> Text -> Text -> FunctionResults a
functionResult Pusher 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 :: HaskellFunction
is_empty :: HaskellFunction
is_empty = (Doc Text -> Bool) -> HsFnPrecursor (Doc Text -> Bool)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Doc Text -> Bool
forall a. Doc a -> Bool
Doc.isEmpty
  HsFnPrecursor (Doc Text -> Bool)
-> Parameter (Doc Text) -> HsFnPrecursor Bool
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"doc"
  HsFnPrecursor Bool -> FunctionResults Bool -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults 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 :: HaskellFunction
offset :: HaskellFunction
offset = (Doc Text -> Int) -> HsFnPrecursor (Doc Text -> Int)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
Doc.offset
  HsFnPrecursor (Doc Text -> Int)
-> Parameter (Doc Text) -> HsFnPrecursor Int
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"doc"
  HsFnPrecursor Int -> FunctionResults Int -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults 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 :: HaskellFunction
min_offset :: HaskellFunction
min_offset = (Doc Text -> Int) -> HsFnPrecursor (Doc Text -> Int)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Doc Text -> Int
forall a. HasChars a => Doc a -> Int
Doc.minOffset
  HsFnPrecursor (Doc Text -> Int)
-> Parameter (Doc Text) -> HsFnPrecursor Int
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"doc"
  HsFnPrecursor Int -> FunctionResults Int -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults 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 :: HaskellFunction
update_column :: HaskellFunction
update_column = (Doc Text -> Int -> Int) -> HsFnPrecursor (Doc Text -> Int -> Int)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Doc Text -> Int -> Int
forall a. HasChars a => Doc a -> Int -> Int
Doc.updateColumn
  HsFnPrecursor (Doc Text -> Int -> Int)
-> Parameter (Doc Text) -> HsFnPrecursor (Int -> Int)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"doc"
  HsFnPrecursor (Int -> Int) -> Parameter Int -> HsFnPrecursor Int
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter Int
intParam Text
"i"
  HsFnPrecursor Int -> FunctionResults Int -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults 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 :: HaskellFunction
height :: HaskellFunction
height = (Doc Text -> Int) -> HsFnPrecursor (Doc Text -> Int)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Doc Text -> Int
forall a. HasChars a => Doc a -> Int
Doc.height
  HsFnPrecursor (Doc Text -> Int)
-> Parameter (Doc Text) -> HsFnPrecursor Int
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"doc"
  HsFnPrecursor Int -> FunctionResults Int -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults 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 :: HaskellFunction
real_length :: HaskellFunction
real_length = (Text -> Int) -> HsFnPrecursor (Text -> Int)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Text -> Int
forall a. HasChars a => a -> Int
Doc.realLength
  HsFnPrecursor (Text -> Int) -> Parameter Text -> HsFnPrecursor Int
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter Text
textParam Text
"str"
  HsFnPrecursor Int -> FunctionResults Int -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults 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 :: HaskellFunction
after_break :: HaskellFunction
after_break = (Text -> Doc Text) -> HsFnPrecursor (Text -> Doc Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Text -> Doc Text
forall a. Text -> Doc a
Doc.afterBreak
  HsFnPrecursor (Text -> Doc Text)
-> Parameter Text -> HsFnPrecursor (Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter Text
textParam Text
"text"
  HsFnPrecursor (Doc Text)
-> FunctionResults (Doc Text) -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults (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 :: HaskellFunction
before_non_blank :: HaskellFunction
before_non_blank = (Doc Text -> Doc Text) -> HsFnPrecursor (Doc Text -> Doc Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Doc Text -> Doc Text
forall a. Doc a -> Doc a
Doc.beforeNonBlank
  HsFnPrecursor (Doc Text -> Doc Text)
-> Parameter (Doc Text) -> HsFnPrecursor (Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"doc"
  HsFnPrecursor (Doc Text)
-> FunctionResults (Doc Text) -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults (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 :: HaskellFunction
blanklines :: HaskellFunction
blanklines = (Int -> Doc Text) -> HsFnPrecursor (Int -> Doc Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Int -> Doc Text
forall a. Int -> Doc a
Doc.blanklines
  HsFnPrecursor (Int -> Doc Text)
-> Parameter Int -> HsFnPrecursor (Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter Int
intParam Text
"n"
  HsFnPrecursor (Doc Text)
-> FunctionResults (Doc Text) -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults (Doc Text)
docResult Text
"conditional blank lines"
  #? "Inserts blank lines unless they exist already."

-- | Puts a @'Doc'@ in curly braces.
braces :: HaskellFunction
braces :: HaskellFunction
braces = (Doc Text -> Doc Text) -> HsFnPrecursor (Doc Text -> Doc Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
Doc.braces
  HsFnPrecursor (Doc Text -> Doc Text)
-> Parameter (Doc Text) -> HsFnPrecursor (Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"doc"
  HsFnPrecursor (Doc Text)
-> FunctionResults (Doc Text) -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults (Doc Text)
docResult Text
"doc enclosed by {}."
  #? "Puts the `doc` in curly braces."

-- | Puts a @'Doc'@ in square brackets.
brackets :: HaskellFunction -- Doc Text -> Lua (Doc Text)
brackets :: HaskellFunction
brackets = (Doc Text -> Doc Text) -> HsFnPrecursor (Doc Text -> Doc Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
Doc.brackets
  HsFnPrecursor (Doc Text -> Doc Text)
-> Parameter (Doc Text) -> HsFnPrecursor (Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"doc"
  HsFnPrecursor (Doc Text)
-> FunctionResults (Doc Text) -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults (Doc Text)
docResult Text
"doc enclosed by []."
  #? "Puts the `doc` in square brackets"

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

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

-- | Wraps a @'Doc'@ in double quotes
double_quotes :: HaskellFunction
double_quotes :: HaskellFunction
double_quotes = (Doc Text -> Doc Text) -> HsFnPrecursor (Doc Text -> Doc Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
Doc.doubleQuotes
  HsFnPrecursor (Doc Text -> Doc Text)
-> Parameter (Doc Text) -> HsFnPrecursor (Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"doc"
  HsFnPrecursor (Doc Text)
-> FunctionResults (Doc Text) -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults (Doc Text)
docResult Text
"`doc` enclosed by `\"` chars"
  #? "Wraps a `Doc` in double quotes."

-- | Makes a @'Doc'@ flush against the left margin.
flush :: HaskellFunction
flush :: HaskellFunction
flush = (Doc Text -> Doc Text) -> HsFnPrecursor (Doc Text -> Doc Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Doc Text -> Doc Text
forall a. Doc a -> Doc a
Doc.flush
  HsFnPrecursor (Doc Text -> Doc Text)
-> Parameter (Doc Text) -> HsFnPrecursor (Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"doc"
  HsFnPrecursor (Doc Text)
-> FunctionResults (Doc Text) -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults (Doc Text)
docResult Text
"flushed `doc`"
  #? "Makes a `Doc` flush against the left margin."

-- | Creates a hanging indent.
hang :: HaskellFunction
hang :: HaskellFunction
hang = (Int -> Doc Text -> Doc Text -> Doc Text)
-> HsFnPrecursor (Int -> Doc Text -> Doc Text -> Doc Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
Doc.hang
  HsFnPrecursor (Int -> Doc Text -> Doc Text -> Doc Text)
-> Parameter Int
-> HsFnPrecursor (Doc Text -> Doc Text -> Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Peeker Int -> Text -> Text -> Text -> Parameter Int
forall a. Peeker a -> Text -> Text -> Text -> Parameter a
parameter Peeker Int
forall a. (Integral a, Read a) => Peeker a
peekIntegral Text
"integer" Text
"ind" Text
"indentation width"
  HsFnPrecursor (Doc Text -> Doc Text -> Doc Text)
-> Parameter (Doc Text) -> HsFnPrecursor (Doc Text -> Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"start"
  HsFnPrecursor (Doc Text -> Doc Text)
-> Parameter (Doc Text) -> HsFnPrecursor (Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"doc"
  HsFnPrecursor (Doc Text)
-> FunctionResults (Doc Text) -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults (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 :: HaskellFunction
inside :: HaskellFunction
inside = (Doc Text -> Doc Text -> Doc Text -> Doc Text)
-> HsFnPrecursor (Doc Text -> Doc Text -> Doc Text -> Doc Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Doc Text -> Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a -> Doc a
Doc.inside
  HsFnPrecursor (Doc Text -> Doc Text -> Doc Text -> Doc Text)
-> Parameter (Doc Text)
-> HsFnPrecursor (Doc Text -> Doc Text -> Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"start"
  HsFnPrecursor (Doc Text -> Doc Text -> Doc Text)
-> Parameter (Doc Text) -> HsFnPrecursor (Doc Text -> Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"end"
  HsFnPrecursor (Doc Text -> Doc Text)
-> Parameter (Doc Text) -> HsFnPrecursor (Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"contents"
  HsFnPrecursor (Doc Text)
-> FunctionResults (Doc Text) -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults (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 :: HaskellFunction
lblock :: HaskellFunction
lblock = (Int -> Doc Text -> Doc Text)
-> HsFnPrecursor (Int -> Doc Text -> Doc Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
Doc.lblock
  HsFnPrecursor (Int -> Doc Text -> Doc Text)
-> Parameter Int -> HsFnPrecursor (Doc Text -> Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Peeker Int -> Text -> Text -> Text -> Parameter Int
forall a. Peeker a -> Text -> Text -> Text -> Parameter a
parameter Peeker Int
forall a. (Integral a, Read a) => Peeker a
peekIntegral Text
"integer" Text
"width" Text
"block width in chars"
  HsFnPrecursor (Doc Text -> Doc Text)
-> Parameter (Doc Text) -> HsFnPrecursor (Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"doc"
  HsFnPrecursor (Doc Text)
-> FunctionResults (Doc Text) -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults (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 :: HaskellFunction
literal :: HaskellFunction
literal = (Text -> Doc Text) -> HsFnPrecursor (Text -> Doc Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Text -> Doc Text
forall a. HasChars a => a -> Doc a
Doc.literal
  HsFnPrecursor (Text -> Doc Text)
-> Parameter Text -> HsFnPrecursor (Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter Text
textParam Text
"string"
  HsFnPrecursor (Doc Text)
-> FunctionResults (Doc Text) -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults (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 :: HaskellFunction
nest :: HaskellFunction
nest = (Int -> Doc Text -> Doc Text)
-> HsFnPrecursor (Int -> Doc Text -> Doc Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
Doc.nest
  HsFnPrecursor (Int -> Doc Text -> Doc Text)
-> Parameter Int -> HsFnPrecursor (Doc Text -> Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Peeker Int -> Text -> Text -> Text -> Parameter Int
forall a. Peeker a -> Text -> Text -> Text -> Parameter a
parameter Peeker Int
forall a. (Integral a, Read a) => Peeker a
peekIntegral Text
"integer" Text
"ind" Text
"indentation size"
  HsFnPrecursor (Doc Text -> Doc Text)
-> Parameter (Doc Text) -> HsFnPrecursor (Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"doc"
  HsFnPrecursor (Doc Text)
-> FunctionResults (Doc Text) -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults (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 :: HaskellFunction
nestle :: HaskellFunction
nestle = (Doc Text -> Doc Text) -> HsFnPrecursor (Doc Text -> Doc Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Doc Text -> Doc Text
forall a. Doc a -> Doc a
Doc.nestle
  HsFnPrecursor (Doc Text -> Doc Text)
-> Parameter (Doc Text) -> HsFnPrecursor (Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"doc"
  HsFnPrecursor (Doc Text)
-> FunctionResults (Doc Text) -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults (Doc Text)
docResult Text
"`doc` with leading blanks removed"
  #? "Removes leading blank lines from a `Doc`."

-- | Makes a @'Doc'@ non-reflowable.
nowrap :: HaskellFunction
nowrap :: HaskellFunction
nowrap = (Doc Text -> Doc Text) -> HsFnPrecursor (Doc Text -> Doc Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
Doc.nowrap
  HsFnPrecursor (Doc Text -> Doc Text)
-> Parameter (Doc Text) -> HsFnPrecursor (Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"doc"
  HsFnPrecursor (Doc Text)
-> FunctionResults (Doc Text) -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults (Doc Text)
docResult Text
"same as input, but non-reflowable"
  #? "Makes a `Doc` non-reflowable."

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

-- | Like @'rblock'@ but aligned to the right.
rblock :: HaskellFunction
rblock :: HaskellFunction
rblock = (Int -> Doc Text -> Doc Text)
-> HsFnPrecursor (Int -> Doc Text -> Doc Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
Doc.rblock
  HsFnPrecursor (Int -> Doc Text -> Doc Text)
-> Parameter Int -> HsFnPrecursor (Doc Text -> Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Peeker Int -> Text -> Text -> Text -> Parameter Int
forall a. Peeker a -> Text -> Text -> Text -> Parameter a
parameter Peeker Int
forall a. (Integral a, Read a) => Peeker a
peekIntegral Text
"integer" Text
"width" Text
"block width in chars"
  HsFnPrecursor (Doc Text -> Doc Text)
-> Parameter (Doc Text) -> HsFnPrecursor (Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter (Doc Text)
docParam Text
"doc"
  HsFnPrecursor (Doc Text)
-> FunctionResults (Doc Text) -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults (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 :: HaskellFunction
vfill :: HaskellFunction
vfill = (Text -> Doc Text) -> HsFnPrecursor (Text -> Doc Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Text -> Doc Text
forall a. HasChars a => a -> Doc a
Doc.vfill
  HsFnPrecursor (Text -> Doc Text)
-> Parameter Text -> HsFnPrecursor (Doc Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter Text
textParam Text
"border"
  HsFnPrecursor (Doc Text)
-> FunctionResults (Doc Text) -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults (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
--

-- | Name used for the @Doc@ Lua userdata values.
docTypeName :: String
docTypeName :: String
docTypeName = String
"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' :: StackIndex -> Lua (Doc Text)
peekDoc' StackIndex
idx = StackIndex -> Lua Type
Lua.ltype StackIndex
idx Lua Type -> (Type -> Lua (Doc Text)) -> Lua (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) -> Lua Text -> Lua (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua Text
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx
  Type
Lua.TypeNumber   -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
Doc.literal (Text -> Doc Text) -> Lua Text -> Lua (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua Text
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx
  Type
_                -> String
-> (StackIndex -> Lua (Maybe (Doc Text)))
-> StackIndex
-> Lua (Doc Text)
forall a.
String -> (StackIndex -> Lua (Maybe a)) -> StackIndex -> Lua a
Lua.reportValueOnFailure String
docTypeName
                        (StackIndex -> String -> Lua (Maybe (Doc Text))
forall a. StackIndex -> String -> Lua (Maybe a)
`Lua.toAnyWithName` String
docTypeName)
                        StackIndex
idx

peekDoc :: Peeker (Doc Text)
peekDoc :: Peeker (Doc Text)
peekDoc = (StackIndex -> Lua (Doc Text)) -> Peeker (Doc Text)
forall a. (StackIndex -> Lua a) -> Peeker a
toPeeker StackIndex -> Lua (Doc Text)
peekDoc'

instance Peekable (Doc Text) where
  peek :: StackIndex -> Lua (Doc Text)
peek = StackIndex -> Lua (Doc Text)
peekDoc'

-- | Push a @Doc Text@ value to the Lua stack.
pushDoc :: Pusher (Doc Text)
pushDoc :: Pusher (Doc Text)
pushDoc = Lua () -> Pusher (Doc Text)
forall a. Lua () -> a -> Lua ()
Lua.pushAnyWithMetatable Lua ()
pushDocMT
  where
    pushDocMT :: Lua ()
pushDocMT = String -> Lua () -> Lua ()
Lua.ensureUserdataMetatable String
docTypeName (Lua () -> Lua ()) -> Lua () -> Lua ()
forall a b. (a -> b) -> a -> b
$ do
      String -> (Doc Text -> Doc Text -> Lua (Doc Text)) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction String
"__add"      Doc Text -> Doc Text -> Lua (Doc Text)
__add
      String -> (Doc Text -> Doc Text -> Lua (Doc Text)) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction String
"__concat"   Doc Text -> Doc Text -> Lua (Doc Text)
__concat
      String -> (Doc Text -> Doc Text -> Lua (Doc Text)) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction String
"__div"      Doc Text -> Doc Text -> Lua (Doc Text)
__div
      String -> (Doc Text -> Doc Text -> Lua Bool) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction String
"__eq"       Doc Text -> Doc Text -> Lua Bool
__eq
      String -> (Doc Text -> Doc Text -> Lua (Doc Text)) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction String
"__idiv"     Doc Text -> Doc Text -> Lua (Doc Text)
__idiv
      String -> (Doc Text -> Lua Text) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction String
"__tostring" Doc Text -> Lua Text
__tostring

instance Pushable (Doc Text) where
  push :: Pusher (Doc Text)
push = Pusher (Doc Text)
pushDoc

-- | Concatenate two @'Doc'@s, putting breakable spaces between them.
__add :: Doc Text -> Doc Text -> Lua (Doc Text)
__add :: Doc Text -> Doc Text -> Lua (Doc Text)
__add Doc Text
a Doc Text
b = Doc Text -> Lua (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
a Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> Doc Text
b)

-- | Concatenate two @'Doc'@.
__concat :: Doc Text -> Doc Text -> Lua (Doc Text)
__concat :: Doc Text -> Doc Text -> Lua (Doc Text)
__concat Doc Text
a Doc Text
b = Doc Text -> Lua (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
a Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
b)

-- | @a / b@ puts @a@ above @b@.
__div :: Doc Text -> Doc Text -> Lua (Doc Text)
__div :: Doc Text -> Doc Text -> Lua (Doc Text)
__div Doc Text
a Doc Text
b = Doc Text -> Lua (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
a Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
b)

-- | Test @'Doc'@ equality.
__eq :: Doc Text -> Doc Text -> Lua Bool
__eq :: Doc Text -> Doc Text -> Lua Bool
__eq Doc Text
a Doc Text
b = Bool -> Lua Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
a Doc Text -> Doc Text -> Bool
forall a. Eq a => a -> a -> Bool
== Doc Text
b)

-- | @a // b@ puts @a@ above @b@.
__idiv :: Doc Text -> Doc Text -> Lua (Doc Text)
__idiv :: Doc Text -> Doc Text -> Lua (Doc Text)
__idiv Doc Text
a Doc Text
b = Doc Text -> Lua (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
a Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
b)

-- | Convert to string by rendering without reflowing.
__tostring :: Doc Text -> Lua Text
__tostring :: Doc Text -> Lua Text
__tostring Doc Text
d = Text -> Lua Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Lua Text) -> Text -> Lua Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
Doc.render Maybe Int
forall a. Maybe a
Nothing Doc Text
d

--
-- Parameters
--

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

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

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

--
-- Results
--

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

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

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