{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{- |
   Module      : Text.Pandoc.Lua.Marshaling.Version
   Copyright   : © 2019-2020 Albert Krewinkel
   License     : GNU GPL, version 2 or above

   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
   Stability   : alpha

Marshaling of @'Version'@s. The marshaled elements can be compared using
default comparison operators (like @>@ and @<=@).
-}
module Text.Pandoc.Lua.Marshaling.Version
  ( peekVersion
  , pushVersion
  )
  where

import Data.Text (Text)
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

-- | Push a @'Version'@ element to the Lua stack.
pushVersion :: Version -> Lua ()
pushVersion :: Version -> Lua ()
pushVersion 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 String
"__eq" Version -> Version -> Lua Bool
__eq
    String -> (Version -> Version -> Lua Bool) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
LuaUtil.addFunction String
"__le" Version -> Version -> Lua Bool
__le
    String -> (Version -> Version -> Lua Bool) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
LuaUtil.addFunction String
"__lt" Version -> Version -> Lua Bool
__lt
    String -> (Version -> Lua Int) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
LuaUtil.addFunction String
"__len" Version -> Lua Int
__len
    String -> (Version -> AnyValue -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
LuaUtil.addFunction String
"__index" Version -> AnyValue -> Lua NumResults
__index
    String -> (Version -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
LuaUtil.addFunction String
"__pairs" Version -> Lua NumResults
__pairs
    String -> (Version -> Lua String) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
LuaUtil.addFunction String
"__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 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
  Type
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 (Version
v, String
"") -> Version -> Lua Version
forall (m :: * -> *) a. Monad m => a -> m a
return Version
v
      Maybe (Version, String)
_  -> String -> Lua Version
forall a. String -> Lua a
Lua.throwMessage (String -> Lua Version) -> String -> Lua Version
forall a b. (a -> b) -> a -> b
$ String
"could not parse as Version: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
versionStr

  Type
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
  Type
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])

  Type
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

  Type
_ ->
    String -> Lua Version
forall a. String -> Lua a
Lua.throwMessage String
"could not peek Version"

instance Peekable Version where
  peek :: StackIndex -> Lua Version
peek = StackIndex -> Lua Version
peekVersion

-- | Name used by Lua for the @CommonState@ type.
versionTypeName :: String
versionTypeName :: String
versionTypeName = String
"HsLua Version"

__eq :: Version -> Version -> Lua Bool
__eq :: Version -> Version -> Lua Bool
__eq Version
v1 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 Version
v1 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 Version
v1 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)

-- | Get number of version components.
__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

-- | Access fields.
__index :: Version -> AnyValue -> Lua NumResults
__index :: Version -> AnyValue -> Lua NumResults
__index Version
v (AnyValue StackIndex
k) = do
  Type
ty <- StackIndex -> Lua Type
Lua.ltype StackIndex
k
  case Type
ty of
    Type
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
- Int
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 NumResults
1
    Type
Lua.TypeString -> do
      (Text
str :: Text) <- StackIndex -> Lua Text
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
k
      if Text
str Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"must_be_at_least"
        then NumResults
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 NumResults
1 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Lua ()
Lua.pushnil
    Type
_ -> NumResults
1 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Lua ()
Lua.pushnil

-- | Create iterator.
__pairs :: Version -> Lua NumResults
__pairs :: Version -> Lua NumResults
__pairs 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 NumResults
3
 where
  nextFn :: AnyValue -> Optional Int -> Lua Lua.NumResults
  nextFn :: AnyValue -> Optional Int -> Lua NumResults
nextFn AnyValue
_ (Optional Maybe Int
key) =
    case Maybe Int
key of
      Maybe Int
Nothing -> case Version -> [Int]
versionBranch Version
v of
                   []  -> NumResults
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)
                   Int
n:[Int]
_ -> NumResults
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
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 Int
n  -> case [Int] -> Int -> Maybe Int
forall a. [a] -> Int -> Maybe a
atMay (Version -> [Int]
versionBranch Version
v) Int
n of
                   Maybe Int
Nothing -> NumResults
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 Int
b  -> NumResults
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
+ Int
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)

-- | Convert to string.
__tostring :: Version -> Lua String
__tostring :: Version -> Lua String
__tostring Version
v = String -> Lua String
forall (m :: * -> *) a. Monad m => a -> m a
return (Version -> String
showVersion Version
v)

-- | Default error message when a version is too old. This message is
-- formatted in Lua with the expected and actual versions as arguments.
versionTooOldMessage :: String
versionTooOldMessage :: String
versionTooOldMessage = String
"expected version %s or newer, got %s"

-- | Throw an error if this version is older than the given version.
-- FIXME: This function currently requires the string library to be
-- loaded.
must_be_at_least :: Version -> Version -> Optional String -> Lua NumResults
must_be_at_least :: Version -> Version -> Optional String -> Lua NumResults
must_be_at_least Version
actual Version
expected 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 NumResults
0
    else do
      String -> Lua ()
Lua.getglobal' String
"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 NumArgs
3 NumResults
1
      Lua NumResults
Lua.error