Merge pull request #1143 from eilseq/tidal-parse-ffi

Enable Tidal-Parse FFI for Cross-Language Integration

Author: yaxu

cabal.project

@@ -1,2 +1,2 @@
 tests: True
-packages: ./ tidal-parse tidal-listener tidal-link
+packages: ./ tidal-parse tidal-parse-ffi tidal-listener tidal-link

tidal-parse-ffi/.gitignore

@@ -0,0 +1,23 @@
+dist
+dist-*
+cabal-dev
+*.o
+*.hi
+*.chi
+*.chs.h
+*.dyn_o
+*.dyn_hi
+.hpc
+.hsenv
+.cabal-sandbox/
+cabal.sandbox.config
+*.prof
+*.aux
+*.hp
+*.eventlog
+.stack-work/
+cabal.project.local
+cabal.project.local~
+.HTF/
+.ghc.environment.*
+dist-newstyle

tidal-parse-ffi/CHANGELOG.md

@@ -0,0 +1,17 @@
+# Changelog for tidal-parse-ffi
+
+## Unreleased
+
+### Added
+
+- FFI bindings for `tidal-parse`.
+- `cabal.project` integration.
+
+### Changed
+
+- Updated dependencies and metadata.
+- Performance improvements.
+
+### Fixed
+
+- Stability and bug fixes.

tidal-parse-ffi/LICENSE

@@ -0,0 +1,84 @@
+# tidal-parse-ffi
+
+`tidal-parse-ffi` is a Haskell library providing a Foreign Function Interface (FFI) for parsing Tidal patterns and exporting them to JSON format. It is designed to be used in conjunction with Rust and other languages via FFI.
+
+## Features
+
+- Exposes Haskell Tidal parsing functions through FFI.
+- Converts parsed patterns into JSON format.
+- Supports Rust integration via `libc`.
+
+## Dependencies
+
+- `tidal-parse`
+- `base`
+- `aeson`
+- `bytestring`
+- `containers`
+- `tidal`
+
+## Installation
+
+Clone the repository and navigate to the `tidal-parse-ffi` directory:
+
+```sh
+cd tidal-parse-ffi
+cabal build
+```
+
+## Usage
+
+Include `tidal-parse-ffi` as a dependency in your Cabal project:
+
+```cabal
+build-depends: tidal-parse-ffi
+```
+
+### Haskell Example
+
+```haskell
+import Foreign.C.String (newCString)
+main = do
+  result <- eval_pattern_c "[bd sn]"
+  putStrLn =<< peekCString result
+```
+
+## Rust Integration
+
+To use this library in Rust:
+
+1. Add the dependency to `Cargo.toml`:
+   ```toml
+   [dependencies]
+   tidal-parse-ffi = { path = "../tidal-parse-ffi" }
+   ```
+2. Link the library in `build.rs`:
+   ```rust
+   println!("cargo:rustc-link-lib=static=tidalparseffi");
+   ```
+
+### Rust Example
+
+```rust
+use std::ffi::{CString, CStr};
+use std::os::raw::c_char;
+
+extern "C" {
+    fn eval_pattern_c(input: *const c_char) -> *mut c_char;
+}
+
+fn main() {
+    let input = CString::new("[bd sn]").expect("CString::new failed");
+    unsafe {
+        let result_ptr = eval_pattern_c(input.as_ptr());
+        let result = CStr::from_ptr(result_ptr).to_string_lossy().into_owned();
+        println!("Parsed Pattern: {}", result);
+    }
+}
+```
+
+The library provides a single exported function:
+
+```haskell
+foreign export ccall eval_pattern_c :: CString -> IO CString
+```

tidal-parse-ffi/README.md

@@ -0,0 +1,90 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Sound.Tidal.Parse.FFI where
+
+import Foreign.C.String (CString, peekCString, newCString)
+import qualified Data.Aeson as Aeson
+import Data.Aeson (ToJSON(..), object, (.=))
+import qualified Data.ByteString.Lazy.Char8 as B
+import qualified Data.Map.Strict as Map
+import Data.Maybe (fromMaybe)
+import Text.Read (readMaybe)
+import GHC.Generics (Generic)
+
+import Sound.Tidal.Parse (parseTidal)
+import Sound.Tidal.Pattern
+import Sound.Tidal.Params ()
+import Sound.Tidal.Show ()
+
+-- Newtype wrappers to avoid orphan instances
+newtype JSONValue = JSONValue { unJSONValue :: Value }
+  deriving (Generic)
+
+instance ToJSON JSONValue where
+    toJSON (JSONValue (VS str)) = toJSON str
+    toJSON (JSONValue (VI i)) = toJSON i
+    toJSON (JSONValue (VF f)) = toJSON f
+    toJSON (JSONValue (VN num)) = toJSON $ show num
+    toJSON (JSONValue (VR r)) = toJSON $ show r
+    toJSON (JSONValue (VB b)) = toJSON b
+    toJSON (JSONValue (VX xs)) = toJSON xs
+    toJSON (JSONValue (VPattern pat)) = toJSON $ show pat
+    toJSON (JSONValue (VState f)) = toJSON $ show $ f Map.empty
+    toJSON (JSONValue (VList vs)) = toJSON $ map JSONValue vs
+
+newtype JSONArcF = JSONArcF (ArcF Rational)
+  deriving (Generic)
+
+instance ToJSON JSONArcF where
+    toJSON (JSONArcF (Arc arcStart arcStop)) =
+        object ["start" .= (realToFrac arcStart :: Double), 
+                "stop"  .= (realToFrac arcStop :: Double)]
+
+newtype JSONEventF = JSONEventF (Event (Map.Map String Value))
+  deriving (Generic)
+
+instance ToJSON JSONEventF where
+    toJSON (JSONEventF (Event _ctx evWhole evPart evValue)) =
+        object [ "whole"   .= fmap JSONArcF evWhole  -- Handle Maybe
+               , "part"    .= JSONArcF evPart
+               , "value"   .= fmap JSONValue evValue ]
+
+
+
+-- Foreign export wrapper function
+foreign export ccall eval_pattern_c :: CString -> CString -> IO CString
+eval_pattern_c :: CString -> CString -> IO CString
+eval_pattern_c cStr cArc = do
+    hsStr <- peekCString cStr
+    arcStr <- peekCString cArc
+    let arcLength = fromMaybe 16 (readMaybe arcStr :: Maybe Double)
+    result <- evalPattern hsStr arcLength
+    newCString result
+
+-- Function to evaluate and return pattern events as a JSON string
+evalPattern :: String -> Double -> IO String
+evalPattern pat arcLen = do
+    let parsedResult = parseAndQuery pat arcLen
+    return $ B.unpack $ Aeson.encode (either encodeError (encodeSuccess arcLen) parsedResult)
+
+encodeError :: String -> Aeson.Value
+encodeError err = Aeson.object ["error" Aeson..= err]
+
+encodeSuccess :: Double -> [Event (Map.Map String Value)] -> Aeson.Value
+encodeSuccess arcLen events = 
+    Aeson.object ["arcLen" .= arcLen, "events" .= map JSONEventF events]
+
+-- Helper functions to handle parsing and querying
+parseAndQuery :: String -> Double -> Either String [Event (Map.Map String Value)]
+parseAndQuery str arcLen =
+    case parseTidal str of
+        Left err -> Left (show err)
+        Right parsed -> 
+            let arcTime = toRational arcLen
+            in Right $ query (stripContext parsed) (State (Arc 0 arcTime) Map.empty)
+
+stripContext :: Pattern a -> Pattern a
+stripContext = setContext $ Context []

