diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Main.hs | 18 | ||||
-rw-r--r-- | src/Trivstream/Options.hs | 37 | ||||
-rw-r--r-- | src/Trivstream/Options/Utils.hs | 32 | ||||
-rw-r--r-- | src/Trivstream/Types.hs | 92 |
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 @@ | |||
1 | module Main where | 1 | module Main where |
2 | 2 | ||
3 | |||
4 | import Trivstream.Types | ||
5 | import Trivstream.Options | ||
6 | |||
7 | |||
8 | import Options.Applicative | ||
9 | |||
10 | import Control.Lens | ||
11 | import Data.Default.Class | ||
12 | import Data.Serialize | ||
13 | import Data.Conduit.Cereal | ||
14 | |||
15 | import Sound.Pulse.Simple | ||
16 | import Sound.JACK | ||
17 | |||
18 | import Network.Socket | ||
19 | |||
20 | |||
3 | main :: IO () | 21 | main :: IO () |
4 | main = undefined | 22 | 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 @@ | |||
1 | {-# LANGUAGE TemplateHaskell, OverloadedStrings #-} | ||
2 | |||
3 | module Trivstream.Options | ||
4 | ( withOptions | ||
5 | ) where | ||
6 | |||
7 | |||
8 | import Trivstream.Types | ||
9 | import Trivstream.Options.Utils | ||
10 | import Paths_trivstream (version) | ||
11 | |||
12 | |||
13 | import Options.Applicative | ||
14 | |||
15 | import Control.Monad.Reader | ||
16 | import Control.Monad.IO.Class | ||
17 | |||
18 | |||
19 | withOptions :: MonadIO m => ReaderT Configuration a -> IO a | ||
20 | withOptions f = liftIO (execParser options) >>= runReaderT f | ||
21 | where | ||
22 | options = options' `info` mconcat [ header $ concat [ "trivstream " | ||
23 | , show version | ||
24 | , " - " | ||
25 | , "A trivial client & server for streaming audio between pulseaudio and jack over udp/tcp" | ||
26 | ] | ||
27 | , footer $ concat [ "trivstream " | ||
28 | , show version | ||
29 | , " (", $(gitBranch), "@", $(gitHash), (if $(gitDirty) then "*" else ""), ")" | ||
30 | ] | ||
31 | ] | ||
32 | options' = Configuration <$> argument rCI (help "Mode of operation" <> value def <> showDefault <> metavar "MODE") | ||
33 | <*> optional ( undefined | ||
34 | ) | ||
35 | <*> audioOptions | ||
36 | |||
37 | 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 @@ | |||
1 | {-# LANGUAGE StandaloneDeriving #-} | ||
2 | |||
3 | module Trivstream.Options.Utils | ||
4 | ( rCI | ||
5 | ) where | ||
6 | |||
7 | import Options.Applicative | ||
8 | |||
9 | import Data.Char | ||
10 | import Data.Maybe | ||
11 | |||
12 | import Network.Socket | ||
13 | |||
14 | |||
15 | deriving instance Enum Family | ||
16 | deriving instance Bounded Family | ||
17 | |||
18 | |||
19 | rCI :: (Show a, Read a) => ReadM a | ||
20 | rCI = eitherReader rRep' | ||
21 | where | ||
22 | rRep' str = case mapMaybe readMaybe $ cases str of | ||
23 | [] -> Left $ "Could not parse `" ++ str ++ "'" | ||
24 | [x] -> Right x | ||
25 | xs -> Left $ "Ambiguous parse for `" ++ str ++ "': " ++ show xs | ||
26 | cases [] = [[]] | ||
27 | cases (c:cs) = [(c':cs') | c' <- [toLower c, c, toUpper c], cs' <- cases cs] | ||
28 | |||
29 | rFamily :: ReadM Family | ||
30 | rFamily = undefined | ||
31 | where | ||
32 | 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 @@ | |||
1 | {-# LANGUAGE TemplateHaskell #-} | ||
2 | {-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, DeriveGeneric #-} | ||
3 | |||
4 | module Trivstream.Types | ||
5 | ( AudioConfig(..) | ||
6 | , AudioBackend(..) | ||
7 | , SampleRate(..) | ||
8 | , Configuration(..) | ||
9 | , Mode (..) | ||
10 | ) where | ||
11 | |||
12 | |||
13 | import Control.Lens | ||
14 | import Control.Lens.TH | ||
15 | import Data.Default.Class (Default(..)) | ||
16 | import Data.Serialize (Serialize) | ||
17 | import GHC.Generics (Generic) | ||
18 | |||
19 | import Foreign.C.Types (CInt(..)) | ||
20 | |||
21 | import Sound.Pulse.Simple (ChannelPosition(..), ChannelPan(..)) | ||
22 | import Sound.JACK () | ||
23 | |||
24 | import Network.Socket (Family(..), SocketType(..), ProtocolNumber(..), SockAddr(..)) | ||
25 | |||
26 | |||
27 | deriving instance Generic ChannelPan | ||
28 | instance Serialize ChannelPan | ||
29 | |||
30 | deriving instance Generic ChannelPosition | ||
31 | instance Serialize ChannelPosition | ||
32 | |||
33 | |||
34 | data AudioBackend = Pulse | Jack | ||
35 | deriving (Enum, Eq, Generic) | ||
36 | |||
37 | instance Default AudioBackend where | ||
38 | def = Pulse | ||
39 | |||
40 | instance Serialize AudioBackend | ||
41 | |||
42 | |||
43 | -- | Numeric instances consider this value to be in `kHz` | ||
44 | newtype SampleRate = SampleRate Int | ||
45 | deriving (Eq, Ord, Enum, Num, Real, Integral, Generic) | ||
46 | makePrisms ''SampleRate | ||
47 | |||
48 | instance Default SampleRate where | ||
49 | def = 44100 | ||
50 | |||
51 | instance Serialize SampleRate | ||
52 | |||
53 | |||
54 | data AudioConfig = AudioConfig | ||
55 | { _aBackend :: AudioBackend | ||
56 | , _aChannels :: [Maybe ChannelPosition] | ||
57 | , _aRate :: SampleRate | ||
58 | } deriving (Generic) | ||
59 | makeLenses ''AudioConfig | ||
60 | |||
61 | instance Default AudioConfig where | ||
62 | def = AudioConfig | ||
63 | { _aBackend = def | ||
64 | , _aChannels = [Just $ ChannelNormal PanLeft, Just $ ChannelNormal PanRight] | ||
65 | , _aRate = def | ||
66 | } | ||
67 | |||
68 | instance Serialize AudioConfig | ||
69 | |||
70 | |||
71 | data Mode = Server | Client | ||
72 | deriving (Enum, Eq, Generic, Show) | ||
73 | |||
74 | instance Default Mode where | ||
75 | def = Server | ||
76 | |||
77 | instance Serialize Mode | ||
78 | |||
79 | |||
80 | data Configuration = Configuration | ||
81 | { _cMode :: Mode | ||
82 | , _cSocketDesc :: Maybe (Family, SocketType, ProtocolNumber, SockAddr) | ||
83 | , _cAudio :: AudioConfig | ||
84 | } deriving (Generic) | ||
85 | makeLenses ''Configuration | ||
86 | |||
87 | instance Default Configuration where | ||
88 | def = Configuration | ||
89 | { _cMode = def | ||
90 | , _cSocketDesc = Nothing | ||
91 | , _cAudio = def | ||
92 | } | ||