diff --git a/License b/License new file mode 100644 --- /dev/null +++ b/License @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2022-2025 Ingy döt Net and contributors + +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/lib/YAMLScript.hs b/lib/YAMLScript.hs new file mode 100644 --- /dev/null +++ b/lib/YAMLScript.hs @@ -0,0 +1,56 @@ +-- Copyright 2022-2025 Ingy döt Net +-- This code is licensed under MIT license (See License for details) + +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE OverloadedStrings #-} + +module YAMLScript + ( loadYAMLScript + , loadYAMLScriptFile + , YAMLScriptError(..) + ) where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Types as Aeson +import Control.Exception (Exception, throwIO) +import Control.Monad.IO.Class (MonadIO, liftIO) +import System.IO.Unsafe (unsafePerformIO) +import YAMLScript.FFI + +-- | Error type for YAMLScript operations +data YAMLScriptError + = YAMLScriptParseError String + | YAMLScriptRuntimeError String + | YAMLScriptFFIError String + deriving (Show, Eq) + +instance Exception YAMLScriptError + +-- | Load and evaluate YAMLScript code from a string +-- Returns the result as a JSON Value +loadYAMLScript :: MonadIO m => T.Text -> m Aeson.Value +loadYAMLScript input = liftIO $ do + let inputBS = TE.encodeUtf8 input + result <- loadYsToJsonFFI inputBS + case Aeson.eitherDecode (LBS.fromStrict result) of + Left err -> throwIO $ YAMLScriptParseError err + Right value -> return value + +-- | Load and evaluate YAMLScript code from a file +-- Returns the result as a JSON Value +loadYAMLScriptFile :: MonadIO m => FilePath -> m Aeson.Value +loadYAMLScriptFile filepath = liftIO $ do + content <- BS.readFile filepath + result <- loadYsToJsonFFI content + case Aeson.eitherDecode (LBS.fromStrict result) of + Left err -> throwIO $ YAMLScriptParseError err + Right value -> return value + +-- | Convenience function for pure contexts +-- Note: This uses unsafePerformIO and should be used carefully +loadYAMLScriptPure :: T.Text -> Aeson.Value +loadYAMLScriptPure = unsafePerformIO . loadYAMLScript diff --git a/lib/YAMLScript/FFI.hs b/lib/YAMLScript/FFI.hs new file mode 100644 --- /dev/null +++ b/lib/YAMLScript/FFI.hs @@ -0,0 +1,61 @@ +-- Copyright 2022-2025 Ingy döt Net +-- This code is licensed under MIT license (See License for details) + +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CApiFFI #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module YAMLScript.FFI + ( loadYsToJsonFFI + ) where + +import Foreign +import Foreign.C.String +import Foreign.C.Types +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BSU +import Control.Exception (bracket) + +-- | GraalVM isolate thread type +type GraalIsolateThread = Ptr () + +-- | Foreign function interface to GraalVM isolate management +foreign import capi "graal_isolate.h graal_create_isolate" + c_graal_create_isolate :: Ptr () -> Ptr () -> Ptr GraalIsolateThread -> IO CInt + +foreign import capi "graal_isolate.h graal_tear_down_isolate" + c_graal_tear_down_isolate :: GraalIsolateThread -> IO CInt + +-- | Foreign function interface to load_ys_to_json +foreign import capi "libys.0.2.1.h load_ys_to_json" + c_load_ys_to_json :: GraalIsolateThread -> CString -> IO CString + +-- | Create a GraalVM isolate and run an action with it +withGraalIsolate :: (GraalIsolateThread -> IO a) -> IO a +withGraalIsolate action = + alloca $ \(isolateThreadPtr :: Ptr GraalIsolateThread) -> do + -- Create the isolate (following Python binding pattern: None, None, &isolatethread) + rc <- c_graal_create_isolate nullPtr nullPtr isolateThreadPtr + if rc /= 0 + then error $ "Failed to create GraalVM isolate (code " ++ show rc ++ ")" + else do + isolateThread <- peek isolateThreadPtr + -- Run the action and ensure cleanup + bracket + (return isolateThread) + (\thread -> do + rc' <- c_graal_tear_down_isolate thread + if rc' /= 0 + then error $ "Failed to tear down GraalVM isolate (code " ++ show rc' ++ ")" + else return ()) + action + +-- | Load YAMLScript code and return JSON result +loadYsToJsonFFI :: BS.ByteString -> IO BS.ByteString +loadYsToJsonFFI input = + withGraalIsolate $ \isolateThread -> + BSU.unsafeUseAsCString input $ \cInput -> do + cResult <- c_load_ys_to_json isolateThread cInput + if cResult == nullPtr + then return BS.empty + else BS.packCString cResult diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,21 @@ +-- Copyright 2022-2025 Ingy döt Net +-- This code is licensed under MIT license (See License for details) + +module Main where + +import qualified Data.Text as T +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Encode.Pretty as Aeson +import qualified Data.ByteString.Lazy.Char8 as LBS +import System.Environment (getArgs) +import YAMLScript + +main :: IO () +main = do + args <- getArgs + case args of + [] -> putStrLn "Usage: yamlscript-test " + (code:_) -> do + let input = T.pack code + result <- loadYAMLScript input + LBS.putStrLn $ Aeson.encodePretty result diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,39 @@ +-- Copyright 2022-2025 Ingy döt Net +-- This code is licensed under MIT license (See License for details) + +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Test.Hspec +import qualified Data.Text as T +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Key as Key +import qualified Data.Aeson.KeyMap as KeyMap +import YAMLScript +import YAMLScript.Tests + +main :: IO () +main = hspec $ do + describe "YAMLScript" $ do + it "loads simple YAML" $ do + result <- loadYAMLScript "foo: bar" + result `shouldBe` Aeson.object + [("data", Aeson.object [("foo", Aeson.String "bar")])] + + it "evaluates YAMLScript function call" $ do + result <- loadYAMLScript "!yamlscript/v0\nadd(40, 2)" + result `shouldBe` Aeson.object [("data", Aeson.Number 42)] + + it "loads from file" $ do + result <- loadYAMLScriptFile "test/data/simple.ys" + result `shouldBe` Aeson.object + [("data", Aeson.object [("test", Aeson.String "value")])] + + it "handles errors gracefully" $ do + result <- loadYAMLScript "!yamlscript/v0\ninvalid: syntax" + case result of + Aeson.Object obj -> case KeyMap.lookup (Key.fromString "error") obj of + Just _ -> return () -- Error present, test passes + Nothing -> expectationFailure "Expected error response" + _ -> expectationFailure "Expected JSON object" diff --git a/test/YAMLScript/Tests.hs b/test/YAMLScript/Tests.hs new file mode 100644 --- /dev/null +++ b/test/YAMLScript/Tests.hs @@ -0,0 +1,64 @@ +-- Copyright 2022-2025 Ingy döt Net +-- This code is licensed under MIT license (See License for details) + +{-# LANGUAGE OverloadedStrings #-} + +module YAMLScript.Tests where + +import Test.Hspec +import qualified Data.Text as T +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Key as Key +import qualified Data.Aeson.KeyMap as KeyMap +import qualified Data.Vector as V +import YAMLScript + +-- | Test basic YAML functionality +basicTests :: Spec +basicTests = describe "Basic YAML" $ do + it "parses simple key-value pairs" $ do + result <- loadYAMLScript "key: value" + result `shouldBe` Aeson.object + [("data", Aeson.object [("key", Aeson.String "value")])] + + it "parses lists" $ do + result <- loadYAMLScript "list: [1, 2, 3]" + result `shouldBe` Aeson.object + [ ("data", Aeson.object + [ ("list", Aeson.Array $ V.fromList + [Aeson.Number 1, Aeson.Number 2, Aeson.Number 3]) + ]) + ] + + it "parses nested objects" $ do + result <- loadYAMLScript "nested:\n key: value" + result `shouldBe` Aeson.object + [ ("data", Aeson.object + [ ("nested", Aeson.object [("key", Aeson.String "value")]) + ]) + ] + +-- | Test YAMLScript functionality +yamlscriptTests :: Spec +yamlscriptTests = describe "YAMLScript Features" $ do + it "evaluates arithmetic expressions" $ do + result <- loadYAMLScript "!yamlscript/v0\nadd(2, 3)" + result `shouldBe` Aeson.object [("data", Aeson.Number 5)] + + it "evaluates function calls" $ do + result <- loadYAMLScript "!yamlscript/v0\ninc(41)" + result `shouldBe` Aeson.object [("data", Aeson.Number 42)] + +-- | Test error handling +errorTests :: Spec +errorTests = describe "Error Handling" $ do + it "returns error on invalid YAMLScript" $ do + result <- loadYAMLScript "!yamlscript/v0\ninvalid: syntax" + case result of + Aeson.Object obj -> case KeyMap.lookup (Key.fromString "error") obj of + Just _ -> return () -- Error present, test passes + Nothing -> expectationFailure "Expected error response" + _ -> expectationFailure "Expected JSON object" + + it "throws on missing file" $ do + (loadYAMLScriptFile "nonexistent.ys") `shouldThrow` anyException diff --git a/yamlscript.cabal b/yamlscript.cabal new file mode 100644 --- /dev/null +++ b/yamlscript.cabal @@ -0,0 +1,70 @@ +cabal-version: 3.0 +name: yamlscript +version: 0.2.1.0 +synopsis: Haskell bindings for YAMLScript +description: Haskell bindings for YAMLScript, a functional + programming language with YAML syntax. + . + YAMLScript allows you to add logic to your YAML files + while maintaining compatibility with standard YAML. +license: MIT +license-file: License +author: Ingy döt Net +maintainer: Ingy döt Net +category: Data, Text, YAML +homepage: https://yamlscript.org +bug-reports: https://github.com/yaml/yamlscript/issues +tested-with: GHC==9.4.7, GHC==9.6.3, GHC==9.8.1, GHC==9.12.1 + +library + exposed-modules: YAMLScript + other-modules: YAMLScript.FFI + build-depends: base >=4.17.0.0 && <5, + bytestring ^>=0.11.0.0, + text >=2.0.0.0 && <3, + aeson >=2.0.0.0 && <3, + unix >=2.7.0.0 && <3 + hs-source-dirs: lib + default-language: Haskell2010 + default-extensions: ForeignFunctionInterface + ghc-options: -Wall -Wcompat -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-export-lists + -Wmissing-home-modules + -Wpartial-fields + -Wredundant-constraints + -- XXX Not sure what to do here. cabal doesn't like relative paths. + -- Currently the Makefile copies the ../libys/lib to /tmp/libys/lib + -- Feels like there should be a better way to do this. + include-dirs: /tmp/libys/lib + extra-libraries: ys + extra-lib-dirs: /tmp/libys/lib + +executable yamlscript-test + main-is: Main.hs + build-depends: base >=4.17.0.0 && <5, + yamlscript, + text >=2.0.0.0 && <3, + aeson >=2.0.0.0 && <3, + aeson-pretty >=0.8.0.0 && <1, + bytestring ^>=0.11.0.0 + hs-source-dirs: test + default-language: Haskell2010 + ghc-options: -Wall + +test-suite yamlscript-tests + type: exitcode-stdio-1.0 + main-is: Test.hs + other-modules: YAMLScript.Tests + build-depends: base >=4.17.0.0 && <5, + yamlscript, + hspec >=2.8.0.0 && <3, + aeson >=2.0.0.0 && <3, + text >=2.0.0.0 && <3, + unix >=2.7.0.0 && <3, + vector >=0.13.0.0 && <1 + hs-source-dirs: test + default-language: Haskell2010 + ghc-options: -Wall +