{-# 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)
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 = [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 = []
}
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
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
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
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"
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"
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
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`."
]