Skip to content

Commit

Permalink
Remove Cabal warnings
Browse files Browse the repository at this point in the history
  • Loading branch information
eilseq committed Feb 10, 2025
1 parent a9c6d3f commit ce5bdce
Show file tree
Hide file tree
Showing 4 changed files with 49 additions and 34 deletions.
5 changes: 5 additions & 0 deletions tidal-parse-ffi/CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
# Revision history for tidal-listener

## 0.1.0.0 -- YYYY-mm-dd

* First version. Released on an unsuspecting world.
74 changes: 42 additions & 32 deletions tidal-parse-ffi/src/Sound/Tidal/Parse/FFI.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Sound.Tidal.Parse.FFI where

Expand All @@ -10,39 +12,47 @@ import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Text.Read (readMaybe)
import Data.Ratio ((%))
import GHC.Generics (Generic)

import Sound.Tidal.Parse (parseTidal)
import Sound.Tidal.Context
import Sound.Tidal.Pattern (Value)
import Sound.Tidal.Show (show)

-- Ensure Tidal's `Value` is converted to JSON properly
instance ToJSON Value where
toJSON (VS s) = toJSON s
toJSON (VI i) = toJSON i
toJSON (VF f) = toJSON f
toJSON (VN n) = toJSON $ show n
toJSON (VR r) = toJSON $ show r
toJSON (VB b) = toJSON b
toJSON (VX xs) = toJSON xs
toJSON (VPattern pat) = toJSON $ show pat
toJSON (VState f) = toJSON $ show $ f Map.empty
toJSON (VList vs) = toJSON vs

-- JSON serialization for ArcF
instance (Real a) => ToJSON (ArcF a) where
toJSON (Arc start stop) =
object ["start" .= (realToFrac start :: Double),
"stop" .= (realToFrac stop :: Double)]

-- JSON serialization for EventF
instance (ToJSON a, ToJSON b) => ToJSON (EventF a b) where
toJSON (Event ctx whole part value) =
object [ "whole" .= whole
, "part" .= part
, "value" .= value
]
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
Expand All @@ -65,7 +75,7 @@ encodeError err = Aeson.object ["error" Aeson..= err]

encodeSuccess :: Double -> [Event (Map.Map String Value)] -> Aeson.Value
encodeSuccess arcLen events =
Aeson.object ["arcLen" .= arcLen, "events" .= 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)]
Expand Down
2 changes: 1 addition & 1 deletion tidal-parse-ffi/test/Sound/Tidal/TidalParseFFITest.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ module Sound.Tidal.TidalParseFFITest where

import Foreign.C.String (CString, peekCString, newCString)
import Test.HUnit
import Data.Aeson (Value, decode, encode, object, (.=))
import Data.Aeson (Value, encode, object, (.=))
import qualified Data.ByteString.Lazy.Char8 as B

-- Foreign function import
Expand Down
2 changes: 1 addition & 1 deletion tidal-parse-ffi/tidal-parse-ffi.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@ name: tidal-parse-ffi

license: GPL-3
license-file: LICENSE
Extra-source-files: README.md
extra-doc-files: CHANGELOG.md, README.md

version: 0.1.0
build-type: Simple
Expand Down

0 comments on commit ce5bdce

Please sign in to comment.