diff options
Diffstat (limited to 'adjmix')
-rw-r--r-- | adjmix/Adjmix.hs | 71 |
1 files changed, 71 insertions, 0 deletions
diff --git a/adjmix/Adjmix.hs b/adjmix/Adjmix.hs new file mode 100644 index 0000000..49b820f --- /dev/null +++ b/adjmix/Adjmix.hs | |||
@@ -0,0 +1,71 @@ | |||
1 | {-# LANGUAGE RecordWildCards #-} | ||
2 | |||
3 | import Options.Applicative | ||
4 | |||
5 | import System.FilePath | ||
6 | |||
7 | import Data.Char | ||
8 | |||
9 | import Trivmix.Types | ||
10 | |||
11 | data Options = Options | ||
12 | { baseDirectory :: FilePath | ||
13 | , targetDirectory :: FilePath | ||
14 | , levelFile :: FilePath | ||
15 | , adjustment :: Adjustment Level | ||
16 | } | ||
17 | optionParser :: Parser Options | ||
18 | optionParser = Options | ||
19 | <$> strOption ( long "base" | ||
20 | <> metavar "DIRECTORY" | ||
21 | <> value "/dev/shm/mix" | ||
22 | ) | ||
23 | <*> strOption ( long "target" | ||
24 | <> short 't' | ||
25 | <> metavar "DIRECTORY" | ||
26 | <> help "Directory relative to ‘--base’ containing the level file" | ||
27 | ) | ||
28 | <*> strOption ( long "level" | ||
29 | <> metavar "FILENAME" | ||
30 | <> value "level" | ||
31 | <> help "Filename of the level file" | ||
32 | ) | ||
33 | <*> ( ( Set <$> option auto ( long "set" | ||
34 | <> short 'o' | ||
35 | <> metavar "LEVEL" | ||
36 | ) | ||
37 | ) | ||
38 | <|> ( Add <$> option auto ( long "add" | ||
39 | <> short 'a' | ||
40 | <> metavar "LEVEL" | ||
41 | ) | ||
42 | ) | ||
43 | <|> ( Sub <$> option auto ( long "sub" | ||
44 | <> short 's' | ||
45 | <> metavar "LEVEL" | ||
46 | ) | ||
47 | ) | ||
48 | ) | ||
49 | |||
50 | main :: IO () | ||
51 | main = execParser opts >>= adjmix | ||
52 | where | ||
53 | opts = info (helper <*> optionParser) | ||
54 | ( fullDesc | ||
55 | <> progDesc "Adjust the level file of a trivmix" | ||
56 | <> header "Adjmix — A trivial interface to a trivial mixer" | ||
57 | ) | ||
58 | |||
59 | adjmix :: Options -> IO () | ||
60 | adjmix Options{..} = do | ||
61 | oldLevel <- readFile levelFile >>= readIO . stripSpace | ||
62 | let | ||
63 | newLevel = oldLevel `doAdjustment` adjustment | ||
64 | writeFile levelFile (show newLevel ++ "\n") | ||
65 | where | ||
66 | levelFile = baseDirectory </> targetDirectory </> levelFile | ||
67 | stripSpace = reverse . stripSpace' . reverse . stripSpace' | ||
68 | stripSpace' [] = [] | ||
69 | stripSpace' l@(x:xs) = if isSpace x | ||
70 | then stripSpace' xs | ||
71 | else l | ||