Inital work on option parsing

4 files changed, 179 insertions, 0 deletions

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
+    }