{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module HsLua.Module.Version (
documentedModule
, typeVersion
, peekVersion
, pushVersion
, peekVersionFuzzy
)
where
import Prelude hiding (error)
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
, pushBool, 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 :: Module e
documentedModule = Module :: forall e.
Name
-> Text
-> [Field e]
-> [DocumentedFunction e]
-> [(Operation, DocumentedFunction e)]
-> Module e
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 () -> Text -> Text -> Text -> Parameter e ()
forall e a. Peeker e a -> Text -> 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 (f :: * -> *) a. Applicative f => a -> f a
pure ()) Text
"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
=#> Pusher e Version -> Text -> Text -> FunctionResults e Version
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult (UDTypeWithList e (DocumentedFunction e) Version Int
-> Pusher e Version
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e (DocumentedFunction e) Version Int
forall e. LuaError e => DocumentedTypeWithList e Version Int
typeVersion) Text
"Version" Text
"new Version object"
]
}
typeVersion :: LuaError e => DocumentedTypeWithList e Version Int
typeVersion :: 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
$ (Version -> Version -> Bool) -> Text -> DocumentedFunction e
forall e.
LuaError e =>
(Version -> Version -> Bool) -> Text -> DocumentedFunction e
versionComparison Version -> Version -> Bool
forall a. Eq 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
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
=#> Pusher e Int -> Text -> Text -> FunctionResults e Int
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral Text
"integer" 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
=#> Pusher e String -> Text -> Text -> FunctionResults e String
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString Text
"string" 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 (Version -> [Int]
versionBranch, Pusher e Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral))
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
=#> Pusher e Bool -> Text -> Text -> FunctionResults e Bool
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Bool
forall e. Pusher e Bool
pushBool Text
"boolean" Text
descr
pushVersion :: LuaError e => Pusher e Version
pushVersion :: Pusher e Version
pushVersion = UDTypeWithList e (DocumentedFunction e) Version Int
-> Pusher e Version
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e (DocumentedFunction e) Version Int
forall e. LuaError e => DocumentedTypeWithList e Version Int
typeVersion
peekVersion :: LuaError e => Peeker e Version
peekVersion :: Peeker e Version
peekVersion = UDTypeWithList e (DocumentedFunction e) Version Int
-> Peeker e Version
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e (DocumentedFunction e) Version Int
forall e. LuaError e => DocumentedTypeWithList e Version Int
typeVersion
peekVersionFuzzy :: LuaError e => Peeker e Version
peekVersionFuzzy :: 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 (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 (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"
versionParam :: LuaError e => Text -> Text -> Parameter e Version
versionParam :: Text -> Text -> Parameter e Version
versionParam = Peeker e Version -> Text -> Text -> Text -> Parameter e Version
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Version
forall e. LuaError e => Peeker e Version
peekVersionFuzzy Text
"Version"
must_be_at_least :: LuaError e => DocumentedFunction e
must_be_at_least :: 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
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
<#> Peeker e String
-> Text -> Text -> Text -> Parameter e (Maybe String)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e String
forall e. Peeker e String
peekString Text
"string" 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`."
]