{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : HsLua.Module.Version
Copyright   : © 2019-2024 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>

Lua module to work with file paths.
-}
module HsLua.Module.Version (
  -- * Module
    documentedModule
  -- * Version objects
  , typeVersion
  , peekVersion
  , pushVersion
  , peekVersionFuzzy
  )
where

import Prelude hiding (error)
import Control.Applicative (optional)
import Data.Maybe (fromMaybe)
import Data.Version
  ( Version, makeVersion, parseVersion, showVersion, versionBranch )
import Data.List.NonEmpty as NonEmpty (last, nonEmpty)
import Data.Text (Text)
import HsLua.Core
  ( LuaError, Type (..) , call, dostring, error, ltype )
import HsLua.Marshalling
  ( Peeker, Pusher, failPeek, liftLua, peekIntegral, peekList, peekString
  , pushIntegral, pushIterator, pushString, retrieving )
import HsLua.Packaging
import Text.ParserCombinators.ReadP (readP_to_S)

import qualified HsLua.Core.Utf8 as UTF8

-- | The @path@ module specification.
documentedModule :: LuaError e => Module e
documentedModule :: forall e. LuaError e => Module e
documentedModule = Module
  { moduleName :: Name
moduleName = Name
"Version"
  , moduleDescription :: Text
moduleDescription = Text
"Version specifier handling"
  , moduleFields :: [Field e]
moduleFields = []
  , moduleFunctions :: [DocumentedFunction e]
moduleFunctions = [DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
must_be_at_least]
  , moduleOperations :: [(Operation, DocumentedFunction e)]
moduleOperations =
    [ Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Call (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (() -> Version -> LuaE e Version)
-> HsFnPrecursor e (() -> Version -> LuaE e Version)
forall a e. a -> HsFnPrecursor e a
lambda
      ### liftPure2 (\_ v -> v)
      HsFnPrecursor e (() -> Version -> LuaE e Version)
-> Parameter e () -> HsFnPrecursor e (Version -> LuaE e Version)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e () -> TypeSpec -> Text -> Text -> Parameter e ()
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Peek e () -> Peeker e ()
forall a b. a -> b -> a
const (Peek e () -> Peeker e ()) -> Peek e () -> Peeker e ()
forall a b. (a -> b) -> a -> b
$ () -> Peek e ()
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) TypeSpec
"table" Text
"module table" Text
"ignored"
      HsFnPrecursor e (Version -> LuaE e Version)
-> Parameter e Version -> HsFnPrecursor e (LuaE e Version)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Text -> Parameter e Version
forall e. LuaError e => Text -> Text -> Parameter e Version
versionParam Text
"version" Text
"version-like object"
      HsFnPrecursor e (LuaE e Version)
-> FunctionResults e Version -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> DocumentedTypeWithList e Version Int
-> Text -> FunctionResults e Version
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Text -> FunctionResults e a
udresult DocumentedTypeWithList e Version Int
forall e. LuaError e => DocumentedTypeWithList e Version Int
typeVersion Text
"new Version object"
    ]
  , moduleTypeInitializers :: [LuaE e Name]
moduleTypeInitializers = []
  }

-- | Type definition of Lua Version values.
typeVersion :: LuaError e => DocumentedTypeWithList e Version Int
typeVersion :: forall e. LuaError e => DocumentedTypeWithList e Version Int
typeVersion = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) Version]
-> Maybe (ListSpec e Version Int)
-> DocumentedTypeWithList e Version Int
forall e a itemtype.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> Maybe (ListSpec e a itemtype)
-> DocumentedTypeWithList e a itemtype
deftype' Name
"Version"
  [ Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Eq (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Maybe Version -> Maybe Version -> LuaE e Bool)
-> HsFnPrecursor e (Maybe Version -> Maybe Version -> LuaE e Bool)
forall a e. a -> HsFnPrecursor e a
lambda
      ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))
      HsFnPrecursor e (Maybe Version -> Maybe Version -> LuaE e Bool)
-> Parameter e (Maybe Version)
-> HsFnPrecursor e (Maybe Version -> LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe Version)
-> TypeSpec -> Text -> Text -> Parameter e (Maybe Version)
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Peek e Version -> Peek e (Maybe Version)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e Version -> Peek e (Maybe Version))
-> (StackIndex -> Peek e Version) -> Peeker e (Maybe Version)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Version
forall e. LuaError e => Peeker e Version
peekVersionFuzzy) TypeSpec
"Version" Text
"a" Text
""
      HsFnPrecursor e (Maybe Version -> LuaE e Bool)
-> Parameter e (Maybe Version) -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe Version)
-> TypeSpec -> Text -> Text -> Parameter e (Maybe Version)
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Peek e Version -> Peek e (Maybe Version)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e Version -> Peek e (Maybe Version))
-> (StackIndex -> Peek e Version) -> Peeker e (Maybe Version)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Version
forall e. LuaError e => Peeker e Version
peekVersionFuzzy) TypeSpec
"Version" Text
"b" Text
""
      HsFnPrecursor e (LuaE e Bool)
