{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-|
Module      : Foreign.Lua.Module.DocLayout
Copyright   : © 2020 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <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

  -- * Doc constructors and combinators
  , after_break
  , before_non_blank
  , blankline
  , blanklines
  , braces
  , brackets
  , cblock
  , chomp
  , concat
  , cr
  , double_quotes
  , empty
  , flush
  , hang
  , inside
  , lblock
  , literal
  , nest
  , nestle
  , nowrap
  , parens
  , prefixed
  , quotes
  , rblock
  , space
  , vfill

  -- * Rendering
  , render

  -- * Document Querying
  , is_empty
  , height
  , min_offset
  , offset
  , real_length
  , update_column

  -- * Marshaling
  , peekDoc
  , pushDoc
  )
where

import Prelude hiding (concat)
import Data.List (intersperse)
import Data.Text (Text)
import Foreign.Lua (Lua, NumResults (..), Optional,
                    Peekable, Pushable, StackIndex)
import Text.DocLayout (Doc, (<+>), ($$), ($+$))

import qualified Data.Text as T
import qualified Foreign.Lua as Lua
import qualified Foreign.Lua.Types.Peekable as Lua
import qualified Foreign.Lua.Userdata as Lua
import qualified Text.DocLayout as Doc

#if ! MIN_VERSION_base(4, 11, 0)
import Data.Monoid ((<>))
#endif

--
-- Module
--

-- | Pushes the @doclayout@ module to the Lua stack.
pushModule :: Lua NumResults
pushModule = do
  Lua.newtable
  -- constructors
  Lua.addfield "empty"     empty
  Lua.addfield "blankline" blankline
  Lua.addfield "cr"        cr
  Lua.addfield "space"     space
  Lua.addfunction "after_break" after_break
  Lua.addfunction "before_non_blank" before_non_blank
  Lua.addfunction "blanklines" blanklines
  Lua.addfunction "braces"     braces
  Lua.addfunction "brackets"   brackets
  Lua.addfunction "cblock"     cblock
  Lua.addfunction "chomp"      chomp
  Lua.addfunction "concat"     concat
  Lua.addfunction "double_quotes" double_quotes
  Lua.addfunction "flush"      flush
  Lua.addfunction "hang"       hang
  Lua.addfunction "inside"     inside
  Lua.addfunction "lblock"     lblock
  Lua.addfunction "literal"    literal
  Lua.addfunction "nest"       nest
  Lua.addfunction "nestle"     nestle
  Lua.addfunction "nowrap"     nowrap
  Lua.addfunction "parens"     parens
  Lua.addfunction "quotes"     quotes
  Lua.addfunction "prefixed"   prefixed
  Lua.addfunction "rblock"     rblock
  Lua.addfunction "vfill"      vfill
  -- querying
  Lua.addfunction "is_empty"   is_empty
  Lua.addfunction "offset"     offset
  Lua.addfunction "height"     height
  Lua.addfunction "min_offset" min_offset
  Lua.addfunction "offset"     offset
  Lua.addfunction "real_length" real_length
  Lua.addfunction "update_column" update_column
  -- rendering
  Lua.addfunction "render" render
  return 1

-- | Add the @doclayout@ module under the given name to the table
-- of preloaded packages.
preloadModule :: String -> Lua ()
preloadModule = flip Lua.preloadhs pushModule

-- | Render a @'Doc'@. The text is reflowed on breakable spaces
-- to match the given line length. Text is not reflowed if the
-- line length parameter is omitted or nil.
render :: Doc Text -> Optional Int -> Lua Text
render doc optLength = return $ Doc.render (Lua.fromOptional optLength) doc

--
-- Querying
--

-- | @True@ iff the document is empty.
is_empty :: Doc Text -> Lua Bool
is_empty = return . Doc.isEmpty

-- | Returns the width of a @'Doc'@.
offset :: Doc Text -> Lua Int
offset = return . Doc.offset

-- | Returns the minimal width of a @'Doc'@ when reflowed at
-- breakable spaces.
min_offset :: Doc Text -> Lua Int
min_offset = return . Doc.minOffset

-- | Returns the column that would be occupied by the last laid
-- out character.
update_column :: Doc Text -> Int -> Lua Int
update_column doc = return . Doc.updateColumn doc

-- | Returns the height of a block or other Doc.
height :: Doc Text -> Lua Int
height = return . Doc.height

-- | Returns the real length of a string in a monospace font: 0
-- for a combining character, 1, for a regular character, 2 for
-- an East Asian wide character.
real_length :: Text -> Lua Int
real_length = return . Doc.realLength

--
-- Constructors
--

-- | Creates a @'Doc'@ which is conditionally included only if it
-- comes at the beginning of a line.
after_break :: Text -> Lua (Doc Text)
after_break = return . Doc.afterBreak

-- | Conditionally includes the given @'Doc'@ unless it is
-- followed by a blank space.
before_non_blank :: Doc Text -> Lua (Doc Text)
before_non_blank = return . Doc.beforeNonBlank

