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

Provide a lua module containing a selection of useful Text functions.
-}
module Foreign.Lua.Module.Text

  ( -- * Module
    pushModule
  , preloadModule
  , documentedModule
  , description
  , functions

    -- * Legacy
  , pushModuleText
  , preloadTextModule
  ) where

import Prelude hiding (reverse)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import Data.Text (Text)
import Data.Maybe (fromMaybe)
import Foreign.Lua (NumResults, Lua, Peekable, Pushable, ToHaskellFunction)
import Foreign.Lua.Call
import Foreign.Lua.Module hiding (preloadModule, pushModule)
import Foreign.Lua.Peek (Peeker, peekIntegral, peekText)
import Foreign.Lua.Push (pushIntegral, pushText)
import qualified Foreign.Lua as Lua
import qualified Data.Text as T

import qualified Foreign.Lua.Module as Module
--
-- Module
--

-- | Textual description of the "text" module.
description :: Text
description :: Text
description =
  Text
"UTF-8 aware text manipulation functions, implemented in Haskell."

documentedModule :: Module
documentedModule :: Module
documentedModule = Module :: Text -> Text -> [Field] -> [(Text, HaskellFunction)] -> Module
Module
  { moduleName :: Text
moduleName = Text
"paths"
  , moduleFields :: [Field]
moduleFields = []
  , moduleDescription :: Text
moduleDescription = Text
description
  , moduleFunctions :: [(Text, HaskellFunction)]
moduleFunctions = [(Text, HaskellFunction)]
functions
  }

-- | Pushes the @text@ 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 ()
Module.pushModule Module
documentedModule

pushModuleText :: Lua NumResults
pushModuleText :: Lua NumResults
pushModuleText = NumResults
1 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Module -> Lua ()
Module.pushModule Module
documentedModule

-- | Add the @text@ 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 }

-- | Add the text module under the given name to the table of preloaded
-- packages.
preloadTextModule :: String -> Lua ()
preloadTextModule :: String -> Lua ()
preloadTextModule = (String -> Lua NumResults -> Lua ())
-> Lua NumResults -> String -> Lua ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Lua NumResults -> Lua ()
Lua.preloadhs Lua NumResults
pushModuleText

--
-- Functions
--

functions :: [(Text, HaskellFunction)]
functions :: [(Text, HaskellFunction)]
functions =
  [ (Text
"len", HaskellFunction
len)
  , (Text
"lower", HaskellFunction
lower)
  , (Text
"reverse", HaskellFunction
reverse)
  , (Text
"sub", HaskellFunction
sub)
  , (Text
"upper", HaskellFunction
upper)
  ]

-- | Wrapper for @'T.length'@.
len :: HaskellFunction
len :: HaskellFunction
len = (Text -> Int) -> HsFnPrecursor (Text -> Int)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Text -> Int
T.length
  HsFnPrecursor (Text -> Int) -> Parameter Text -> HsFnPrecursor Int
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter Text
textParam Text
"s"
  HsFnPrecursor Int -> FunctionResults Int -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults Int
intResult Text
"length"
  #? "Determines the number of characters in a string."

-- | Wrapper for @'T.toLower'@.
lower :: HaskellFunction
lower :: HaskellFunction
lower = (Text -> Text) -> HsFnPrecursor (Text -> Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Text -> Text
T.toLower
  HsFnPrecursor (Text -> Text)
-> Parameter Text -> HsFnPrecursor Text
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter Text
textParam Text
"s"
  HsFnPrecursor Text -> FunctionResults Text -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults Text
textResult Text
"Lowercase copy of `s`"
  #? "Convert a string to lower case"

-- | Wrapper for @'T.reverse'@.
reverse :: HaskellFunction
reverse :: HaskellFunction
reverse = (Text -> Text) -> HsFnPrecursor (Text -> Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Text -> Text
T.reverse
  HsFnPrecursor (Text -> Text)
-> Parameter Text -> HsFnPrecursor Text
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter Text
textParam Text
"s"
  HsFnPrecursor Text -> FunctionResults Text -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults Text
textResult Text
"Reversed `s`"
  #? "Reverses a string."

-- | Returns a substring, using Lua's string indexing rules.
sub :: HaskellFunction
sub :: HaskellFunction
sub = (Text -> Int -> Maybe Int -> Text)
-> HsFnPrecursor (Text -> Int -> Maybe Int -> Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Text -> Int -> Maybe Int -> Text
substring
  HsFnPrecursor (Text -> Int -> Maybe Int -> Text)
-> Parameter Text -> HsFnPrecursor (Int -> Maybe Int -> Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter Text
textParam Text
"s"
  HsFnPrecursor (Int -> Maybe Int -> Text)
-> Parameter Int -> HsFnPrecursor (Maybe Int -> Text)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Text -> Parameter Int
textIndex Text
"i" Text
"substring start position"
  HsFnPrecursor (Maybe Int -> Text)
-> Parameter (Maybe Int) -> HsFnPrecursor Text
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Text -> Parameter (Maybe Int)
textOptionalIndex Text
"j" Text
"substring end position"
  HsFnPrecursor Text -> FunctionResults Text -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults 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 :: HaskellFunction
upper :: HaskellFunction
upper = (Text -> Text) -> HsFnPrecursor (Text -> Text)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor Text -> Text
T.toUpper
  HsFnPrecursor (Text -> Text)
-> Parameter Text -> HsFnPrecursor Text
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Text -> Parameter Text
textParam Text
"s"
  HsFnPrecursor Text -> FunctionResults Text -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> Text -> FunctionResults Text
textResult Text
"Lowercase copy of `s`"
  #? "Convert a string to lower case"

--
-- Parameters
--

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

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

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

--
-- Results
--

textResult :: Text -- ^ Description
           -> FunctionResults Text
textResult :: Text -> FunctionResults Text
textResult = Pusher Text -> Text -> Text -> FunctionResults Text
forall a. Pusher a -> Text -> Text -> FunctionResults a
functionResult Pusher Text
pushText Text
"string"

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"