{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module HsLua.Module.Version (
documentedModule
, 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)
#if !MIN_VERSION_base(4,12,0)
import Data.Semigroup (Semigroup ((<>)))
#endif
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
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 = [forall e. LuaError e => DocumentedFunction e
must_be_at_least]
, moduleOperations :: [(Operation, DocumentedFunction e)]
moduleOperations =
[ forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Call forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
### liftPure2 (\_ v -> v)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Text
"table" Text
"module table" Text
"ignored"
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. LuaError e => Text -> Text -> Parameter e Version
versionParam Text
"version" Text
"version-like object"
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Text -> FunctionResults e a
udresult forall e. LuaError e => DocumentedTypeWithList e Version Int
typeVersion Text
"new Version object"
]
}
typeVersion :: LuaError e => DocumentedTypeWithList e Version Int
typeVersion :: forall e. LuaError e => DocumentedTypeWithList e Version Int
typeVersion = 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"
[ forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Eq forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e Version
peekVersionFuzzy) Text
"Version" Text
"a" Text
""
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e Version
peekVersionFuzzy) Text
"Version" Text
"b" Text
""
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e. Text -> FunctionResults e Bool
boolResult Text
"true iff v1 == v2"
, forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Le forall a b. (a -> b) -> a -> b
$ forall {e}.
LuaError e =>
(Version -> Version -> Bool) -> Text -> DocumentedFunction e
versionComparison forall a. Ord a => a -> a -> Bool
(<=) Text
"true iff v1 <= v2"
, forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Lt forall a b. (a -> b) -> a -> b
$ forall {e}.
LuaError e =>
(Version -> Version -> Bool) -> Text -> DocumentedFunction e
versionComparison forall a. Ord a => a -> a -> Bool
(<) Text
"true iff v1 < v2"
, forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Len forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
### liftPure (length . versionBranch)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. LuaError e => Text -> Text -> Parameter e Version
versionParam Text
"version" Text
""
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall a e. (Integral a, Show a) => Text -> FunctionResults e a
integralResult Text
"number of version components"
, forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Pairs forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
### pushIterator (\(i, n) -> 2 <$ pushIntegral i <* pushIntegral n)
. zip [(1 :: Int) ..] . versionBranch
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. LuaError e => Text -> Text -> Parameter e Version
versionParam Text
"version" Text
""
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"iterator values"
, forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
### liftPure showVersion
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. LuaError e => Text -> Text -> Parameter e Version
versionParam Text
"version" Text
""
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e. Text -> FunctionResults e String
stringResult Text
"stringified version"
]
[ forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method forall e. LuaError e => DocumentedFunction e
must_be_at_least ]
(forall a. a -> Maybe a
Just ( (forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, Version -> [Int]
versionBranch)
, (forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, 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 = forall a e. a -> HsFnPrecursor e a
lambda
### liftPure2 f
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. LuaError e => Text -> Text -> Parameter e Version
versionParam Text
"v1" Text
""
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. LuaError e => Text -> Text -> Parameter e Version
versionParam Text
"v2" Text
""
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e. Text -> FunctionResults e Bool
boolResult Text
descr
pushVersion :: LuaError e => Pusher e Version
pushVersion :: forall e. LuaError e => Pusher e Version
pushVersion = forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD forall e. LuaError e => DocumentedTypeWithList e Version Int
typeVersion
peekVersion :: LuaError e => Peeker e Version
peekVersion :: forall e. LuaError e => Peeker e Version
peekVersion = forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD forall e. LuaError e => DocumentedTypeWithList e Version Int
typeVersion
peekVersionFuzzy :: LuaError e => Peeker e Version
peekVersionFuzzy :: forall e. LuaError e => Peeker e Version
peekVersionFuzzy StackIndex
idx = forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Version" forall a b. (a -> b) -> a -> b
$ forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
TypeUserdata -> forall e. LuaError e => Peeker e Version
peekVersion StackIndex
idx
Type
TypeString -> do
String
versionStr <- forall e. Peeker e String
peekString StackIndex
idx
let parses :: [(Version, String)]
parses = forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
parseVersion String
versionStr
case forall a. NonEmpty a -> a
NonEmpty.last forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [(Version, String)]
parses of
Just (Version
v, String
"") -> forall (m :: * -> *) a. Monad m => a -> m a
return Version
v
Maybe (Version, String)
_ -> forall a e. ByteString -> Peek e a
failPeek forall a b. (a -> b) -> a -> b
$
ByteString
"could not parse as Version: " forall a. Semigroup a => a -> a -> a
<> String -> ByteString
UTF8.fromString String
versionStr
Type
TypeNumber -> [Int] -> Version
makeVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a e. (Integral a, Read a) => Peeker e a
peekIntegral StackIndex
idx
Type
TypeTable -> [Int] -> Version
makeVersion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall a e. (Integral a, Read a) => Peeker e a
peekIntegral StackIndex
idx
Type
_ ->
forall a e. ByteString -> Peek e a
failPeek ByteString
"could not peek Version"
versionParam :: LuaError e => Text -> Text -> Parameter e Version
versionParam :: forall e. LuaError e => Text -> Text -> Parameter e Version
versionParam = forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Version
peekVersionFuzzy Text
"Version"
must_be_at_least :: LuaError e => DocumentedFunction e
must_be_at_least :: forall e. LuaError e => DocumentedFunction e
must_be_at_least =
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"must_be_at_least"
### (\actual expected mMsg -> do
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)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. LuaError e => Text -> Text -> Parameter e Version
versionParam Text
"self" Text
"version to check"
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. LuaError e => Text -> Text -> Parameter e Version
versionParam Text
"reference" Text
"minimum version"
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e. Text -> Text -> Parameter e String
stringParam Text
"msg" Text
"alternative message")
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> forall a. Monoid a => [a] -> a
mconcat [ Text
"Returns no result, and throws an error if this "
, Text
"version is older than `reference`."
]