{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-|
Module      : HsLua.Module.Text
Copyright   : © 2017–2021 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
Stability   : alpha
Portability : ForeignFunctionInterface

Provides a Lua module containing a selection of useful Text functions.
-}
module HsLua.Module.Text
  ( -- * Module
    documentedModule
    -- ** Functions
  , len
  , lower
  , reverse
  , sub
  , upper
  ) where

import Prelude hiding (reverse)
import Data.Text (Text)
import Data.Maybe (fromMaybe)
import HsLua.Marshalling (peekIntegral, peekText, pushIntegral, pushText)
import HsLua.Packaging
import qualified Data.Text as T

-- | The @text@ module.
documentedModule :: 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
"text"
  , moduleOperations :: [(Operation, DocumentedFunction e)]
moduleOperations = []
  , moduleFields :: [Field e]
moduleFields = []
  , moduleFunctions :: [DocumentedFunction e]
moduleFunctions =
    [ DocumentedFunction e
forall e. DocumentedFunction e
len
    , DocumentedFunction e
forall e. DocumentedFunction e
lower
    , DocumentedFunction e
forall e. DocumentedFunction e
reverse
    , DocumentedFunction e
forall e. DocumentedFunction e
sub
    , DocumentedFunction e
forall e. DocumentedFunction e
upper
    ]
  , moduleDescription :: Text
moduleDescription =
      Text
"UTF-8 aware text manipulation functions, implemented in Haskell."
  }

--
-- Functions
--

-- | Wrapper for @'T.length'@.
len :: DocumentedFunction e
len :: DocumentedFunction e
len = Name
-> (Text -> LuaE e Int) -> HsFnPrecursor e (Text -> LuaE e Int)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"len"
  ### liftPure T.length
  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
"s"
  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
"length"
  #? "Determines the number of characters in a string."

-- | Wrapper for @'T.toLower'@.
lower :: DocumentedFunction e
lower :: DocumentedFunction e
lower = Name
-> (Text -> LuaE e Text) -> HsFnPrecursor e (Text -> LuaE e Text)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"lower"
  ### liftPure T.toLower
  HsFnPrecursor e (Text -> LuaE e Text)
-> Parameter e Text -> HsFnPrecursor e (LuaE e 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
"s"
  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
"Lowercase copy of `s`"
  #? "Converts a string to lower case."

-- | Wrapper for @'T.reverse'@.
reverse :: DocumentedFunction e
reverse :: DocumentedFunction e
reverse = Name
-> (Text -> LuaE e Text) -> HsFnPrecursor e (Text -> LuaE e Text)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"reverse"
  ### liftPure T.reverse
  HsFnPrecursor e (Text -> LuaE e Text)
-> Parameter e Text -> HsFnPrecursor e (LuaE e 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
"s"
  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
"Reversed `s`"
  #? "Reverses a string."

-- | Returns a substring, using Lua's string indexing rules.
sub :: DocumentedFunction e
sub :: DocumentedFunction e
sub = Name
-> (Text -> Int -> Maybe Int -> LuaE e Text)
-> HsFnPrecursor e (Text -> Int -> Maybe Int -> LuaE e Text)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"sub"
  ### liftPure3 substring
  HsFnPrecursor e (Text -> Int -> Maybe Int -> LuaE e Text)
-> Parameter e Text
-> HsFnPrecursor e (Int -> Maybe Int -> LuaE e 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
"s"
  HsFnPrecursor e (Int -> Maybe Int -> LuaE e Text)
-> Parameter e Int -> HsFnPrecursor e (Maybe Int -> LuaE e Text)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Text -> Parameter e Int
forall e. Text -> Text -> Parameter e Int
textIndex Text
"i" Text
"substring start position"
  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
<#> Text -> Text -> Parameter e (Maybe Int)
forall e. Text -> Text -> Parameter e (Maybe Int)
textOptionalIndex Text
"j" Text
"substring end position"
  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
"text substring"
  #? "Returns a substring, using Lua's string indexing rules."
  where
    substring :: Text -> Int -> Maybe Int -> Text
    substring :: Text -> Int -> Maybe Int -> Text
substring Text
s Int
i Maybe Int
jopt =
      let j :: Int
j = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) Maybe Int
jopt
          fromStart :: Int
fromStart = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then  Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else Text -> Int
T.length Text
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
          fromEnd :: Int
fromEnd   = if Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
0 then -Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else Text -> Int
T.length Text
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
j
      in Int -> Text -> Text
T.dropEnd Int
fromEnd (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
fromStart (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
s

-- | Wrapper for @'T.toUpper'@.
upper :: DocumentedFunction e
upper :: DocumentedFunction e
upper = Name
-> (Text -> LuaE e Text) -> HsFnPrecursor e (Text -> LuaE e Text)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"upper"
  ### liftPure T.toUpper
  HsFnPrecursor e (Text -> LuaE e Text)
-> Parameter e Text -> HsFnPrecursor e (LuaE e 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
"s"
  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
"Uppercase copy of `s`"
  #? "Converts a string to upper case."

--
-- Parameters
--

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
"UTF-8 encoded string"

textIndex :: Text -> Text -> Parameter e Int
textIndex :: Text -> Text -> Parameter e Int
textIndex = 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"

textOptionalIndex :: Text -> Text -> Parameter e (Maybe Int)
textOptionalIndex :: Text -> Text -> Parameter e (Maybe Int)
textOptionalIndex = 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"

--
-- Results
--

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
"string"

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"