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

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

import Prelude hiding (reverse)
import Data.Text (Text)
import Data.Maybe (fromMaybe)
import Foreign.Marshal.Alloc (alloca)
import HsLua.Core (LuaError)
import HsLua.Packaging
import Lua (lua_pushlstring, lua_tolstring)
import System.IO.Error (tryIOError)
import qualified Data.Text as T
import qualified Foreign.Storable as F
import qualified GHC.Foreign as GHC
import qualified GHC.IO.Encoding as GHC
import qualified HsLua.Core as Lua
import qualified HsLua.Marshalling as Lua

-- | The @text@ module.
documentedModule :: LuaError e => Module e
documentedModule :: forall e. LuaError e => Module e
documentedModule = Module
  { moduleName :: Name
moduleName = Name
"text"
  , moduleOperations :: [(Operation, DocumentedFunction e)]
moduleOperations = []
  , moduleFields :: [Field e]
moduleFields = []
  , moduleFunctions :: [DocumentedFunction e]
moduleFunctions =
    [ forall e. LuaError e => DocumentedFunction e
fromencoding
    , forall e. DocumentedFunction e
len
    , forall e. DocumentedFunction e
lower
    , forall e. DocumentedFunction e
reverse
    , forall e. DocumentedFunction e
sub
    , forall e. LuaError e => DocumentedFunction e
toencoding
    , forall e. DocumentedFunction e
upper
    ]
  , moduleDescription :: Text
moduleDescription =
      Text
"UTF-8 aware text manipulation functions, implemented in Haskell."
  }

--
-- Functions
--

-- | Recodes a string as UTF-8.
fromencoding :: LuaError e => DocumentedFunction e
fromencoding :: forall e. LuaError e => DocumentedFunction e
fromencoding = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"fromencoding"
  ### (\strIdx menc -> do
          l <- Lua.state
          result <- Lua.liftIO . tryIOError $ do
            encoding <- maybe getFileSystemEncoding GHC.mkTextEncoding menc
            alloca $ \lenPtr -> do
              cstr <- lua_tolstring l strIdx lenPtr
              -- cstr cannot be NULL, or stringIndex would have failed.
              cstrLen <- F.peek lenPtr
              GHC.peekCStringLen encoding (cstr, fromIntegral cstrLen)
          case result of
            Right s -> pure $ T.pack s
            Left err -> Lua.failLua (show err))
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall {e}. StackIndex -> Peek e StackIndex
stringIndex Text
"string" Text
"s" Text
"string to be converted"
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e. Text -> Text -> Parameter e String
stringParam Text
"encoding" Text
"target encoding")
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. Pusher e Text
Lua.pushText Text
"string" Text
"UTF-8 string"
  #? T.unlines
     [ "Converts a string from a different encoding to UTF-8. On Windows,"
     , "the `encoding` parameter defaults to the current ANSI code page; on"
     , "other platforms the function will try to use the file system's"
     , "encoding."
     , ""
     , "See `toencoding` for more info on supported encodings."
     ]
  where
    stringIndex :: StackIndex -> Peek e StackIndex
stringIndex StackIndex
idx = do
      Bool
isstr <- forall e a. LuaE e a -> Peek e a
Lua.liftLua (forall e. StackIndex -> LuaE e Bool
Lua.isstring StackIndex
idx)
      if Bool
isstr
        then forall (f :: * -> *) a. Applicative f => a -> f a
pure StackIndex
idx
        else forall e. Name -> StackIndex -> Peek e ByteString
Lua.typeMismatchMessage Name
"string" StackIndex
idx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a e. ByteString -> Peek e a
Lua.failPeek

-- | Wrapper for @'T.length'@.
len :: DocumentedFunction e
len :: forall e. DocumentedFunction e
len = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"len"
  ### liftPure T.length
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"s" Text
"UTF-8 encoded string"
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall a e. (Integral a, Show a) => Text -> FunctionResults e a
integralResult Text
"length"
  #? "Determines the number of characters in a string."

