Created
December 30, 2015 01:04
-
-
Save ulyssesdotcodes/da9a7348fe3ecd972fd7 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# LANGUAGE OverloadedStrings #-} | |
| {-# LANGUAGE NoImplicitPrelude #-} | |
| {-# OPTIONS_GHC -fno-warn-orphans #-} | |
| module AesonOSC where | |
| import BasePrelude hiding (readMaybe) | |
| import Data.Aeson | |
| import Data.Aeson.Types | |
| import Sound.OSC.Type | |
| import Data.Vector ((!?)) | |
| import qualified Data.ByteString.Lazy as BSL | |
| import qualified Data.ByteString.Char8 as BSC | |
| import qualified Data.Vector as Vector | |
| foo :: BSL.ByteString | |
| foo = "[\"#bundle\",{\"timestamp\":0.0},[\"/c_set\",3,4.5],[\"/n_free\",0]]" | |
| (.!) :: FromJSON a => Array -> Int -> Parser a | |
| v .! ix = case v !? ix of | |
| Just a -> | |
| parseJSON a | |
| Nothing -> | |
| fail ("No such index " <> show ix <> " in vector " <> show v) | |
| -- | This differs from decode_datum in that it always parses numbers | |
| -- to a Float. | |
| instance FromJSON Datum where | |
| parseJSON (Object o) = | |
| parseBlob <|> parseMidi <|> parseTimestamp | |
| where | |
| parseBlob = | |
| Blob . BSL.pack <$> o .: "blob" | |
| parseMidi = do | |
| [p, q, r, s] <- o .: "midi" | |
| return (midi (p, q, r, s)) | |
| parseTimestamp = | |
| TimeStamp <$> (o .: "timestamp") | |
| parseJSON whole@(Number _) = | |
| Float <$> parseJSON whole | |
| parseJSON whole@(String _) = | |
| string <$> parseJSON whole | |
| parseJSON invalid = | |
| typeMismatch "Datum" invalid | |
| instance ToJSON Datum where | |
| toJSON d = | |
| case d of | |
| Blob b -> object [ ("blob", toJSON $ BSL.unpack b)] | |
| Midi m -> object [ ("midi", toJSON $ encodeMidi m)] | |
| TimeStamp t -> object ["timestamp" .= t] | |
| Int32 n -> toJSON n | |
| Int64 n -> toJSON n | |
| Float n -> toJSON n | |
| Double n -> toJSON n | |
| ASCII_String s -> toJSON $ BSC.unpack s | |
| where | |
| encodeMidi (MIDI p q r s) = map toJSON [p,q,r,s] | |
| instance FromJSON Bundle where | |
| parseJSON (Array v) = do | |
| b' <- v .! 0 | |
| timestamp <- v .! 1 | |
| guard (b' == String "#bundle") | |
| Bundle <$> (timestamp .: "timestamp") <*> traverse parseMessages (toList (Vector.drop 2 v)) | |
| where | |
| parseMessages (Array w) = do | |
| addr <- w .! 0 | |
| Message <$> parseJSON addr <*> traverse parseJSON (toList (Vector.drop 1 w)) | |
| parseMessages invalid = | |
| typeMismatch "Bundle' messages" invalid | |
| parseJSON invalid = | |
| typeMismatch "Bundle'" invalid | |
| instance ToJSON Bundle where | |
| toJSON (Bundle t m) = do | |
| let b = toJSON ("#bundle" :: String) | |
| let t' = toJSON t | |
| let m' = map encodeMessage m | |
| toJSON (b : t' : m') | |
| where | |
| encodeMessage (Message a d) = | |
| let a' = toJSON a | |
| d' = map toJSON d | |
| in toJSON (a' : d') |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment