ENH remove prelude from xio
This commit is contained in:
parent
96cb9298d7
commit
fe61b0192d
|
@ -1,5 +1,3 @@
|
||||||
{-# LANGUAGE ImplicitPrelude #-}
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- Functions for handling dependencies
|
-- Functions for handling dependencies
|
||||||
|
|
||||||
|
@ -102,6 +100,7 @@ import qualified DBus.Introspection as I
|
||||||
import Data.Aeson hiding (Error, Result)
|
import Data.Aeson hiding (Error, Result)
|
||||||
import Data.Aeson.Key
|
import Data.Aeson.Key
|
||||||
import Data.Internal.DBus
|
import Data.Internal.DBus
|
||||||
|
import qualified Data.Text.IO as TI
|
||||||
import Data.Yaml
|
import Data.Yaml
|
||||||
import GHC.IO.Exception (ioe_description)
|
import GHC.IO.Exception (ioe_description)
|
||||||
import RIO hiding (bracket, fromString)
|
import RIO hiding (bracket, fromString)
|
||||||
|
@ -134,8 +133,8 @@ withLogFile :: MonadUnliftIO m => FilePath -> (Handle -> m a) -> m a
|
||||||
withLogFile logfile f = do
|
withLogFile logfile f = do
|
||||||
p <- (</> logfile) . dataDir <$> liftIO getDirectories
|
p <- (</> logfile) . dataDir <$> liftIO getDirectories
|
||||||
catchIO (withBinaryFile p AppendMode f) $ \e -> do
|
catchIO (withBinaryFile p AppendMode f) $ \e -> do
|
||||||
liftIO $ print e
|
liftIO $ TI.putStrLn $ T.pack $ show e
|
||||||
liftIO $ putStrLn "could not open log file, falling back to stderr"
|
liftIO $ TI.putStrLn "could not open log file, falling back to stderr"
|
||||||
f stderr
|
f stderr
|
||||||
|
|
||||||
hRunXIO :: Bool -> Handle -> XIO a -> IO a
|
hRunXIO :: Bool -> Handle -> XIO a -> IO a
|
||||||
|
@ -520,7 +519,7 @@ getParams = do
|
||||||
maybe (return defParams) (liftIO . decodeYaml) p
|
maybe (return defParams) (liftIO . decodeYaml) p
|
||||||
where
|
where
|
||||||
decodeYaml p =
|
decodeYaml p =
|
||||||
either (\e -> print e >> return defParams) return
|
either (\e -> TI.putStrLn (T.pack $ show e) >> return defParams) return
|
||||||
=<< decodeFileEither p
|
=<< decodeFileEither p
|
||||||
|
|
||||||
getParamFile :: MonadIO m => m (Maybe FilePath)
|
getParamFile :: MonadIO m => m (Maybe FilePath)
|
||||||
|
|
Loading…
Reference in New Issue