diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,7 @@ +## Changelog + +### 2.0.0 + +Release pending. + +Complete rewrite. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,23 @@ +Copyright © 1994-2020 Lua.org, PUC-Rio. +Copyright © 2007-2012 Gracjan Polak +Copyright © 2012-2015 Ömer Sinan Ağacan +Copyright © 2016-2021 Albert Krewinkel + +Permission is hereby granted, free of charge, to any person obtaining a +copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,41 @@ +HsLua examples +============== + +[![Build status][GitHub Actions badge]][GitHub Actions] +[![AppVeyor Status]](https://ci.appveyor.com/project/tarleb/hslua-r2y18) +[![Hackage]](https://hackage.haskell.org/package/hslua-examples) + +Example programs showcasing the [HsLua] framework. + +[GitHub Actions badge]: https://img.shields.io/github/workflow/status/hslua/hslua/CI.svg?logo=github +[GitHub Actions]: https://github.com/hslua/hslua/actions +[AppVeyor Status]: https://ci.appveyor.com/api/projects/status/ldutrilgxhpcau94/branch/main?svg=true +[Hackage]: https://img.shields.io/hackage/v/hslua-core.svg +[HsLua]: https://hslua.org/ + +run-lua +----------- + +A simple program which uses Lua to calculate and print Fibonacci +numbers. It demonstrates how a Lua script can be embedded and +executed. + +print-version +------------- + +Demonstrates the use of the the low-level C API functions from the +`lua` package. Prints the Lua version. + +wishlist +---------- + +The code for [Santa's Little Lua Scripts][SLLS]. + +low-level-factorial +------------------- + +Calculate integer factorials in Haskell, allowing for results +which don't fit into a normal Lua integer. Uses only the low-level +C API functions from the `lua` package. + +[SLLS]: https://hslua.org/santas-little-lua-scripts.html diff --git a/factorial/factorial.hs b/factorial/factorial.hs new file mode 100644 --- /dev/null +++ b/factorial/factorial.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-| Compute factorials in Haskell -} +module Main where +import Control.Monad (void) +import HsLua +import Prelude + +-- | Factorial function. +factorial :: DocumentedFunction e +factorial = defun "factorial" + ### liftPure (\n -> product [1..n] :: Prelude.Integer) + -- get arg type of arg name description + <#> parameter peekIntegral "integer" "n" "input number" + =#> functionResult pushIntegral "integer|string" "factorial of n" + #? "Computes the factorial of an integer." + +main :: IO () +main = run @HsLua.Exception $ do + openlibs + pushDocumentedFunction factorial *> setglobal "factorial" + -- run a script + void . dostring $ mconcat + [ "print(' 5! =', factorial(5), type(factorial(5)))\n" + , "print('30! =', factorial(30), type(factorial(30)))\n" + ] diff --git a/hslua-examples.cabal b/hslua-examples.cabal new file mode 100644 --- /dev/null +++ b/hslua-examples.cabal @@ -0,0 +1,79 @@ +cabal-version: 2.2 +name: hslua-examples +version: 2.0.0 +synopsis: Examples of how to combine Haskell and Lua. +description: The HsLua modules provide wrappers of Lua language + interpreter as described on the official + +category: Foreign +build-type: Simple +extra-source-files: README.md + CHANGELOG.md + wishlist/filter.lua + +source-repository head + type: git + location: https://github.com/hslua/hslua.git + subdir: hslua-examples + +common common-options + default-language: Haskell2010 + build-depends: base >= 4.9 && < 5 + ghc-options: -Wall + -Wincomplete-record-updates + -Wnoncanonical-monad-instances + -Wredundant-constraints + if impl(ghc >= 8.2) + ghc-options: -Wcpp-undef + -Werror=missing-home-modules + if impl(ghc >= 8.4) + ghc-options: -Widentities + -Wincomplete-uni-patterns + -Wpartial-fields + -fhide-source-paths + +executable print-version + import: common-options + main-is: print-version.hs + hs-source-dirs: print-version + build-depends: lua >= 2.0 && < 2.1 + +executable run-lua + import: common-options + main-is: run-lua.hs + hs-source-dirs: run-lua + build-depends: bytestring + , hslua >= 2.0 && < 2.1 + +executable wishlist + import: common-options + main-is: wishlist.hs + hs-source-dirs: wishlist + build-depends: bytestring + , hslua >= 2.0 && < 2.1 + , hslua-marshalling >= 2.0 && < 2.1 + , text + +executable factorial + import: common-options + main-is: factorial.hs + hs-source-dirs: factorial + build-depends: bytestring + , hslua >= 2.0 && < 2.1 + +executable low-level-factorial + import: common-options + main-is: low-level-factorial.hs + hs-source-dirs: low-level-factorial + build-depends: lua >= 2.0 && < 2.1 diff --git a/low-level-factorial/low-level-factorial.hs b/low-level-factorial/low-level-factorial.hs new file mode 100644 --- /dev/null +++ b/low-level-factorial/low-level-factorial.hs @@ -0,0 +1,41 @@ +-- lua_setglobal is unsafe in general and causes a compiler warning. +{-# OPTIONS_GHC -Wno-warnings-deprecations #-} +{-| Expose factorial function to Lua, using the low-level API. -} +module Main where +import Prelude +import Control.Monad (void) +import Foreign.C (withCString, withCStringLen) +import Foreign.Ptr (nullPtr) +import Lua + +luaScript :: String +luaScript = unlines + [ "print(' 5! =', factorial(5), type(factorial(5)))" + , "print('30! =', factorial(30), type(factorial(30)))" + ] + +factorial :: PreCFunction +factorial l = do + -- Get the first function argument as an integer. + n <- lua_tointegerx l (nthBottom 1) nullPtr + let result = product [1..fromIntegral n] :: Prelude.Integer + -- push as integer if the result is small enough, + -- and as string otherwise. + if result <= fromIntegral (maxBound :: Lua.Integer) + then lua_pushinteger l (fromIntegral result) + else withCString (show result) (void . lua_pushstring l) + -- Signal that one result value is on the top of the stack. + return (NumResults 1) + +main :: IO () +main = void . withNewState $ \l -> do + luaL_openlibs l + -- expose Haskell function `factorial` as a Lua function of the same name. + hslua_pushhsfunction l factorial + _ <- withCString "factorial" (lua_setglobal l) + -- Load the script. + LUA_OK <- withCStringLen luaScript $ \(sPtr, sLen) -> + withCString "script" $ luaL_loadbuffer l sPtr (fromIntegral sLen) + -- Call the loaded script. + LUA_OK <- lua_pcall l (NumArgs 0) LUA_MULTRET (StackIndex 0) + return () diff --git a/print-version/print-version.hs b/print-version/print-version.hs new file mode 100644 --- /dev/null +++ b/print-version/print-version.hs @@ -0,0 +1,17 @@ +-- @lua_getglobal@ is unsafe in general, but safe in this case. +{-# OPTIONS_GHC -Wno-warnings-deprecations #-} +{-| Use low-level API functions to output the Lua version. -} +module Main where +import Control.Monad (void) +import Foreign.C (withCString) +import Lua + +main :: IO () +main = void . withNewState $ \l -> do + luaL_openlibs l + -- Prepare call `print(_VERSION)`: first push the `print` function + -- to the stack, then the arguments. + LUA_TFUNCTION <- withCString "print" (lua_getglobal l) + LUA_TSTRING <- withCString "_VERSION" (lua_getglobal l) + -- Call the function with one argument. + lua_pcall l (NumArgs 1) (NumResults 0) (StackIndex 0) diff --git a/run-lua/run-lua.hs b/run-lua/run-lua.hs new file mode 100644 --- /dev/null +++ b/run-lua/run-lua.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE OverloadedStrings #-} +{-| Simple program running Lua code. +-} +module Main where +import HsLua.Core +import qualified Data.ByteString as B + +main :: IO () +main = do + putStrLn "Calling Lua to output some Fibonacci numbers." + luaStatus <- run $ do + openlibs -- load the default Lua packages + dostring luaProgram -- load and run the program + putStrLn ("Lua finished with status '" ++ show luaStatus ++ "'.") + + +-- | The Lua program. It uses a simple loop to calculate and print the +-- first 11 Fibonacci numbers. +-- +-- Note that we are using the /OverloadedStrings/ extension. The +-- @IsString@ instance for ByteString behaves weirdly with non-ASCII +-- characters, but we don't use any here. +luaProgram :: B.ByteString +luaProgram = B.concat + [ "local a, b = 0, 1\n" + , "for i = 0, 10 do\n" + , " print(i, a)\n" + , " a, b = b, a + b\n" + , "end\n" + ] diff --git a/wishlist/filter.lua b/wishlist/filter.lua new file mode 100644 --- /dev/null +++ b/wishlist/filter.lua @@ -0,0 +1,4 @@ +return function (wish) + return wish.child.nice and + wish.toy == 'TrainSet' +end diff --git a/wishlist/wishlist.hs b/wishlist/wishlist.hs new file mode 100644 --- /dev/null +++ b/wishlist/wishlist.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE OverloadedStrings #-} +{-| Santa's wishlist processor. + +The program expexts the path to a filter file as its only argument. +See the blog-post for more details: +https://hslua.org/santas-little-lua-scripts.html +-} +module Main where +import Control.Monad (filterM) +import Data.Text (Text, pack) +import HsLua.Core ( Lua, NumResults (..), NumArgs (..) + , call, dofile, newtable, nth, pop, pushvalue, run + , setfield, top, toboolean) +import HsLua.Marshalling (pushBool, pushText) +import System.Environment (getArgs) + +data Toy = Bricks | TrainSet | Doll deriving Show +data Behavior = Nice | Naughty deriving (Eq, Show) + +data Wish = Wish + { wishingChild :: Child + , wishedToy :: Toy + } deriving Show + +data Child = Child + { childName :: Text + , childBehavior :: Behavior + } deriving Show + +pushToy :: Toy -> Lua () +pushToy = pushText . pack . show + +pushChild :: Child -> Lua () +pushChild (Child name behavior) = do + -- create new Lua table on the stack + newtable + -- push boolean to stack + pushText name + -- table now in position 2; assign string to field in table + setfield (nth 2) "name" + + -- push boolean to stack + pushBool (behavior == Nice) + setfield (nth 2) "nice" + +pushWish :: Wish -> Lua () +pushWish (Wish child toy) = do + newtable + pushChild child + setfield (nth 2) "child" + pushToy toy + setfield (nth 2) "toy" + +wishes :: [Wish] +wishes = + [ Wish (Child "Theodor" Nice) Bricks + , Wish (Child "Philine" Nice) TrainSet + , Wish (Child "Steve" Naughty) Doll + ] + +hasPredicate :: Wish -> Lua Bool +hasPredicate wish = do + -- Assume filter function is at the top of the stack; + -- create a copy so we can re-use it. + pushvalue top + pushWish wish + -- Call the function. There is one argument on the stack, + -- and we expect one result to be returned. + call (NumArgs 1) (NumResults 1) + toboolean top <* pop 1 + +main :: IO () +main = do + filterFile <- fmap (!! 0) getArgs -- get first argument + result <- run $ do + _status <- dofile filterFile + filterM hasPredicate wishes + print result