tidal-parse-ffi/src/Sound/Tidal/Parse/FFI.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Sound.Tidal.TidalParseFFITest where
+
+import Foreign.C.String (CString, peekCString, newCString)
+import Test.HUnit
+import Data.Aeson (Value, encode, object, (.=))
+import qualified Data.ByteString.Lazy.Char8 as B
+
+-- Foreign function import
+foreign import ccall "eval_pattern_c" eval_pattern_c :: CString -> CString -> IO CString
+
+-- Utility function to run FFI test
+ffiTest :: String -> String -> IO Bool
+ffiTest input arcLen = do
+    cInput <- newCString input 
+    cArcLen <- newCString arcLen 
+    resultPtr <- eval_pattern_c cInput cArcLen
+    result <- peekCString resultPtr
+    let expected = B.unpack $ encode mockJSON
+    return (result == expected)
+
+-- Mock the exact expected JSON output
+mockJSON :: Value
+mockJSON = object
+    [ "arcLen" .= (1 :: Int)
+    , "events" .= 
+        [ object [
+                 "part" .= object ["start" .= (0 :: Double), "stop" .= (0.5 :: Double)]
+                 , "value" .= object ["s" .= ("bd" :: String)]
+                 , "whole" .= object ["start" .= (0 :: Double), "stop" .= (0.5 :: Double)]
+                 ]
+        , object [
+                 "part" .= object ["start" .= (0.5 :: Double), "stop" .= (1 :: Double)]
+                 , "value" .= object ["s" .= ("cd" :: String)]
+                 , "whole" .= object ["start" .= (0.5 :: Double), "stop" .= (1 :: Double)]
+                 ]
+        ]
+    ]
+
+-- Test case with the mocked JSON output
+testFullPattern :: Test
+testFullPattern = TestCase $ do
+    result <- ffiTest "s $ \"bd cd\"" "1"
+    assertBool "Full pattern 's $ \"bd cd\"' should return the expected JSON" result

tidal-parse-ffi/test/Sound/Tidal/TidalParseFFITest.hs

@@ -0,0 +1,7 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Test.HUnit
+import Sound.Tidal.TidalParseFFITest (testFullPattern)
+
+main :: IO Counts
+main = runTestTT $ TestList [testFullPattern]

tidal-parse-ffi/test/Test.hs

@@ -0,0 +1,46 @@
+name:               tidal-parse-ffi
+
+license:            GPL-3
+license-file:       LICENSE
+extra-doc-files:    CHANGELOG.md, README.md
+
+version:            0.1.0
+build-type:         Simple
+cabal-version:      >=1.10
+
+library
+  exposed-modules:  Sound.Tidal.Parse.FFI
+  default-language: Haskell2010
+
+  ghc-options:      -Wall
+  hs-source-dirs:   src
+
+  Build-depends:
+      base
+    , containers
+    , tidal-parse 
+    , tidal 
+    , aeson 
+    , bytestring 
+    , vector
+
+test-suite tests
+  type:             exitcode-stdio-1.0
+  main-is:          Test.hs
+  hs-source-dirs:   test
+  ghc-options:      -Wall
+  other-modules:    Sound.Tidal.TidalParseFFITest
+  build-depends:
+      base
+    , containers
+    , tidal-parse-ffi
+    , tidal-parse
+    , tidal
+    , aeson
+    , bytestring
+    , HUnit
+    , vector
+
+source-repository head
+  type:             git
+  location:         https://github.com/tidalcycles/tidal-parse-ffi

tidal-parse-ffi/tidal-parse-ffi.cabal

@@ -26,7 +26,7 @@ library
   default-language:    Haskell2010
 
   Exposed-modules:     Sound.Tidal.Parse
-  other-modules: Sound.Tidal.Parse.TH
+  other-modules:       Sound.Tidal.Parse.TH
 
   Build-depends:
       base >=4.8 && <5