-- | Wrapper for @'T.toLower'@.
lower :: DocumentedFunction e
lower :: forall e. DocumentedFunction e
lower = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"lower"
  ### liftPure T.toLower
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"s" Text
"UTF-8 string to convert to lowercase"
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> 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 :: forall e. DocumentedFunction e
reverse = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"reverse"
  ### liftPure T.reverse
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"s" Text
"UTF-8 string to revert"
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> 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 :: forall e. DocumentedFunction e
sub = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"sub"
  ### liftPure3 substring
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"s" Text
"UTF-8 string"
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Int
textIndex Text
"i" Text
"substring start position"
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e. Text -> Text -> Parameter e Int
textIndex Text
"j" Text
"substring end position")
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> 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 = forall a. a -> Maybe a -> a
fromMaybe (-Int
1) Maybe Int
jopt
          fromStart :: Int
fromStart = if Int
i forall a. Ord a => a -> a -> Bool
>= Int
0 then  Int
i forall a. Num a => a -> a -> a
- Int
1 else Text -> Int
T.length Text
s forall a. Num a => a -> a -> a
+ Int
i
          fromEnd :: Int
fromEnd   = if Int
j forall a. Ord a => a -> a -> Bool
<  Int
0 then -Int
j forall a. Num a => a -> a -> a
- Int
1 else Text -> Int
T.length Text
s forall a. Num a => a -> a -> a
- Int
j
      in Int -> Text -> Text
T.dropEnd Int
fromEnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
fromStart forall a b. (a -> b) -> a -> b
$ Text
s

-- | Converts a UTF-8 string to a different encoding.
toencoding :: LuaError e => DocumentedFunction e
toencoding :: forall e. LuaError e => DocumentedFunction e
toencoding = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"toencoding"
  ### (\s menc -> do
          l <- Lua.state
          result <- Lua.liftIO . tryIOError $ do
            encoding <- maybe getFileSystemEncoding GHC.mkTextEncoding menc
            GHC.withCStringLen encoding (T.unpack s) $ \(sPtr, sLen) ->
              lua_pushlstring l sPtr (fromIntegral sLen)
          case result of
            Right () -> pure ()
            Left err -> Lua.failLua (show err))
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"s" Text
"UTF-8 string"
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e. Text -> Text -> Parameter e String
stringParam Text
"enc" Text
"target encoding")
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult (forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) Text
"string" Text
"re-encoded string"
  #? T.unlines
     [ "Converts a UTF-8 string to a different encoding. On Windows, the"
     , "`encoding` parameter defaults to the current ANSI code page; on"
     , "other platforms the function will try to use the file system's"
     , "encoding."
     , ""
     , "The set of known encodings is system dependent, but includes at"
     , "least `UTF-8`, `UTF-16BE`, `UTF-16LE`, `UTF-32BE`, and `UTF-32LE`."
     , "Note that the prefix `CP` allows to access code page on Windows,"
     , "e.g. `CP0` (the current ANSI code page) or `CP1250`."
     ]

-- | Wrapper for @'T.toUpper'@.
upper :: DocumentedFunction e
upper :: forall e. DocumentedFunction e
upper = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"upper"
  ### liftPure T.toUpper
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"s" Text
"UTF-8 string to convert to uppercase"
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e. Text -> FunctionResults e Text
textResult Text
"Uppercase copy of `s`"
  #? "Converts a string to upper case."

--
-- Parameters
--

-- | String index parameter
textIndex :: Text -- ^ parameter name
          -> Text -- ^ parameter description
          -> Parameter e Int
textIndex :: forall e. Text -> Text -> Parameter e Int
textIndex = forall a e. (Read a, Integral a) => Text -> Text -> Parameter e a
integralParam @Int

--
-- Helpers
--
getFileSystemEncoding :: IO GHC.TextEncoding
getFileSystemEncoding :: IO TextEncoding
getFileSystemEncoding =
#if defined(mingw32_HOST_OS)
  GHC.mkTextEncoding "CP0"  -- a.k.a CP_ACP
#else
  IO TextEncoding
GHC.getFileSystemEncoding
#endif