{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE NoImplicitPrelude    #-}
{- |
   Module      : Text.Pandoc.Lua.Marshaling.Version
   Copyright   : © 2019 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 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

-- | Push a @'Version'@ element to the Lua stack.
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

-- | Name used by Lua for the @CommonState@ type.
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)

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

-- | Create iterator.
__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)

-- | Convert to string.
__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)

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