diff options
| author | Gregor Kleen <gkleen@yggdrasil.li> | 2017-03-09 14:13:44 +0100 | 
|---|---|---|
| committer | Gregor Kleen <gkleen@yggdrasil.li> | 2017-03-09 14:13:44 +0100 | 
| commit | 10ed6c7c73ac455b3dbfbbae2dd522f1581e68dc (patch) | |
| tree | 7d422aaa7023f6b50c65def03670e3d512b78ffa /adjmix | |
| parent | 2f5f880136f3411e7e8d919631e71ef05d0ae9ad (diff) | |
| download | trivmix-10ed6c7c73ac455b3dbfbbae2dd522f1581e68dc.tar trivmix-10ed6c7c73ac455b3dbfbbae2dd522f1581e68dc.tar.gz trivmix-10ed6c7c73ac455b3dbfbbae2dd522f1581e68dc.tar.bz2 trivmix-10ed6c7c73ac455b3dbfbbae2dd522f1581e68dc.tar.xz trivmix-10ed6c7c73ac455b3dbfbbae2dd522f1581e68dc.zip  | |
Cleanup adjmix
Diffstat (limited to 'adjmix')
| -rw-r--r-- | adjmix/Adjmix.hs | 129 | 
1 files changed, 60 insertions, 69 deletions
diff --git a/adjmix/Adjmix.hs b/adjmix/Adjmix.hs index c2f7fee..bc04a50 100644 --- a/adjmix/Adjmix.hs +++ b/adjmix/Adjmix.hs  | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | {-# LANGUAGE RecordWildCards #-} | 1 | {-# LANGUAGE RecordWildCards, ApplicativeDo #-} | 
| 2 | 2 | ||
| 3 | import Options.Applicative | 3 | import Options.Applicative | 
| 4 | 4 | ||
| @@ -7,90 +7,81 @@ import System.FileLock | |||
| 7 | 7 | ||
| 8 | import Data.Char | 8 | import Data.Char | 
| 9 | import Data.Monoid | 9 | import Data.Monoid | 
| 10 | import Data.List | ||
| 10 | 11 | ||
| 11 | import Trivmix.Types | 12 | import Trivmix.Types | 
| 12 | 13 | ||
| 14 | |||
| 13 | data Options = Options | 15 | data Options = Options | 
| 14 | { baseDirectory :: FilePath | 16 | { baseDirectory :: FilePath | 
| 15 | , targetDirectory :: FilePath | 17 | , targetDirectory :: FilePath | 
| 16 | , levelFile :: FilePath | 18 | , levelFile :: FilePath | 
| 17 | , adjustment :: Adjustment Level | 19 | , adjustment :: Adjustment Level | 
| 18 | } | 20 | } | 
| 21 | |||
| 22 | |||
| 19 | optionParser :: Parser Options | 23 | optionParser :: Parser Options | 
| 20 | optionParser = Options | 24 | optionParser = do | 
| 21 | <$> strOption ( long "base" | 25 | baseDirectory <- strOption $ mconcat | 
| 22 | <> metavar "DIRECTORY" | 26 | [ long "base", metavar "DIRECTORY", showDefault | 
| 23 | <> value "/dev/shm/mix" | 27 | , value "/dev/shm/mix" | 
| 24 | <> showDefault | 28 | , help "Base directory" | 
| 25 | <> help "Base directory" | 29 | ] | 
| 26 | ) | 30 | levelFile <- strOption $ mconcat | 
| 27 | <*> strOption ( long "target" | 31 | [ long "level", metavar "FILENAME", showDefault | 
| 28 | <> short 't' | 32 | , value "level" | 
| 29 | <> metavar "DIRECTORY" | 33 | , help "Filename of the level file" | 
| 30 | <> help "Directory relative to ‘--base’ containing the level file" | 34 | ] | 
| 31 | ) | 35 | targetDirectory <- strArgument $ mconcat | 
| 32 | <*> strOption ( long "level" | 36 | [ metavar "DIRECTORY" | 
| 33 | <> metavar "FILENAME" | 37 | , help "Directory relative to ‘--base’ containing the level file" | 
| 34 | <> value "level" | 38 | ] | 
| 35 | <> help "Filename of the level file" | 39 | adjustment <- getAlt . mconcat $ map Alt | 
| 36 | <> showDefault | 40 | [ Set <$> option auto (mconcat | 
| 37 | ) | 41 | [ long "set", short 'o', metavar "LEVEL" | 
| 38 | <*> ( ( Set <$> option auto ( long "set" | 42 | , help "Overwrite the current level" | 
| 39 | <> short 'o' | 43 | ]) | 
| 40 | <> metavar "LEVEL" | 44 | , Add <$> option auto (mconcat | 
| 41 | <> help "Overwrite the current level" | 45 | [ long "add", short 'a', metavar "LEVEL" | 
| 42 | ) | 46 | , help "Add to the current level" | 
| 43 | ) | 47 | ]) | 
| 44 | <|> ( Add <$> option auto ( long "add" | 48 | , Sub <$> option auto (mconcat | 
| 45 | <> short 'a' | 49 | [ long "sub", short 's', metavar "LEVEL" | 
| 46 | <> metavar "LEVEL" | 50 | , help "Subtract from the current level" | 
| 47 | <> help "Add to the current level" | 51 | ]) | 
| 48 | ) | 52 | , let | 
| 49 | ) | 53 | adjMode = getAlt . mconcat $ map Alt | 
| 50 | <|> ( Sub <$> option auto ( long "sub" | 54 | [ flag' Add (mconcat | 
| 51 | <> short 's' | 55 | [ long "inc", short 'i' | 
| 52 | <> metavar "LEVEL" | 56 | , help "Increase level by a preset amount (see ‘--by’)" | 
| 53 | <> help "Subtract from the current level" | 57 | ]) | 
| 54 | ) | 58 | , flag' Sub (mconcat | 
| 55 | ) | 59 | [ long "dec", short 'd' | 
| 56 | <|> ( ($) <$> ( flag' Add ( long "inc" | 60 | , help "Decrease level by a preset amount (see ‘--by’)" | 
| 57 | <> short 'i' | 61 | ]) | 
| 58 | <> help "Increase level by a preset amount (see ‘--by’)" | 62 | ] | 
| 59 | ) | 63 | adjBy = option auto (mconcat | 
| 60 | <|> flag' Sub ( long "dec" | 64 | [ long "by", short 'b', metavar "LEVEL", value (read "5dB"), showDefault | 
| 61 | <> short 'd' | 65 | , help "Value to increase/decrease level by when using ‘--inc’ or ‘--dec’" | 
| 62 | <> help "Decrease level by a preset amount (see ‘--by’)" | 66 | ]) | 
| 63 | ) | 67 | in ($) <$> adjMode <*> adjBy | 
| 64 | ) | 68 | ] | 
| 65 | <*> ( option auto ( long "by" | 69 | return Options{..} | 
| 66 | <> metavar "LEVEL" | ||
| 67 | <> value (read "5dB") | ||
| 68 | <> showDefault | ||
| 69 | <> help "Value to decrease/increase level by when using ‘--inc’ or ‘--dec’" | ||
| 70 | ) | ||
| 71 | ) | ||
| 72 | ) | ||
| 73 | ) | ||
| 74 | 70 | ||
| 75 | main :: IO () | 71 | main :: IO () | 
| 76 | main = execParser opts >>= adjmix | 72 | main = execParser opts >>= adjmix | 
| 77 | where | 73 | where | 
| 78 | opts = info (helper <*> optionParser) | 74 | opts = info (helper <*> optionParser) $ mconcat | 
| 79 | ( fullDesc | 75 | [ progDesc "Adjust the level file of a trivmix" | 
| 80 | <> progDesc "Adjust the level file of a trivmix" | 76 | , header "Adjmix — A trivial interface to a trivial mixer" | 
| 81 | <> header "Adjmix — A trivial interface to a trivial mixer" | 77 | , fullDesc | 
| 82 | ) | 78 | ] | 
| 83 | 79 | ||
| 84 | adjmix :: Options -> IO () | 80 | adjmix :: Options -> IO () | 
| 85 | adjmix Options{..} = withFileLock levelFile' Exclusive $ const $ do | 81 | adjmix Options{..} = withFileLock levelFile' Exclusive . const $ do | 
| 86 | oldLevel <- readFile levelFile' >>= readIO . stripSpace | 82 | oldLevel <- readFile levelFile' >>= readIO . stripSpace | 
| 87 | let | 83 | let newLevel = oldLevel `doAdjustment` adjustment | 
| 88 | newLevel = oldLevel `doAdjustment` adjustment | 84 | writeFile levelFile' $ show newLevel ++ "\n" | 
| 89 | writeFile levelFile' (show newLevel ++ "\n") | ||
| 90 | where | 85 | where | 
| 91 | levelFile' = baseDirectory </> targetDirectory </> levelFile | 86 | levelFile' = baseDirectory </> targetDirectory </> levelFile | 
| 92 | stripSpace = reverse . stripSpace' . reverse . stripSpace' | 87 | stripSpace = dropWhile isSpace . dropWhileEnd isSpace | 
| 93 | stripSpace' [] = [] | ||
| 94 | stripSpace' l@(x:xs) = if isSpace x | ||
| 95 | then stripSpace' xs | ||
| 96 | else l | ||
