{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Text.Pandoc.Lua.Marshaling.Version
( peekVersion
, pushVersion
)
where
import Prelude
import Data.Maybe (fromMaybe)
import Data.Version (Version (..), makeVersion, parseVersion, showVersion)
import Foreign.Lua (Lua, Optional (..), NumResults,
Peekable, Pushable, StackIndex)
import Foreign.Lua.Types.Peekable (reportValueOnFailure)
import Foreign.Lua.Userdata (ensureUserdataMetatable, pushAnyWithMetatable,
toAnyWithName)
import Safe (atMay, lastMay)
import Text.Pandoc.Lua.Marshaling.AnyValue (AnyValue (..))
import Text.ParserCombinators.ReadP (readP_to_S)
import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.Lua.Util as LuaUtil
pushVersion :: Version -> Lua ()
pushVersion :: Version -> Lua ()
pushVersion version :: Version
version = Lua () -> Version -> Lua ()
forall a. Lua () -> a -> Lua ()
pushAnyWithMetatable Lua ()
pushVersionMT Version
version
where
pushVersionMT :: Lua ()
pushVersionMT = String -> Lua () -> Lua ()
ensureUserdataMetatable String
versionTypeName (Lua () -> Lua ()) -> Lua () -> Lua ()
forall a b. (a -> b) -> a -> b
$ do
String -> (Version -> Version -> Lua Bool) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
LuaUtil.addFunction "__eq" Version -> Version -> Lua Bool
__eq
String -> (Version -> Version -> Lua Bool) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
LuaUtil.addFunction "__le" Version -> Version -> Lua Bool
__le
String -> (Version -> Version -> Lua Bool) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
LuaUtil.addFunction "__lt" Version -> Version -> Lua Bool
__lt
String -> (Version -> Lua Int) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
LuaUtil.addFunction "__len" Version -> Lua Int
__len
String -> (Version -> AnyValue -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
LuaUtil.addFunction "__index" Version -> AnyValue -> Lua NumResults
__index
String -> (Version -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
LuaUtil.addFunction "__pairs" Version -> Lua NumResults
__pairs
String -> (Version -> Lua String) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
LuaUtil.addFunction "__tostring" Version -> Lua String
__tostring
instance Pushable Version where
push :: Version -> Lua ()
push = Version -> Lua ()
pushVersion
peekVersion :: StackIndex -> Lua Version
peekVersion :: StackIndex -> Lua Version
peekVersion idx :: StackIndex
idx = StackIndex -> Lua Type
Lua.ltype StackIndex
idx Lua Type -> (Type -> Lua Version) -> Lua Version
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Lua.TypeString -> do
String
versionStr <- StackIndex -> Lua String
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx
let parses :: [(Version, String)]
parses = ReadP Version -> ReadS Version
forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
parseVersion String
versionStr
case [(Version, String)] -> Maybe (Version, String)
forall a. [a] -> Maybe a
lastMay [(Version, String)]
parses of
Just (v :: Version
v, "") -> Version -> Lua Version
forall (m :: * -> *) a. Monad m => a -> m a
return Version
v
_ -> String -> Lua Version
forall a. String -> Lua a
Lua.throwException (String -> Lua Version) -> String -> Lua Version
forall a b. (a -> b) -> a -> b
$ "could not parse as Version: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
versionStr
Lua.TypeUserdata ->
String
-> (StackIndex -> Lua (Maybe Version)) -> StackIndex -> Lua Version
forall a.
String -> (StackIndex -> Lua (Maybe a)) -> StackIndex -> Lua a
reportValueOnFailure String
versionTypeName
(StackIndex -> String -> Lua (Maybe Version)
forall a. StackIndex -> String -> Lua (Maybe a)
`toAnyWithName` String
versionTypeName)
StackIndex
idx
Lua.TypeNumber -> do
Int
n <- StackIndex -> Lua Int
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx
Version -> Lua Version
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> Version
makeVersion [Int
n])
Lua.TypeTable ->
[Int] -> Version
makeVersion ([Int] -> Version) -> Lua [Int] -> Lua Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua [Int]
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx
_ ->
String -> Lua Version
forall a. String -> Lua a
Lua.throwException "could not peek Version"
instance Peekable Version where
peek :: StackIndex -> Lua Version
peek = StackIndex -> Lua Version
peekVersion
versionTypeName :: String
versionTypeName :: String
versionTypeName = "HsLua Version"
__eq :: Version -> Version -> Lua Bool
__eq :: Version -> Version -> Lua Bool
__eq v1 :: Version
v1 v2 :: Version
v2 = Bool -> Lua Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Version
v1 Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
v2)
__le :: Version -> Version -> Lua Bool
__le :: Version -> Version -> Lua Bool
__le v1 :: Version
v1 v2 :: Version
v2 = Bool -> Lua Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Version
v1 Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
<= Version
v2)
__lt :: Version -> Version -> Lua Bool
__lt :: Version -> Version -> Lua Bool
__lt v1 :: Version
v1 v2 :: Version
v2 = Bool -> Lua Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Version
v1 Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
v2)
__len :: Version -> Lua Int
__len :: Version -> Lua Int
__len = Int -> Lua Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Lua Int) -> (Version -> Int) -> Version -> Lua Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> Int) -> (Version -> [Int]) -> Version -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
versionBranch
__index :: Version -> AnyValue -> Lua NumResults
__index :: Version -> AnyValue -> Lua NumResults
__index v :: Version
v (AnyValue k :: StackIndex
k) = do
Type
ty <- StackIndex -> Lua Type
Lua.ltype StackIndex
k
case Type
ty of
Lua.TypeNumber -> do
Int
n <- StackIndex -> Lua Int
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
k
let versionPart :: Maybe Int
versionPart = [Int] -> Int -> Maybe Int
forall a. [a] -> Int -> Maybe a
atMay (Version -> [Int]
versionBranch Version
v) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
Optional Int -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (Maybe Int -> Optional Int
forall a. Maybe a -> Optional a
Lua.Optional Maybe Int
versionPart)
NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return 1
Lua.TypeString -> do
String
str <- StackIndex -> Lua String
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
k
if String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "must_be_at_least"
then 1 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Version -> Version -> Optional String -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => a -> Lua ()
Lua.pushHaskellFunction Version -> Version -> Optional String -> Lua NumResults
must_be_at_least
else 1 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Lua ()
Lua.pushnil
_ -> 1 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Lua ()
Lua.pushnil
__pairs :: Version -> Lua NumResults
__pairs :: Version -> Lua NumResults
__pairs v :: Version
v = do
(AnyValue -> Optional Int -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => a -> Lua ()
Lua.pushHaskellFunction AnyValue -> Optional Int -> Lua NumResults
nextFn
Lua ()
Lua.pushnil
Lua ()
Lua.pushnil
NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return 3
where
nextFn :: AnyValue -> Optional Int -> Lua Lua.NumResults
nextFn :: AnyValue -> Optional Int -> Lua NumResults
nextFn _ (Optional key :: Maybe Int
key) =
case Maybe Int
key of
Nothing -> case Version -> [Int]
versionBranch Version
v of
[] -> 2 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Lua ()
Lua.pushnil Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lua ()
Lua.pushnil)
n :: Int
n:_ -> 2 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Int -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (1 :: Int) Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Int
n)
Just n :: Int
n -> case [Int] -> Int -> Maybe Int
forall a. [a] -> Int -> Maybe a
atMay (Version -> [Int]
versionBranch Version
v) Int
n of
Nothing -> 2 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Lua ()
Lua.pushnil Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lua ()
Lua.pushnil)
Just b :: Int
b -> 2 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Int -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Int
b)
__tostring :: Version -> Lua String
__tostring :: Version -> Lua String
__tostring v :: Version
v = String -> Lua String
forall (m :: * -> *) a. Monad m => a -> m a
return (Version -> String
showVersion Version
v)
versionTooOldMessage :: String
versionTooOldMessage :: String
versionTooOldMessage = "expected version %s or newer, got %s"
must_be_at_least :: Version -> Version -> Optional String -> Lua NumResults
must_be_at_least :: Version -> Version -> Optional String -> Lua NumResults
must_be_at_least actual :: Version
actual expected :: Version
expected optMsg :: Optional String
optMsg = do
let msg :: String
msg = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
versionTooOldMessage (Optional String -> Maybe String
forall a. Optional a -> Maybe a
fromOptional Optional String
optMsg)
if Version
expected Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
<= Version
actual
then NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return 0
else do
String -> Lua ()
Lua.getglobal' "string.format"
String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push String
msg
String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (Version -> String
showVersion Version
expected)
String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (Version -> String
showVersion Version
actual)
NumArgs -> NumResults -> Lua ()
Lua.call 3 1
Lua NumResults
Lua.error