Added adjmix

5 files changed, 189 insertions, 53 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 @@
+{-# LANGUAGE RecordWildCards #-}
+
+import Options.Applicative
+
+import System.FilePath
+
+import Data.Char
+
+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"
+                             )
+               <*> 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"
+                             )
+               <*> ( ( Set <$> option auto ( long "set"
+                                             <> short 'o'
+                                             <> metavar "LEVEL"
+                                           )
+                     )
+                     <|> ( Add <$> option auto ( long "add"
+                                                 <> short 'a'
+                                                 <> metavar "LEVEL"
+                                               )
+                         )
+                     <|> ( Sub <$> option auto ( long "sub"
+                                                 <> short 's'
+                                                 <> metavar "LEVEL"
+                                               )
+                         )
+                   )
+
+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{..} = 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
diff --git a/src/Trivmix/Types.hs b/src/Trivmix/Types.hs
new file mode 100644
index 0000000..66accdf
--- /dev/null
+++ b/src/Trivmix/Types.hs
@@ -0,0 +1,90 @@
+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
+
+module Trivmix.Types
+       ( Level
+       , toFloat
+       , Adjustment(..)
+       , doAdjustment
+       , module Data.Default
+       ) where
+
+import Data.Fixed
+import           Data.CaseInsensitive  ( CI )
+import qualified Data.CaseInsensitive as CI
+
+import Data.Default
+
+import Data.Function (on)
+
+data Level = Lin Float | DB Float
+
+instance Num Level where
+  (+) = asFloat (+)
+  (-) = asFloat (-)
+  (*) = asFloat (*)
+  abs = Lin . abs . toFloat
+  signum = Lin . signum . toFloat
+  fromInteger = Lin . fromInteger
+
+asFloat :: (Float -> Float -> Float) -> Level -> Level -> Level
+asFloat f (Lin x) (Lin y) = Lin $ f x y
+asFloat f x y = DB $ (f `on` toFloat) x y
+
+toFloat :: Level -> Float
+toFloat (Lin x) = x
+toFloat (DB x) = x
+
+withPrec :: (Num a, RealFrac a, HasResolution b) => a -> Fixed b
+withPrec x = withResolution $ \p' -> MkFixed $ toInteger $ round $ x * (fromInteger p')
+
+withType :: (p a -> f a) -> f a
+withType f = f undefined
+
+withResolution :: (HasResolution a) => (Integer -> f a) -> f a
+withResolution f = withType (f . resolution)
+
+instance Show Level where
+  show (Lin x) = show x
+  show (DB x) = (show $ (withPrec x' :: Milli)) ++ "dB"
+    where
+      x' = 20 * (logBase 10 x)
+
+instance Read Level where
+  readsPrec i = map toL . readsPrec i
+    where
+      toL :: (Float, String) -> (Level, String)
+      toL (f, str)
+        | ((==) `on` CI.mk) prec unit = (DB $ 10 ** (0.05 * f), rest)
+        | otherwise = (Lin f, str)
+        where
+          prec = take lU str
+          rest = drop lU str
+          unit = "dB"
+          lU = length unit
+
+instance Eq Level where
+  (Lin a) == (Lin b) = a == b
+  (Lin a) == (DB b) = a == b
+  (DB a) == (Lin b) = a == b
+  (DB a) == (DB b) = a == b
+
+instance Default Level where
+  def = Lin 0
+
+data Adjustment a = Set a
+                  | Add a
+                  | Sub a
+                  deriving (Show, Eq)
+
+class Adjustable a where
+  add :: a -> a -> a
+  sub :: a -> a -> a
+
+instance Num a => Adjustable a where
+  add = (+)
+  sub = (-)
+
+doAdjustment :: Adjustable a => a -> Adjustment a -> a
+doAdjustment _ (Set y) = y
+doAdjustment x (Add y) = add x y
+doAdjustment x (Sub y) = sub x y
diff --git a/trivmix.cabal b/trivmix.cabal
index 40aa9a8..0e02a7d 100644
--- a/trivmix.cabal
+++ b/trivmix.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                trivmix
-version:             2.4.6
+version:             2.5.0
 -- synopsis:            
 -- description:         
 license:             PublicDomain
@@ -15,6 +15,14 @@ build-type:          Simple
 -- extra-source-files:  
 cabal-version:       >=1.10
 
+library
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  exposed-modules:     Trivmix.Types
+  build-depends:       base >=4.7 && <4.8
+                     , data-default >=0.5 && <1
+                     , case-insensitive >=1.2 && <2
+
 executable trivmix
   main-is:             Trivmix.hs
   -- other-modules:       
@@ -29,12 +37,21 @@ executable trivmix
                      , transformers >=0.3 && <1
                      , explicit-exception >=0.1 && <1
                      , process >=1.2 && <2
-                     , case-insensitive >=1.2 && <2
                      , filelock >=0.1 && <1
-  hs-source-dirs:      src
+                     , trivmix
+  hs-source-dirs:      trivmix
   default-language:    Haskell2010
   ghc-options:         -threaded
 
+executable adjmix
+  main-is:             Adjmix.hs
+  build-depends:       base >=4.7 && <4.8
+                     , optparse-applicative >=0.11 && <1
+                     , filepath >=1.3 && <2
+                     , trivmix
+  hs-source-dirs:      adjmix
+  default-language:    Haskell2010
+
 -- Local Variables:
 -- firestarter: "nix-shell -p haskellPackages.cabal2nix --command 'cabal2nix ./.' | tee trivmix.nix"
 -- End:
diff --git a/trivmix.nix b/trivmix.nix
index fae88fc..6edcff0 100644
--- a/trivmix.nix
+++ b/trivmix.nix
@@ -1,18 +1,18 @@
 # This file was auto-generated by cabal2nix. Please do NOT edit manually!
 
-{ cabal, caseInsensitive, explicitException, filelock, filepath
-, hinotify, jack, optparseApplicative, transformers
+{ cabal, caseInsensitive, dataDefault, explicitException, filelock
+, filepath, hinotify, jack, optparseApplicative, transformers
 }:
 
 cabal.mkDerivation (self: {
   pname = "trivmix";
-  version = "2.4.6";
+  version = "2.5.0";
   src = ./.;
-  isLibrary = false;
+  isLibrary = true;
   isExecutable = true;
   buildDepends = [
-    caseInsensitive explicitException filelock filepath hinotify jack
-    optparseApplicative transformers
+    caseInsensitive dataDefault explicitException filelock filepath
+    hinotify jack optparseApplicative transformers
   ];
   meta = {
     license = self.stdenv.lib.licenses.publicDomain;
diff --git a/src/Trivmix.hs b/trivmix/Trivmix.hs
index 37ecec6..9f0cf22 100644
--- a/src/Trivmix.hs
+++ b/trivmix/Trivmix.hs
@@ -34,11 +34,8 @@ import Data.Char
 import Data.Function
 
 import Control.Monad
-
-import Data.Fixed
   
-import           Data.CaseInsensitive  ( CI )
-import qualified Data.CaseInsensitive as CI
+import Trivmix.Types
 
 data Options = Options
                { input :: String
@@ -48,42 +45,6 @@ data Options = Options
                , levelFiles :: [FilePath]
                }
 
-data Level = Lin Float | DB Float
-
-withPrec :: (Num a, RealFrac a, HasResolution b) => a -> Fixed b
-withPrec x = withResolution $ \p' -> MkFixed $ toInteger $ round $ x * (fromInteger p')
-
-withType :: (p a -> f a) -> f a
-withType f = f undefined
-
-withResolution :: (HasResolution a) => (Integer -> f a) -> f a
-withResolution f = withType (f . resolution)
-
-instance Show Level where
-  show (Lin x) = show x
-  show (DB x) = (show $ (withPrec x' :: Milli)) ++ "dB"
-    where
-      x' = 20 * (logBase 10 x)
-
-instance Read Level where
-  readsPrec i = map toL . readsPrec i
-    where
-      toL :: (Float, String) -> (Level, String)
-      toL (f, str)
-        | ((==) `on` CI.mk) prec unit = (DB $ 10 ** (0.05 * f), rest)
-        | otherwise = (Lin f, str)
-        where
-          prec = take lU str
-          rest = drop lU str
-          unit = "dB"
-          lU = length unit
-
-instance Eq Level where
-  (Lin a) == (Lin b) = a == b
-  (Lin a) == (DB b) = a == b
-  (DB a) == (Lin b) = a == b
-  (DB a) == (DB b) = a == b
-
 optionParser :: Parser Options
 optionParser = Options <$>
                (fromMaybe "in" <$> optional (strOption ( long "input"
@@ -120,7 +81,7 @@ watchedAttrs = [ Modify
                ]
 
 initialLevel :: Level
-initialLevel = Lin 0
+initialLevel = def
 
 defFileMode :: FileMode
 defFileMode = foldl unionFileModes nullFileMode [ ownerReadMode
@@ -168,9 +129,6 @@ mix :: MVar Level -> CFloat -> IO CFloat
 mix level input = do
   level' <- readMVar level
   return $ (CFloat $ toFloat level') * input
-  where
-    toFloat (Lin x) = x
-    toFloat (DB x) = x
 
 handleFiles :: INotify -> MVar Level -> [FilePath] -> IO ()
 handleFiles inotify level files = do