summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2015-06-09 23:20:13 +0200
committerGregor Kleen <gkleen@yggdrasil.li>2015-06-09 23:20:13 +0200
commit3e89e9e7486ae0fdd04a68b2ba799dbf89a621f0 (patch)
treedd4c9e95e00be47131d51654de589067b73a6c55 /src
parent77ec0ee0f8d3b5113fc32a00430024615d7737e1 (diff)
downloadtrivmix-3e89e9e7486ae0fdd04a68b2ba799dbf89a621f0.tar
trivmix-3e89e9e7486ae0fdd04a68b2ba799dbf89a621f0.tar.gz
trivmix-3e89e9e7486ae0fdd04a68b2ba799dbf89a621f0.tar.bz2
trivmix-3e89e9e7486ae0fdd04a68b2ba799dbf89a621f0.tar.xz
trivmix-3e89e9e7486ae0fdd04a68b2ba799dbf89a621f0.zip
moved logging to stderr
Diffstat (limited to 'src')
-rw-r--r--src/Trivmix.hs23
1 files changed, 13 insertions, 10 deletions
diff --git a/src/Trivmix.hs b/src/Trivmix.hs
index 4af2165..5dc213c 100644
--- a/src/Trivmix.hs
+++ b/src/Trivmix.hs
@@ -24,6 +24,7 @@ import qualified Control.Monad.Exception.Synchronous as Sync
24 24
25import Control.Exception 25import Control.Exception
26import System.IO.Error 26import System.IO.Error
27import System.IO
27 28
28import System.INotify 29import System.INotify
29 30
@@ -47,14 +48,16 @@ data Level = Lin Float | DB Float
47 48
48instance Show Level where 49instance Show Level where
49 show (Lin x) = show x 50 show (Lin x) = show x
50 show (DB x) = (show x) ++ "dB" 51 show (DB x) = (show x') ++ "dB"
52 where
53 x' = 20 * (logBase 10 x)
51 54
52instance Read Level where 55instance Read Level where
53 readsPrec i = map toL . readsPrec i 56 readsPrec i = map toL . readsPrec i
54 where 57 where
55 toL :: (Float, String) -> (Level, String) 58 toL :: (Float, String) -> (Level, String)
56 toL (f, str) 59 toL (f, str)
57 | ((==) `on` CI.mk) prec unit = (DB f, rest) 60 | ((==) `on` CI.mk) prec unit = (DB $ 10 ** (0.05 * f), rest)
58 | otherwise = (Lin f, str) 61 | otherwise = (Lin f, str)
59 where 62 where
60 prec = take lU str 63 prec = take lU str
@@ -133,7 +136,7 @@ mix level input = do
133 return $ (CFloat $ toFloat level') * input 136 return $ (CFloat $ toFloat level') * input
134 where 137 where
135 toFloat (Lin x) = x 138 toFloat (Lin x) = x
136 toFloat (DB x) = 10 ** (0.05 * x) 139 toFloat (DB x) = x
137 140
138handleFiles :: INotify -> MVar Level -> [FilePath] -> IO () 141handleFiles :: INotify -> MVar Level -> [FilePath] -> IO ()
139handleFiles inotify level files = do 142handleFiles inotify level files = do
@@ -159,7 +162,7 @@ onStateFile file initial action = do
159 let acquireFile = case exists of 162 let acquireFile = case exists of
160 True -> return () 163 True -> return ()
161 False -> do 164 False -> do
162 putStrLn $ "Creating ‘" ++ file ++ "’ (file)" 165 hPutStrLn stderr $ "Creating ‘" ++ file ++ "’ (file)"
163 createFile file fileMode >>= closeFd >> writeFile file initial 166 createFile file fileMode >>= closeFd >> writeFile file initial
164 fileMode = foldl unionFileModes nullFileMode [ ownerReadMode 167 fileMode = foldl unionFileModes nullFileMode [ ownerReadMode
165 , ownerWriteMode 168 , ownerWriteMode
@@ -169,17 +172,17 @@ onStateFile file initial action = do
169 releaseFile = case exists of 172 releaseFile = case exists of
170 True -> return () 173 True -> return ()
171 False -> do 174 False -> do
172 putStrLn $ "Removing ‘" ++ file ++ "’ (file)" 175 hPutStrLn stderr $ "Removing ‘" ++ file ++ "’ (file)"
173 removeFile file 176 removeFile file
174 acquireDir = case dirExists of 177 acquireDir = case dirExists of
175 True -> return () 178 True -> return ()
176 False -> do 179 False -> do
177 putStrLn $ "Creating ‘" ++ directory ++ "’ (dir" 180 hPutStrLn stderr $ "Creating ‘" ++ directory ++ "’ (dir"
178 createDirectoryIfMissing True directory 181 createDirectoryIfMissing True directory
179 releaseDir = case dirExists of 182 releaseDir = case dirExists of
180 True -> return () 183 True -> return ()
181 False -> do 184 False -> do
182 putStrLn $ "Removing ‘" ++ directory ++ "’ (dir)" 185 hPutStrLn stderr $ "Removing ‘" ++ directory ++ "’ (dir)"
183 removeDirectory directory 186 removeDirectory directory
184 acquire = acquireDir >> acquireFile 187 acquire = acquireDir >> acquireFile
185 release = releaseFile >> releaseDir 188 release = releaseFile >> releaseDir
@@ -191,10 +194,10 @@ readLevel levelChan current file = catch action handler
191 action = do 194 action = do
192 level <- readFile file >>= readIO . stripSpace 195 level <- readFile file >>= readIO . stripSpace
193 writeChan levelChan level 196 writeChan levelChan level
194 putStrLn $ "Detected new level: " ++ (show level) 197 hPutStrLn stderr $ "Detected new level: " ++ (show level)
195 handler e = if isUserError e 198 handler e = if isUserError e
196 then do 199 then do
197 putStrLn $ "Could not parse new level from ‘" ++ file ++ "’ - overwriting." 200 hPutStrLn stderr $ "Could not parse new level from ‘" ++ file ++ "’ - overwriting."
198 readMVar current >>= writeLevel file 201 readMVar current >>= writeLevel file
199 else throw e 202 else throw e
200 stripSpace = reverse . stripSpace' . reverse . stripSpace' 203 stripSpace = reverse . stripSpace' . reverse . stripSpace'
@@ -205,5 +208,5 @@ readLevel levelChan current file = catch action handler
205 208
206writeLevel :: FilePath -> Level -> IO () 209writeLevel :: FilePath -> Level -> IO ()
207writeLevel file level = do 210writeLevel file level = do
208 putStrLn $ "Writing out level ‘" ++ (show level) ++ "’ to ‘" ++ file ++ "’" 211 hPutStrLn stderr $ "Writing out level ‘" ++ (show level) ++ "’ to ‘" ++ file ++ "’"
209 writeFile file (show level ++ "\n") 212 writeFile file (show level ++ "\n")