-> FunctionResults e Bool -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Bool
forall e. Text -> FunctionResults e Bool
boolResult Text
"true iff v1 == v2"
  , Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Le (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Version -> Version -> Bool) -> Text -> DocumentedFunction e
forall {e}.
LuaError e =>
(Version -> Version -> Bool) -> Text -> DocumentedFunction e
versionComparison Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
(<=) Text
"true iff v1 <= v2"
  , Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Lt (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Version -> Version -> Bool) -> Text -> DocumentedFunction e
forall {e}.
LuaError e =>
(Version -> Version -> Bool) -> Text -> DocumentedFunction e
versionComparison Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
(<)  Text
"true iff v1 < v2"
  , Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Len (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Version -> LuaE e Int) -> HsFnPrecursor e (Version -> LuaE e Int)
forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure (length . versionBranch)
    HsFnPrecursor e (Version -> LuaE e Int)
-> Parameter e Version -> HsFnPrecursor e (LuaE e Int)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Text -> Parameter e Version
forall e. LuaError e => Text -> Text -> Parameter e Version
versionParam Text
"version" Text
""
    HsFnPrecursor e (LuaE e Int)
-> FunctionResults e Int -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Int
forall a e. (Integral a, Show a) => Text -> FunctionResults e a
integralResult Text
"number of version components"
  , Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Pairs (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Version -> LuaE e NumResults)
-> HsFnPrecursor e (Version -> LuaE e NumResults)
forall a e. a -> HsFnPrecursor e a
lambda
    ### pushIterator (\(i, n) -> 2 <$ pushIntegral i <* pushIntegral n)
          . zip [(1 :: Int) ..] . versionBranch
    HsFnPrecursor e (Version -> LuaE e NumResults)
-> Parameter e Version -> HsFnPrecursor e (LuaE e NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Text -> Parameter e Version
forall e. LuaError e => Text -> Text -> Parameter e Version
versionParam Text
"version" Text
""
    HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"iterator values"
  , Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Version -> LuaE e String)
-> HsFnPrecursor e (Version -> LuaE e String)
forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure showVersion
    HsFnPrecursor e (Version -> LuaE e String)
-> Parameter e Version -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Text -> Parameter e Version
forall e. LuaError e => Text -> Text -> Parameter e Version
versionParam Text
"version" Text
""
    HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e String
forall e. Text -> FunctionResults e String
stringResult Text
"stringified version"
  ]
  [ DocumentedFunction e -> Member e (DocumentedFunction e) Version
forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
must_be_at_least ]
  (ListSpec e Version Int -> Maybe (ListSpec e Version Int)
forall a. a -> Maybe a
Just ( (Int -> LuaE e ()
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, Version -> [Int]
versionBranch)
        , (Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, ([Int] -> Version) -> Version -> [Int] -> Version
forall a b. a -> b -> a
const [Int] -> Version
makeVersion)))
  where
    versionComparison :: (Version -> Version -> Bool) -> Text -> DocumentedFunction e
versionComparison Version -> Version -> Bool
f Text
descr = (Version -> Version -> LuaE e Bool)
-> HsFnPrecursor e (Version -> Version -> LuaE e Bool)
forall a e. a -> HsFnPrecursor e a
lambda
      ### liftPure2 f
      HsFnPrecursor e (Version -> Version -> LuaE e Bool)
-> Parameter e Version -> HsFnPrecursor e (Version -> LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Text -> Parameter e Version
forall e. LuaError e => Text -> Text -> Parameter e Version
versionParam Text
"v1" Text
""
      HsFnPrecursor e (Version -> LuaE e Bool)
-> Parameter e Version -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Text -> Parameter e Version
forall e. LuaError e => Text -> Text -> Parameter e Version
versionParam Text
"v2" Text
""
      HsFnPrecursor e (LuaE e Bool)
-> FunctionResults e Bool -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Bool
forall e. Text -> FunctionResults e Bool
boolResult Text
descr

-- | Push a @'Version'@ element to the Lua stack.
pushVersion :: LuaError e => Pusher e Version
pushVersion :: forall e. LuaError e => Pusher e Version
pushVersion = DocumentedTypeWithList e Version Int -> Version -> LuaE e ()
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD DocumentedTypeWithList e Version Int
forall e. LuaError e => DocumentedTypeWithList e Version Int
typeVersion

-- | Retrieve a @'Version'@ object from the top of the stack.
peekVersion :: LuaError e => Peeker e Version
peekVersion :: forall e. LuaError e => Peeker e Version
peekVersion = DocumentedTypeWithList e Version Int -> Peeker e Version
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Peeker e a
peekUD DocumentedTypeWithList e Version Int
forall e. LuaError e => DocumentedTypeWithList e Version Int
typeVersion

-- | Retrieve a Version-like object from the top of the stack.
--
-- This function uses these heuristics, depending on the Lua object
-- type.
--
--   * string: object is parsed as a version specifier.
--
--   * table: value is expected to be a list of integers, with each
--     index specifying a version branch.
--
--   * userdata: assumes the value to be a Version userdata object.
--
--   * number: parses the number as an integer value.
--
-- Otherwise, or if the object fails to meet an expectation, peeking
-- fails.
peekVersionFuzzy :: LuaError e => Peeker e Version
peekVersionFuzzy :: forall e. LuaError e => Peeker e Version
peekVersionFuzzy StackIndex
idx = Name -> Peek e Version -> Peek e Version
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Version" (Peek e Version -> Peek e Version)
-> Peek e Version -> Peek e Version
forall a b. (a -> b) -> a -> b
$ LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) Peek e Type -> (Type -> Peek e Version) -> Peek e Version
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeUserdata -> Peeker e Version
forall e. LuaError e => Peeker e Version
peekVersion StackIndex
idx
  Type
