{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : HsLua.Module.Version
Copyright   : © 2019-2021 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <albert+hslua@zeitkraut.de>

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

-- | The @path@ module specification.
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"
    ]
  }

-- | Type definition of Lua Version values.
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

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

-- | Retrieve a @'Version'@ object from the top of the stack.
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

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

-- | Parameter that takes a Version-like object.
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"

-- | 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 :: 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
<#> 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`."
                ]