-- | Inserts a blank line unless one exists already.
blankline :: Doc Text
blankline = Doc.blankline

-- | Insert blank lines unless they exist already.
blanklines :: Int -> Lua (Doc Text)
blanklines = return . Doc.blanklines

-- | Puts a @'Doc'@ in curly braces.
braces :: Doc Text -> Lua (Doc Text)
braces = return . Doc.braces

-- | Puts a @'Doc'@ in square brackets.
brackets :: Doc Text -> Lua (Doc Text)
brackets = return . Doc.brackets

-- | Like @'lblock'@ but aligned centered.
cblock :: Int -> Doc Text -> Lua (Doc Text)
cblock width = return . Doc.cblock width

-- | Chomps trailing blank space off of a @'Doc'@.
chomp :: Doc Text -> Lua (Doc Text)
chomp = return . Doc.chomp

-- | Concatenates a list of @'Doc'@s.
concat :: [Doc Text] -> Optional (Doc Text) -> Lua (Doc Text)
concat docs optSep = return $
  case Lua.fromOptional optSep of
    Nothing  -> mconcat docs
    Just sep -> mconcat $ intersperse sep docs

-- | A carriage return. Does nothing if we're at the beginning of
-- a line; otherwise inserts a newline.
cr :: Doc Text
cr = Doc.cr

-- | Wraps a @'Doc'@ in double quotes
double_quotes :: Doc Text -> Lua (Doc Text)
double_quotes = return . Doc.doubleQuotes

-- | The empty document.
empty :: Doc Text
empty = Doc.empty

-- | Makes a @'Doc'@ flush against the left margin.
flush :: Doc Text -> Lua (Doc Text)
flush = return . Doc.flush

-- | Creates a hanging indent.
hang :: Int -> Doc Text -> Doc Text -> Lua (Doc Text)
hang ind start doc = return $ Doc.hang ind start doc

-- | Encloses a @'Doc'@ inside a start and end @'Doc'@.
inside :: Doc Text -> Doc Text -> Doc Text -> Lua (Doc Text)
inside start end contents = return $ Doc.inside start end contents

-- | Creates a block with the given width and content, aligned to the left.
lblock :: Int -> Doc Text -> Lua (Doc Text)
lblock width = return . Doc.lblock width

-- | Creates a @'Doc'@ from a string.
literal :: Text -> Lua (Doc Text)
literal = return . Doc.literal

-- | Indents a @'Doc'@ by the specified number of spaces.
nest :: Int -> Doc Text -> Lua (Doc Text)
nest ind = return . Doc.nest ind

-- | Removes leading blank lines from a @'Doc'@.
nestle :: Doc Text -> Lua (Doc Text)
nestle = return . Doc.nestle

-- | Makes a @'Doc'@ non-reflowable.
nowrap :: Doc Text -> Lua (Doc Text)
nowrap = return . Doc.nowrap

-- | Puts a @'Doc'@ in parentheses.
parens :: Doc Text -> Lua (Doc Text)
parens = return . Doc.parens

-- | Uses the specified string as a prefix for every line of the
-- inside document (except the first, if not at the beginning of
-- the line).
prefixed :: Text -> Doc Text -> Lua (Doc Text)
prefixed prefix = return . Doc.prefixed (T.unpack prefix)

-- | Wraps a @'Doc'@ in single quotes.
quotes :: Doc Text -> Lua (Doc Text)
quotes = return . Doc.quotes

-- | Like @'lblock'@ but aligned to the right.
rblock :: Int -> Doc Text -> Lua (Doc Text)
rblock width = return . Doc.rblock width

-- | A breaking (reflowable) space.
space :: Doc Text
space = Doc.space

vfill :: Text -> Lua (Doc Text)
vfill = return . Doc.vfill


--
-- Marshaling
--

-- | Name used for the @Doc@ Lua userdata values.
docTypeName :: String
docTypeName = "HsLua DocLayout.Doc"

-- | Retrieve a @Doc Text@ value from the Lua stack. Strings are
-- converted to plain @'Doc'@ values.
peekDoc :: StackIndex -> Lua (Doc Text)
peekDoc idx = Lua.ltype idx >>= \case
  Lua.TypeString   -> let stringToDoc s = if T.null s
                                          then Doc.empty
                                          else Doc.literal s
                      in stringToDoc <$> Lua.peek idx
  Lua.TypeNumber   -> Doc.literal <$> Lua.peek idx
  _                -> Lua.reportValueOnFailure docTypeName
                        (`Lua.toAnyWithName` docTypeName)
                        idx

instance Peekable (Doc Text) where
  peek = peekDoc

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

instance Pushable (Doc Text) where
  push = pushDoc

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

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

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

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

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

-- | Convert to string by rendering without reflowing.
__tostring :: Doc Text -> Lua Text
__tostring d = return $ Doc.render Nothing d