From f31a65bcd1642b3f042bd906674f4064cfc9362c Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 2 Aug 2016 22:42:52 +0200 Subject: Inital work on option parsing --- src/Main.hs | 18 ++++++++ src/Trivstream/Options.hs | 37 +++++++++++++++++ src/Trivstream/Options/Utils.hs | 32 ++++++++++++++ src/Trivstream/Types.hs | 92 +++++++++++++++++++++++++++++++++++++++++ trivstream.cabal | 24 ++++++++++- trivstream.nix | 14 +++++-- 6 files changed, 212 insertions(+), 5 deletions(-) create mode 100644 src/Trivstream/Options.hs create mode 100644 src/Trivstream/Options/Utils.hs create mode 100644 src/Trivstream/Types.hs diff --git a/src/Main.hs b/src/Main.hs index c2e4af9..70c3ad5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,4 +1,22 @@ module Main where + +import Trivstream.Types +import Trivstream.Options + + +import Options.Applicative + +import Control.Lens +import Data.Default.Class +import Data.Serialize +import Data.Conduit.Cereal + +import Sound.Pulse.Simple +import Sound.JACK + +import Network.Socket + + main :: IO () main = undefined diff --git a/src/Trivstream/Options.hs b/src/Trivstream/Options.hs new file mode 100644 index 0000000..a777942 --- /dev/null +++ b/src/Trivstream/Options.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE TemplateHaskell, OverloadedStrings #-} + +module Trivstream.Options + ( withOptions + ) where + + +import Trivstream.Types +import Trivstream.Options.Utils +import Paths_trivstream (version) + + +import Options.Applicative + +import Control.Monad.Reader +import Control.Monad.IO.Class + + +withOptions :: MonadIO m => ReaderT Configuration a -> IO a +withOptions f = liftIO (execParser options) >>= runReaderT f + where + options = options' `info` mconcat [ header $ concat [ "trivstream " + , show version + , " - " + , "A trivial client & server for streaming audio between pulseaudio and jack over udp/tcp" + ] + , footer $ concat [ "trivstream " + , show version + , " (", $(gitBranch), "@", $(gitHash), (if $(gitDirty) then "*" else ""), ")" + ] + ] + options' = Configuration <$> argument rCI (help "Mode of operation" <> value def <> showDefault <> metavar "MODE") + <*> optional ( undefined + ) + <*> audioOptions + + audioOptions = undefined diff --git a/src/Trivstream/Options/Utils.hs b/src/Trivstream/Options/Utils.hs new file mode 100644 index 0000000..30694d8 --- /dev/null +++ b/src/Trivstream/Options/Utils.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE StandaloneDeriving #-} + +module Trivstream.Options.Utils + ( rCI + ) where + +import Options.Applicative + +import Data.Char +import Data.Maybe + +import Network.Socket + + +deriving instance Enum Family +deriving instance Bounded Family + + +rCI :: (Show a, Read a) => ReadM a +rCI = eitherReader rRep' + where + rRep' str = case mapMaybe readMaybe $ cases str of + [] -> Left $ "Could not parse `" ++ str ++ "'" + [x] -> Right x + xs -> Left $ "Ambiguous parse for `" ++ str ++ "': " ++ show xs + cases [] = [[]] + cases (c:cs) = [(c':cs') | c' <- [toLower c, c, toUpper c], cs' <- cases cs] + +rFamily :: ReadM Family +rFamily = undefined + where + families = filter isSupportedFamily [minBound..maxBound] diff --git a/src/Trivstream/Types.hs b/src/Trivstream/Types.hs new file mode 100644 index 0000000..8cdd592 --- /dev/null +++ b/src/Trivstream/Types.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, DeriveGeneric #-} + +module Trivstream.Types + ( AudioConfig(..) + , AudioBackend(..) + , SampleRate(..) + , Configuration(..) + , Mode (..) + ) where + + +import Control.Lens +import Control.Lens.TH +import Data.Default.Class (Default(..)) +import Data.Serialize (Serialize) +import GHC.Generics (Generic) + +import Foreign.C.Types (CInt(..)) + +import Sound.Pulse.Simple (ChannelPosition(..), ChannelPan(..)) +import Sound.JACK () + +import Network.Socket (Family(..), SocketType(..), ProtocolNumber(..), SockAddr(..)) + + +deriving instance Generic ChannelPan +instance Serialize ChannelPan + +deriving instance Generic ChannelPosition +instance Serialize ChannelPosition + + +data AudioBackend = Pulse | Jack + deriving (Enum, Eq, Generic) + +instance Default AudioBackend where + def = Pulse + +instance Serialize AudioBackend + + +-- | Numeric instances consider this value to be in `kHz` +newtype SampleRate = SampleRate Int + deriving (Eq, Ord, Enum, Num, Real, Integral, Generic) +makePrisms ''SampleRate + +instance Default SampleRate where + def = 44100 + +instance Serialize SampleRate + + +data AudioConfig = AudioConfig + { _aBackend :: AudioBackend + , _aChannels :: [Maybe ChannelPosition] + , _aRate :: SampleRate + } deriving (Generic) +makeLenses ''AudioConfig + +instance Default AudioConfig where + def = AudioConfig + { _aBackend = def + , _aChannels = [Just $ ChannelNormal PanLeft, Just $ ChannelNormal PanRight] + , _aRate = def + } + +instance Serialize AudioConfig + + +data Mode = Server | Client + deriving (Enum, Eq, Generic, Show) + +instance Default Mode where + def = Server + +instance Serialize Mode + + +data Configuration = Configuration + { _cMode :: Mode + , _cSocketDesc :: Maybe (Family, SocketType, ProtocolNumber, SockAddr) + , _cAudio :: AudioConfig + } deriving (Generic) +makeLenses ''Configuration + +instance Default Configuration where + def = Configuration + { _cMode = def + , _cSocketDesc = Nothing + , _cAudio = def + } diff --git a/trivstream.cabal b/trivstream.cabal index 546fc1a..a8dc9ec 100644 --- a/trivstream.cabal +++ b/trivstream.cabal @@ -1,6 +1,6 @@ name: trivstream version: 0.0.0 -synopsis: A trivial client & server for streaming audio over udp between pulseaudio & jack +synopsis: A trivial client & server for streaming audio between pulseaudio and jack over udp/tcp -- description: license: GPL-3 author: Gregor Kleen @@ -13,8 +13,28 @@ cabal-version: >=1.10 executable trivstream main-is: Main.hs - -- other-modules: + extensions: TemplateHaskell + , DeriveGeneric + , StandaloneDeriving + , GeneralizedNewtypeDeriving + , OverloadedStrings + other-modules: Trivstream.Types -- other-extensions: build-depends: base >=4.9 && <5 + , cereal >=0.5.3.0 && <1 + , cereal-conduit >=0.7.3 && <1 + , conduit >=1.2.6.6 && <2 + , conduit-extra >=1.1.13.2 && <2 + , data-default-class >=0.1.2.0 && <1 + , gitrev >=1.2.0 && <2 + , jack >=0.7.0.3 && <1 + , lens >=4.14 && <5 + , network >=2.6.2.1 && <3 + , mtl + , optparse-applicative >=0.12.1.0 && <1 + , pulse-simple >=0.1.14 && <1 + , socket-activation >=0.1.0.1 && <1 + , transformers hs-source-dirs: src default-language: Haskell2010 + ghc-options: -threaded diff --git a/trivstream.nix b/trivstream.nix index 2521a88..7e8c872 100644 --- a/trivstream.nix +++ b/trivstream.nix @@ -1,11 +1,19 @@ -{ mkDerivation, base, stdenv }: +{ mkDerivation, base, cereal, cereal-conduit, conduit +, conduit-extra, data-default-class, gitrev, jack, lens, mtl +, network, optparse-applicative, pulse-simple, socket-activation +, stdenv, transformers +}: mkDerivation { pname = "trivstream"; version = "0.0.0"; src = ./.; isLibrary = false; isExecutable = true; - executableHaskellDepends = [ base ]; - description = "A trivial client & server for streaming audio over udp between pulseaudio & jack"; + executableHaskellDepends = [ + base cereal cereal-conduit conduit conduit-extra data-default-class + gitrev jack lens mtl network optparse-applicative pulse-simple + socket-activation transformers + ]; + description = "A trivial client & server for streaming audio between pulseaudio and jack over udp/tcp"; license = stdenv.lib.licenses.gpl3; } -- cgit v1.2.3