adjmix/Adjmix.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96

{-# LANGUAGE RecordWildCards #-}

import Options.Applicative

import System.FilePath
import System.FileLock

import Data.Char
import Data.Monoid

import Trivmix.Types

data Options = Options
               { baseDirectory :: FilePath
               , targetDirectory :: FilePath
               , levelFile :: FilePath
               , adjustment :: Adjustment Level
               }
optionParser :: Parser Options
optionParser = Options
               <$> strOption ( long "base"
                               <> metavar "DIRECTORY"
                               <> value "/dev/shm/mix"
                               <> showDefault
                               <> help "Base directory"
                             )
               <*> strOption ( long "target"
                               <> short 't'
                               <> metavar "DIRECTORY"
                               <> help "Directory relative to ‘--base’ containing the level file"
                             )
               <*> strOption ( long "level"
                               <> metavar "FILENAME"
                               <> value "level"
                               <> help "Filename of the level file"
                               <> showDefault
                             )
               <*> ( ( Set <$> option auto ( long "set"
                                             <> short 'o'
                                             <> metavar "LEVEL"
                                             <> help "Overwrite the current level"
                                           )
                     )
                     <|> ( Add <$> option auto ( long "add"
                                                 <> short 'a'
                                                 <> metavar "LEVEL"
                                                 <> help "Add to the current level"
                                               )
                         )
                     <|> ( Sub <$> option auto ( long "sub"
                                                 <> short 's'
                                                 <> metavar "LEVEL"
                                                 <> help "Subtract from the current level"
                                               )
                         )
                     <|> ( ($) <$> ( flag' Add ( long "inc"
                                                 <> short 'i'
                                                 <> help "Increase level by a preset amount (see ‘--by’)"
                                               )
                                     <|> flag' Sub ( long "dec"
                                                     <> short 'd'
                                                     <> help "Decrease level by a preset amount (see ‘--by’)"
                                                   )
                                   )
                           <*> ( option auto ( long "by"
                                               <> metavar "LEVEL"
                                               <> value (read "5dB")
                                               <> showDefault
                                               <> help "Value to decrease/increase level by when using ‘--inc’ or ‘--dec’"
                                             )
                               )
                         )
                   )

main :: IO ()
main = execParser opts >>= adjmix
  where
    opts = info (helper <*> optionParser)
           ( fullDesc
             <> progDesc "Adjust the level file of a trivmix"
             <> header "Adjmix — A trivial interface to a trivial mixer"
           )

adjmix :: Options -> IO ()
adjmix Options{..} = withFileLock levelFile' Exclusive $ const $ do
  oldLevel <- readFile levelFile' >>= readIO . stripSpace
  let
    newLevel = oldLevel `doAdjustment` adjustment
  writeFile levelFile' (show newLevel ++ "\n")
  where
    levelFile' = baseDirectory </> targetDirectory </> levelFile
    stripSpace = reverse . stripSpace' . reverse . stripSpace'
    stripSpace' [] = []
    stripSpace' l@(x:xs) = if isSpace x
                          then stripSpace' xs
                          else l