vivid-osc (empty) → 0.3.0.0
raw patch · 7 files changed
+1202/−0 lines, 7 filesdep +basedep +binarydep +bytestringsetup-changed
Dependencies added: base, binary, bytestring, cereal, microspec, time, vivid-osc
Files
- LICENSE +339/−0
- Setup.hs +2/−0
- Vivid/OSC.hs +283/−0
- Vivid/OSC/Old.hs +178/−0
- Vivid/OSC/Old/Util.hs +43/−0
- test/Test.hs +245/−0
- vivid-osc.cabal +112/−0
+ LICENSE view
@@ -0,0 +1,339 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Lesser General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License along+ with this program; if not, write to the Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Lesser General+Public License instead of this License.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Vivid/OSC.hs view
@@ -0,0 +1,283 @@+-- | Open Sound Control data++{-# OPTIONS_HADDOCK show-extensions #-}++{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-# LANGUAGE NoRebindableSyntax #-}+{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.OSC (+ OSC(..)+ , OSCDatum(..)++ , encodeOSC+ , decodeOSC++ , Timestamp(..)+ , OSCBundle(..)++ , encodeOSCBundle+ , decodeOSCBundle++ , encodeTimestamp+ , utcToTimestamp+ -- , timestampToUTC++ , addSecs+ , diffTimestamps++ , encodeOSCDatum++ -- , decodeOSCDatumWithPadding+ -- , decodeOSCData++ -- Testing/internals:+ , putOSC+ , putOSCString+ , putOSCDatum+ , getOSCString+ , getOSC+ , putOSCBlob+ , getOSCBlob+ , getOSCTimestamp+ , putOSCTimestamp++ , putOSCBundle+ , getOSCBundle+ , runGetWithNoLeftover++ -- Only need for testing old<->new+ , toTypeChar+ , alignTo4'+ ) where++-- import Control.DeepSeq (NFData, rnf)+import Control.Monad+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8 (unpack)+import Data.Int (Int32)+import Data.Monoid+import Data.Serialize hiding (encode, decode, runGet)+-- import Data.Serialize.IEEE754+import qualified Data.Serialize.Get as Get+import Data.Time (UTCTime(..), fromGregorian, secondsToDiffTime, diffUTCTime)++-- | An OSC message, e.g.+-- +-- > OSC "/n_free" [OSC_I 42]+data OSC+ = OSC ByteString [OSCDatum]+ deriving (Show, Read, Eq, Ord)++data OSCDatum+ = OSC_I Int32+ | OSC_S ByteString+ | OSC_F Float+ | OSC_D Double -- ^ This isn't a base type in the OSC standard but the+ -- scsynth response message from "/status" uses it...+{-+ | OSC_I8 Int8+ | OSC_I16 Int16+-}+ | OSC_B ByteString+ | OSC_T Timestamp -- ^ From the OSC 1.1 spec+ deriving (Show, Read, Eq, Ord)++-- | This is stored as the number of seconds since Jan 1 1900. You can get+-- it with 'Vivid.Actions.Class.getTime'+newtype Timestamp = Timestamp Double+ deriving (Show, Read, Eq, Ord)++-- | TODO: a Bundle can also contain other bundles, recursively+data OSCBundle+ = OSCBundle Timestamp [Either ByteString OSC]+ deriving (Show, Read, Eq)++toTypeChar :: OSCDatum -> ByteString+toTypeChar = \case+ OSC_I _ -> "i"+ OSC_S _ -> "s"+ OSC_F _ -> "f"+ OSC_B _ -> "b"+ OSC_D _ -> "d"+ OSC_T _ -> "t"++-- formerly known as 'someShit':+-- TODO: if sometimes encoding can fail (e.g. if a string contains a '\NUL'), we+-- should really have a (Either String) situation (and same for 'encodeOSCDatum'):+encodeOSC :: OSC -> ByteString+encodeOSC o = runPut (putOSC o)++putOSC :: OSC -> Put+putOSC (OSC path args) = do+ putOSCString path+ putOSCString $ "," <> BS.concat (map toTypeChar args)+ mapM_ putOSCDatum args++encodeOSCDatum :: OSCDatum -> ByteString+encodeOSCDatum = runPut . putOSCDatum++putOSCDatum :: OSCDatum -> Put+putOSCDatum = \case+ OSC_S s -> putOSCString s+ OSC_I i -> putInt32be i+ OSC_F f -> putFloat32be f+ OSC_D d -> putFloat64be d+ OSC_T t -> putOSCTimestamp t+ OSC_B b -> putOSCBlob b++putOSCString :: ByteString -> Put+putOSCString s = do+ -- There must be at least one \NUL byte:+ putByteString $ padTo4Bytes (s<>"\NUL")++getOSCString :: Get ByteString+getOSCString = do+ -- There may be a more efficient way to do this:+ first <- BS.takeWhile (/= 0) <$> getByteString 4+ case BS.length first of+ 4 -> do+ (first <>) <$> getOSCString+ -- Note we've already discarded the ending '\NUL' padding:+ _ -> pure first++-- | Add '\NUL' characters to the end of a ByteString until its length is+-- a multiple of 4+-- TODO: make this be a 'Put' and just get like the 'seek' count so we don't have to traverse it twice:+padTo4Bytes :: ByteString -> ByteString+padTo4Bytes b = b <> BS.replicate (alignTo4' (BS.length b)) 0++putOSCBlob :: ByteString -> Put+putOSCBlob bs = do+ -- Note: should probably really be word:+ putInt32be $ toEnum $ BS.length bs+ -- The only reason we don't account for the prefixed length is that's+ -- always 4 bytes long so it won't affect the padding:+ putByteString $ padTo4Bytes bs++getOSCBlob :: Get ByteString+getOSCBlob = do+ size <- fromEnum <$> getInt32be+ b <- getByteString size+ _ <- getByteString (alignTo4' size) -- TODO; 'seek' instead?+ pure b++decodeOSC :: ByteString -> Either String OSC+decodeOSC = runGet getOSC++getOSC :: Get OSC+getOSC = do+ path <- getOSCString+ -- For example, ",issifbt":+ (comma:typeDesc) <- BS8.unpack <$> getOSCString+ when (comma /= ',') $ fail "Malformed OSC!"+ values <- forM typeDesc $ \case+ 's' -> OSC_S <$> getOSCString+ 'i' -> OSC_I <$> getInt32be+ 'f' -> OSC_F <$> getFloat32be+ 't' -> OSC_T <$> getOSCTimestamp+ 'd' -> OSC_D <$> getFloat64be+ 'b' -> OSC_B <$> getOSCBlob+ c -> fail $ "Unrecognized character: " ++ show c+ pure (OSC path values)++encodeOSCBundle :: OSCBundle -> ByteString+encodeOSCBundle b = runPut (putOSCBundle b)++putOSCBundle :: OSCBundle -> Put+putOSCBundle (OSCBundle time messages) = do+ putByteString "#bundle\NUL"+ putOSCTimestamp time+ forM_ messages $ \message -> do+ let encoded = case message of+ Left b -> b+ -- TODO: Doesn't feel right that i have a 'runPut' inside a 'Put':+ Right osc -> runPut $ putOSC osc+ putWord32be $ toEnum $ BS.length encoded+ putByteString encoded++decodeOSCBundle :: ByteString -> Either String OSCBundle+decodeOSCBundle = runGet getOSCBundle++getOSCBundle :: Get OSCBundle+getOSCBundle = do+ let prefix = "#bundle\NUL"+ pre <- getByteString (BS.length prefix)+ when (pre /= prefix) $+ fail "Wrong header"+ ts <- getOSCTimestamp+ messages <- getListTillEnd $ do+ len <- fromEnum <$> getWord32be+ Right <$> isolate len getOSC+ pure $ OSCBundle ts messages++-- There might be a more efficient way to write this?:+getListTillEnd :: Get x -> Get [x]+getListTillEnd getAction = isEmpty >>= \case+ True -> pure []+ False -> do+ r <- getAction+ (r:) <$> getListTillEnd getAction++encodeTimestamp :: Timestamp -> ByteString+encodeTimestamp t = runPut (putOSCTimestamp t)++putOSCTimestamp :: Timestamp -> Put+putOSCTimestamp (Timestamp t) =+ putWord64be $ round $ t * 2^(32::Int)++getOSCTimestamp :: Get Timestamp+getOSCTimestamp = do+ w <- {- realToFrac -} fromIntegral <$> getWord64be+ pure $ Timestamp $ w / 2 ** 32 -- (2^(32::Int))++utcToTimestamp :: UTCTime -> Timestamp+utcToTimestamp utcTime =+ let startOfTheCentury =+ UTCTime (fromGregorian 1900 1 1) (secondsToDiffTime 0)+ in Timestamp . realToFrac $ diffUTCTime utcTime startOfTheCentury++_timestampToUTC :: Timestamp -> UTCTime+_timestampToUTC = undefined++addSecs :: Timestamp -> Double -> Timestamp+addSecs (Timestamp t) secs = Timestamp (t + secs)++diffTimestamps :: Timestamp -> Timestamp -> Double+diffTimestamps (Timestamp t1) (Timestamp t0) = t1 - t0++{-+instance NFData OSCDatum where+ rnf (OSC_I x) = rnf x+ rnf (OSC_F x) = rnf x+ rnf (OSC_S x) = rnf x+{-+ rnf (OSC_I8 x) = rnf x+ rnf (OSC_I16 x) = rnf x+-}+ rnf (OSC_B x) = rnf x+-}++-- Makes sure we've consumed all input:+runGet :: Get a -> ByteString -> Either String a+runGet g = Get.runGet $ do+ x <- g+ isEmpty >>= \case+ True -> pure x+ False -> fail $ "Leftover bytes #2"++-- With an exportable name:+runGetWithNoLeftover :: Get a -> ByteString -> Either String a+runGetWithNoLeftover = runGet++-- Everything in OSC has to be a multiple of 4 bytes, so this is handy:+alignTo4' :: Integral i => i -> i+alignTo4' n = (4 - (n `rem` 4)) `mod` 4+
+ Vivid/OSC/Old.hs view
@@ -0,0 +1,178 @@+-- | An older implementation of the spec. I provide it here, and several+-- tests, to show that the new code behaves the same. Will be removed soon.++{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Vivid.OSC.Old (+ encodeOSC+ , encodeOSCDatum+ , encodeOSCBundle+ , encodeTimestamp++ , encodedOSC_addLength++ , decodeOSCData+ , decodeOSC+ , decodeOSCDatumWithPadding+ ) where++import Vivid.OSC (OSCDatum(..), Timestamp(..), OSC(..), OSCBundle(..), toTypeChar)+import Vivid.OSC.Old.Util++import Data.Binary (encode, decode)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as BSL+import Data.Int+import Data.Monoid+import Data.Word++encodeOSC :: OSC -> ByteString+encodeOSC (OSC url args) = BSL.toStrict $ BSL.concat $ [+ encodeOSCDatum (OSC_S url)+ ,encodeOSCDatum (OSC_S ("," <> BS.concat (map toTypeChar args)))+ ] <> map encodeOSCDatum args++encodeOSCDatum :: OSCDatum -> BSL.ByteString+encodeOSCDatum = \case+ OSC_I i -> encode i+ OSC_S s -> BSL.fromStrict $+ s <> BS.replicate (align (BS.length s + 1) + 1) 0+ OSC_F f -> encode $ floatToWord f+ OSC_D d -> encode $ doubleToWord d+ OSC_T timestamp ->+ BSL.fromStrict $ encodeTimestamp timestamp+ OSC_B b -> mconcat [+ -- 4 bytes which describe the size of the blob:+ encode (fromIntegral (BS.length b) :: Int32)+ -- the blob itself:+ , BSL.fromStrict b+ -- padding:+ , BSL.fromStrict (BS8.pack (replicate (align (BS.length b)) '\NUL'))+ ]++encodeOSCBundle :: OSCBundle -> ByteString+encodeOSCBundle (OSCBundle time messages) = mconcat [+ "#bundle\NUL"+ , encodeTimestamp time+ , (mconcat . map (encodedOSC_addLength . either id encodeOSC)) messages+ ]++encodeTimestamp :: Timestamp -> ByteString+encodeTimestamp (Timestamp time) =+ BSL.toStrict $ encode $ (round (time * 2^(32::Int)) :: Word64)+++encodedOSC_addLength :: ByteString -> ByteString+encodedOSC_addLength bs =+ BSL.toStrict (encode (toEnum (BS.length bs) :: Word32)) <> bs+++numBytesWithoutPadding :: Char -> ByteString -> Either String Int+numBytesWithoutPadding char b = case char of+ 'i' -> Right 4+ 'f' -> Right 4+ 't' -> Right 4+ 'd' -> Right 8+ 's' -> case BS.elemIndex 0 $ b of+ Just x -> Right $ fromIntegral x+ Nothing -> Left $ "weirdness on " <> show b+ 'b' -> Right . fromIntegral $+ (decode $ BSL.fromStrict $ BS.take 4 b :: Int32)+ c ->+ Left $ "vivid: unknown OSC character " <> show c <> ": " <> show b++numBytesWithPadding :: Char -> ByteString -> Either String Int+numBytesWithPadding char b = case char of+ 'i' -> Right 4+ 'f' -> Right 4+ 't' -> Right 4+ 'd' -> Right 8+ 's' ->+ case numBytesWithoutPadding 's' b of+ Right nb ->+ let n = nb + 1+ in Right $ n + align n+ Left e -> Left e+ 'b' ->+ case numBytesWithoutPadding 'b' b of+ Right nb -> Right $ nb + align nb + 4+ Left e -> Left e+ c ->+ Left $ "vivid: unknown OSC character " <> show c <> ": " <> show b++decodeOSCData :: [Char] -> ByteString -> Either String [OSCDatum]+decodeOSCData typeChars blob = case (typeChars, blob) of+ ([], "") -> Right []+ ([], leftover) -> Left $ "leftover bytes: " <> show leftover+ (_:_, "") -> Left $ "leftover typechars:" <> show typeChars+ (t:ypes, _) ->+ case (datum, rest) of+ (Right a, Right b) -> Right (a:b)+ (Right _, Left b) -> Left b+ (Left a, Right _) -> Left a+ (Left a, Left b) -> Left $ a ++ ", " ++ b+ where+ datum :: Either String OSCDatum+ datum = case thisBlob of+ Right b -> decodeOSCDatumWithPadding t b+ Left e -> Left e+ thisBlob :: Either String ByteString+ thisBlob = case numBytesWithPadding t blob of+ Right nb -> Right $ BS.take nb blob+ Left e -> Left e+ rest :: Either String [OSCDatum]+ rest = case numBytesWithPadding t blob of+ Right nb -> decodeOSCData ypes (BS.drop nb blob)+ Left e -> Left e++decodeOSC :: ByteString -> Either String OSC+decodeOSC b = case sizeAndStorage b of+ Left e -> Left e+ Right (sizeOfURL, storageOfURL) ->++ let (urlWithPad, allButURL) = BS.splitAt storageOfURL b+ url = BS.take sizeOfURL urlWithPad+ in case sizeAndStorage allButURL of+ Left e -> Left e+ -- typeDesc is like ",issif"+ Right (sizeOfTypeDesc, storageOfTypeDesc) ->+ case BS8.unpack $ BS.take sizeOfTypeDesc allButURL of+ (',':typeDesc) ->+ let rest = BS.drop (storageOfURL + storageOfTypeDesc) $ b+ in case decodeOSCData typeDesc rest of+ Right decoded -> Right $ OSC url decoded+ Left e -> Left e+ other -> Left $ "not understood: " ++ show other+ where+ sizeAndStorage :: ByteString -> Either String (Int, Int)+ sizeAndStorage bs =+ case (numBytesWithoutPadding 's' bs, numBytesWithPadding 's' bs) of+ (Right size, Right storage) -> Right (size, storage)+ (Left e0, Left e1) -> Left $ e0 ++ ", " ++ e1+ (Left e, _) -> Left e+ (_, Left e) -> Left e++decodeOSCDatumWithPadding :: Char -> ByteString -> Either String OSCDatum+decodeOSCDatumWithPadding char b = case char of+ 'i' ->+ Right $ OSC_I $ decode $ BSL.fromStrict b+ 'f' ->+ Right $ OSC_F $ wordToFloat $ decode $ BSL.fromStrict b+ 's' ->+ case numBytesWithoutPadding 's' b of+ Right nb -> Right $ OSC_S $ BS.take nb b+ Left e -> Left e+ 'b' ->+ case numBytesWithoutPadding 'b' b of+ Right nb -> Right $ OSC_B $ BS.take nb $ BS.drop 4 b+ Left e -> Left e+ 'd' ->+ Right $ OSC_D $ wordToDouble $ decode $ BSL.fromStrict b+ 't' ->+ Right $ OSC_T $ Timestamp $ (/(2^(32::Int))) $ realToFrac $+ (decode $ BSL.fromStrict b :: Word64)+ c ->+ Left $ "unknown character " <> show c <> ": " <> show b
+ Vivid/OSC/Old/Util.hs view
@@ -0,0 +1,43 @@+{-# OPTIONS_HADDOCK show-extensions #-}++{-# LANGUAGE NoRebindableSyntax #-}+{-# LANGUAGE NoIncoherentInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE NoUndecidableInstances #-}++module Vivid.OSC.Old.Util (+ align+ , floatToWord+ , wordToFloat+ , doubleToWord+ , wordToDouble+ ) where++import Data.Bits ((.&.), complement, Bits)+import qualified Foreign as F+import System.IO.Unsafe (unsafePerformIO)++-- from hosc:+align :: (Num i,Bits i) => i -> i+{-# INLINE align #-}+align n = ((n + 3) .&. complement 3) - n++-- from data-binary-ieee754:+floatToWord :: Float -> F.Word32+floatToWord = coercionThing++wordToFloat :: F.Word32 -> Float+wordToFloat = coercionThing++doubleToWord :: Double -> F.Word64+doubleToWord = coercionThing++wordToDouble :: F.Word64 -> Double+wordToDouble = coercionThing+++coercionThing :: (F.Storable a, F.Storable b) => a -> b+coercionThing x = unsafePerformIO $ F.alloca $ \buf -> do+ F.poke (F.castPtr buf) x+ F.peek buf+
+ test/Test.hs view
@@ -0,0 +1,245 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import Data.Serialize hiding (runGet)+-- import Data.Serialize.Get hiding (runGet)+-- import qualified Data.Serialize.Get as Get+-- import Data.Serialize.Put+import Data.Time+import Data.Word++import Test.Microspec++import Vivid.OSC+import Vivid.OSC.Old.Util+import qualified Vivid.OSC.Old as Old++main :: IO ()+main = microspec $ do+ describe ".utils" $ do+ describe "float->word->float" $ \f ->+ wordToFloat (floatToWord f) === f+ describe "word->float->word" $ \w ->+ floatToWord (wordToFloat w) === w+ describe "double->word->double" $ \d ->+ wordToDouble (doubleToWord d) === d+ describe "word->Double->word" $ \w ->+ doubleToWord (wordToDouble w) === w+ describe "align == align'" $ \i ->+ alignTo4' (i :: Int) === align i+ describe "OSC types" $ do+ describe "OSC Datum" $ do+ it "newPutOSCdatum == oldPutOSCdatum" $ do+ \d -> BSL.toStrict (Old.encodeOSCDatum d) == encodeOSCDatum d+ {-+ - Problem is we don't have type tag; not high priority because+ - we test it in 'getOSC/putOSC' etc:+ it "getOSCDatum . putOSCDatum" $ \oldD ->+ let Right newD = runGet getOSCDatum (runPut $ putOSCDatum o)+ in datumEq newD oldD+ -}++ it "timestamps: old encode . decode" $+ \(Positive t) ->+ let ts = Timestamp t+ encoded = BSL.toStrict $ Old.encodeOSCDatum $ OSC_T ts+ Right (OSC_T t') = Old.decodeOSCDatumWithPadding 't' encoded+ in ts `timestampEq` t'++ describe "examples from the OSC 1.0 spec" $ do+ it "example 1" $ do+ Old.encodeOSCDatum (OSC_S "OSC")+ === BSL.pack (map (toEnum . fromEnum) ['O','S','C', '\NUL'])+ it "example 1, new" $ do+ encodeOSCDatum (OSC_S "OSC")+ === BS.pack (map (toEnum . fromEnum) ['O','S','C', '\NUL'])+ it "example 2" $ do+ Old.encodeOSCDatum (OSC_S "data")+ === BSL.pack (map (toEnum . fromEnum) ("data"++replicate 4 '\NUL'))+ it "example 2, new" $ do+ encodeOSCDatum (OSC_S "data")+ === BS.pack (map (toEnum . fromEnum) ("data"++replicate 4 '\NUL'))+++ describe "the OSC type" $ do+ it "olddecode . oldencode" $ \(OSC a bs) ->+ -- My old decoding of timestamps was fucked up!:+ let oldO = OSC a $ filter (\case { OSC_T _ -> False ; _ -> True }) bs+ in Old.decodeOSC (Old.encodeOSC oldO) === Right oldO+ it "new encode == old encode" $ \o ->+ encodeOSC o === Old.encodeOSC o+ it "decode . encode" $ \o ->+ let Right new = decodeOSC (encodeOSC o)+ in oscEq new o+ describe "examples from the OSC 1.0 spec" $ do+ it "example 1" $+ encodeOSC (OSC "/oscillator/4/frequency" [OSC_F 440.0])+ === BS.pack [+ 0x2f, 0x6f, 0x73, 0x63+ , 0x69, 0x6c, 0x6c, 0x61+ , 0x74, 0x6f, 0x72, 0x2f+ , 0x34, 0x2f, 0x66, 0x72+ , 0x65, 0x71, 0x75, 0x65+ , 0x6e, 0x63, 0x79, 0x00+ , 0x2c, 0x66, 0x00, 0x00+ , 0x43, 0xdc, 0x00, 0x00+ ]+ it "example 2" $+ let cmd = OSC "/foo" [OSC_I 1000, OSC_I (-1), OSC_S "hello", OSC_F 1.234, OSC_F 5.678]+ out = BS.pack [+ 0x2f, 0x66, 0x6f, 0x6f+ , 0x00, 0x00, 0x00, 0x00+ , 0x2c, 0x69, 0x69, 0x73+ , 0x66, 0x66, 0x00, 0x00+ , 0x00, 0x00, 0x03, 0xe8+ , 0xff, 0xff, 0xff, 0xff+ , 0x68, 0x65, 0x6c, 0x6c+ , 0x6f, 0x00, 0x00, 0x00+ , 0x3f, 0x9d, 0xf3, 0xb6+ , 0x40, 0xb5, 0xb2, 0x2d+ ]+ in encodeOSC cmd === out+ describe "OSCBundle" $ do+ it "newDecode . newEncode" $ \t xs ->+ let oldB = OSCBundle t (map Right xs)+ Right newB = decodeOSCBundle (encodeOSCBundle oldB)+ in bundleEq newB oldB+ it "oldEncode === newEncode" $ \b ->+ Old.encodeOSCBundle b === encodeOSCBundle b+ describe "bijections" $ do+ it "getOSC . putOSC" $ \origOSC ->+ let Right newOSC = decodeOSC (encodeOSC origOSC)+ in oscEq newOSC origOSC+ it "putOSCString vs old" $ \(NonNullBS s) ->+ runPut (putOSCString s) === BSL.toStrict (Old.encodeOSCDatum (OSC_S s))+ describe "getString . putString" $ \(NonNullBS s) ->+ runGet getOSCString (runPut (putOSCString s)) === Right s+ it "decodetimestamp . encodetimestamp" $ \t ->+ fromRight (runGet getOSCTimestamp (runPut (putOSCTimestamp t))) `timestampEq` t+ it "oldencode timestamp == new encode" $ \t ->+ runPut (putOSCTimestamp t) === Old.encodeTimestamp t+ it "encodeOSC isRight (with the valid input we generate)" pending+ describe "binary blobs" $ do+ it "decode . encode" $ \(BS.pack -> b) ->+ runGet getOSCBlob (runPut (putOSCBlob b)) === Right b+ describe "decodeOSCdatumswithpadding == getOSCDatum" pending+ describe "unit tests - a few examples for each function" $ do+ describe "putOSCDatum" $ do+ describe "OSC_S" $ do+ it "pads an extra 4 when it's already a multiple of 4" $+ encodeOSCDatum (OSC_S "four") === "four\NUL\NUL\NUL\NUL"+ describe "do this for every function" pending+ describe "more manual test cases" pending+-- binary up to the mazimum size+-- very large and very small floats+-- NaNs and (+/-)Infinity (floats and doubles)+-- Huge numbers of variants+-- Some example times to parse+-- Some example numbers to parse+++ describe "timestamp" $ do+ it "timestamp->utc" $ pending -- \t ->+ -- utcToTimestamp (timestampToUTC t) === t+ it "utc->timestamp" $ pending -- \u ->+ -- timestampToUTC (utcToTimestamp u) === u++fromRight :: Show e => Either e x -> x+fromRight = \case+ Right x -> x+ Left e -> error $ show e++-- TODO: generic-random:+instance Arbitrary OSCDatum where+ arbitrary = oneof [+ OSC_I <$> arbitrary++ -- Note no 0: OSC strings cannot contain the null character:+ , OSC_S <$> nonNullBS+ , OSC_F <$> arbitrary+ , OSC_D <$> arbitrary+ , (OSC_B . BS.pack) <$> arbitrary+ , OSC_T <$> arbitrary+ ]++nonNullBS :: Gen ByteString+nonNullBS = BS.pack <$> listOf (choose (1, maxBound :: Word8))++newtype NonNullBS = NonNullBS ByteString+ deriving (Show)++instance Arbitrary NonNullBS where+ arbitrary = NonNullBS <$> nonNullBS++instance Arbitrary Timestamp where+ -- Note cannot be negative:+ arbitrary = (Timestamp . getNonNegative) <$> arbitrary++instance Arbitrary OSC where+ arbitrary = OSC+ <$> nonNullBS -- Again no '\NUL'+ <*> arbitrary++instance Arbitrary OSCBundle where+ arbitrary = OSCBundle+ <$> arbitrary+ <*> listOf (oneof [+ -- TODO:+ -- (Left . BS.pack) <$> arbitrary -- todo: maybe needs to be padded?+ Right <$> arbitrary -- type inference is nice!+ ])++instance Arbitrary UTCTime where+ arbitrary = undefined++-- TODO: do we need this? is there a way to encode timestamps non-lossily?:+-- I would also love to get rid of this whole thing:+timestampEq :: Timestamp -> Timestamp -> Bool+timestampEq (Timestamp time0) (Timestamp time1) =+ abs (time0 - time1) < 0.0000001++datumEq :: OSCDatum -> OSCDatum -> Bool+datumEq a b = case (a, b) of+ (OSC_T t0, OSC_T t1) -> timestampEq t0 t1+ _ -> a == b++oscEq :: OSC -> OSC -> Bool+oscEq (OSC p0 args0) (OSC p1 args1) =+ (p0 == p1) && argsMatch args0 args1+ where+ argsMatch [] [] = True+ argsMatch [] (_:_) = False+ argsMatch (_:_) [] = False+ argsMatch (d0:rest0) (d1:rest1) =+ datumEq d0 d1 && argsMatch rest0 rest1++bundleEq :: OSCBundle -> OSCBundle -> Bool+bundleEq (OSCBundle t0 msgs0) (OSCBundle t1 msgs1) =+ timestampEq t0 t1 && msgsMatch msgs0 msgs1+ where+ msgsMatch [] [] = True+ msgsMatch [] (_:_) = False+ msgsMatch (_:_) [] = False+ msgsMatch (Right msg0:rest0) (Right msg1:rest1) =+ oscEq msg0 msg1 && msgsMatch rest0 rest1+ msgsMatch (Left msg0:rest0) (Left msg1:rest1) =+ (msg0 == msg1) && msgsMatch rest0 rest1+ -- This is the case where one is 'Left' and one is 'Right'.+ -- We could hypothetically test if they're equal.+ msgsMatch (_:_rest0) (_:_rest1) = False+{-+ msgsMatch (Left l:rest0) (Right r:rest1) =+ rightMatchesLeft l r+ msgsMatch (Right r:rest0) (Left l:rest1) =+ rightMatchesLeft l r++-- This is not ideal, using the encoding functions to test them+rightMatchesLeft :: Left ByteString -> Right OSC -> Bool+-}+runGet :: Get a -> ByteString -> Either String a+runGet = runGetWithNoLeftover+
+ vivid-osc.cabal view
@@ -0,0 +1,112 @@+name: vivid-osc+version: 0.3.0.0+synopsis: Open Sound Control encode/decode+description:+ A small, simple, and well-tested implementation of the Open Sound Control+ message format.+ .+ Example usage:+ .+ @+ {-\# LANGUAGE OverloadedStrings \#-}+ @+ . + > import Network.Socket+ > import Network.Socket.ByteString as SB+ > + > import Vivid.OSC+ > + > main = do+ > -- Boring Network.Socket setup:+ > (a:_) <- getAddrInfo Nothing (Just "127.0.0.1") (Just "57120")+ > s <- socket (addrFamily a) Datagram defaultProtocol+ > connect s (addrAddress a)+ > + > -- The interesting part:+ > SB.send s $ encodeOSC $+ > OSC "/play2" [OSC_S "cps", OSC_I 1, OSC_S "s", OSC_S "bd"]++license: GPL+license-file: LICENSE+author: Tom Murphy+maintainer: Tom Murphy+category: Audio, Codec, Music, Sound++build-type: Simple+cabal-version: >=1.10+++library+ exposed-modules:+ Vivid.OSC+ , Vivid.OSC.Old+ , Vivid.OSC.Old.Util+ other-extensions:+ LambdaCase+ , OverloadedStrings+ , ViewPatterns+ , ScopedTypeVariables+ , NoRebindableSyntax+ , NoIncoherentInstances+ , NoMonomorphismRestriction+ , NoUndecidableInstances+ build-depends:++ base >3 && <5++ -- TODO: can remove when we remove .Old:+ -- Lower bound:+ -- Just a guess -- 0.5.0.2 is >5 years old+ -- I don't have a reason to think it needs a lower bound+ -- 0.2 is the oldest version on Hackage+ -- Upper bound:+ -- 0.9 doesn't exist yet+ -- Try: "> 0.5.0.2 && < 0.9"+ , binary+++ -- Lower bound:+ -- Just a guess -- 0.9.1.8 is >5 years old+ -- I don't have a reason to think it needs a lower bound+ -- 0.9 is the oldest version on Hackage+ -- Upper bound:+ -- 0.11 doesn't exist yet+ -- Try: "> 0.9.1.8 && < 0.11"+ , bytestring++ -- Lower bound:+ -- Guess: 0.4 is ~5 years old+ -- Upper bound:+ -- 0.6 doesn't exist yet+ -- Try: ">= 0.4 && < 0.6"+ , cereal++ -- Lower bound:+ -- Just a guess -- 1.2 is >5 years old+ -- I don't have a reason to think it needs a lower bound+ -- (Although check out 'old-time' and those changes -- but+ -- that's before 1.2)+ -- 1.0 is the oldest version on Hackage+ -- Upper bound:+ -- 1.7 doesn't exist yet+ -- Try: "&& < 1.7"+ , time >= 1.2++ default-language: Haskell2010+ ghc-options:+ -O2++test-suite vivid-osc-tests+ hs-source-dirs: test+ main-is: Test.hs+ type: exitcode-stdio-1.0+ build-depends:+ base+ , vivid-osc++ , bytestring+ , cereal+ -- Try: == 0.1+ , microspec+ , time+ default-language: Haskell2010