TypeString   -> do
    String
versionStr <- Peeker e String
forall e. Peeker e String
peekString 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 NonEmpty (Version, String) -> (Version, String)
forall a. NonEmpty a -> a
NonEmpty.last (NonEmpty (Version, String) -> (Version, String))
-> Maybe (NonEmpty (Version, String)) -> Maybe (Version, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Version, String)] -> Maybe (NonEmpty (Version, String))
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [(Version, String)]
parses of
      Just (Version
v, String
"") -> Version -> Peek e Version
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return Version
v
      Maybe (Version, String)
_  -> ByteString -> Peek e Version
forall a e. ByteString -> Peek e a
failPeek (ByteString -> Peek e Version) -> ByteString -> Peek e Version
forall a b. (a -> b) -> a -> b
$
            ByteString
"could not parse as Version: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
UTF8.fromString String
versionStr
  Type
TypeNumber   -> [Int] -> Version
makeVersion ([Int] -> Version) -> (Int -> [Int]) -> Int -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[]) (Int -> Version) -> Peek e Int -> Peek e Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral StackIndex
idx
  Type
TypeTable    -> [Int] -> Version
makeVersion ([Int] -> Version) -> Peek e [Int] -> Peek e Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker e Int -> Peeker e [Int]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral StackIndex
idx
  Type
_ ->
    ByteString -> Peek e Version
forall a e. ByteString -> Peek e a
failPeek ByteString
"could not peek Version"

-- | Parameter that takes a Version-like object.
versionParam :: LuaError e => Text -> Text -> Parameter e Version
versionParam :: forall e. LuaError e => Text -> Text -> Parameter e Version
versionParam = Peeker e Version -> TypeSpec -> Text -> Text -> Parameter e Version
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e Version
forall e. LuaError e => Peeker e Version
peekVersionFuzzy TypeSpec
"Version"

-- | Throw an error if this version is older than the given version. This
-- function currently the string library to be loaded.
must_be_at_least :: LuaError e => DocumentedFunction e
must_be_at_least :: forall e. LuaError e => DocumentedFunction e
must_be_at_least =
  Name
-> (Version -> Version -> Maybe String -> LuaE e NumResults)
-> HsFnPrecursor
     e (Version -> Version -> Maybe String -> LuaE e NumResults)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"must_be_at_least"
    ### (\actual expected mMsg -> do
            -- Default error message when a version is too old. This
            -- message is formatted in Lua with the expected and actual
            -- versions as arguments.
            let versionTooOldMessage = "expected version %s or newer, got %s"
            let msg = fromMaybe versionTooOldMessage mMsg
            if expected <= actual
              then return 0
              else do
              _ <- dostring "return string.format"
              pushString msg
              pushString (showVersion expected)
              pushString (showVersion actual)
              call 3 1
              error)
    HsFnPrecursor
  e (Version -> Version -> Maybe String -> LuaE e NumResults)
-> Parameter e Version
-> HsFnPrecursor e (Version -> Maybe String -> LuaE e NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Text -> Parameter e Version
forall e. LuaError e => Text -> Text -> Parameter e Version
versionParam Text
"self" Text
"version to check"
    HsFnPrecursor e (Version -> Maybe String -> LuaE e NumResults)
-> Parameter e Version
-> HsFnPrecursor e (Maybe String -> LuaE e NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Text -> Parameter e Version
forall e. LuaError e => Text -> Text -> Parameter e Version
versionParam Text
"reference" Text
"minimum version"
    HsFnPrecursor e (Maybe String -> LuaE e NumResults)
-> Parameter e (Maybe String)
-> HsFnPrecursor e (LuaE e NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e String -> Parameter e (Maybe String)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Text -> Text -> Parameter e String
forall e. Text -> Text -> Parameter e String
stringParam Text
"msg" Text
"alternative message")
    HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [ Text
"Returns no result, and throws an error if this "
                , Text
"version is older than `reference`."
                ]