monky 2.1.0.0 → 2.1.3.0
raw patch · 13 files changed
+346/−115 lines, 13 filesdep ~netlinkdep ~pulseaudio
Dependency ranges changed: netlink, pulseaudio
Files
- Monky.hs +67/−28
- Monky/CPU.hs +15/−8
- Monky/CUtil.hsc +82/−0
- Monky/Examples/Sound/Pulse.hs +16/−28
- Monky/Outputs/Ascii.hs +12/−6
- Monky/Outputs/Dzen2.hs +18/−8
- Monky/Outputs/Guess.hs +17/−5
- Monky/Outputs/I3.hs +6/−5
- Monky/Outputs/Modify.hs +49/−0
- Monky/Outputs/Utf8.hs +14/−7
- Monky/Utility.hs +35/−15
- bin/Main.hs +11/−2
- monky.cabal +4/−3
Monky.hs view
@@ -33,51 +33,90 @@ other functions later on. -} module Monky- ( startLoop- )+ ( startLoop+ , startLoopT+ ) where --import Control.Concurrent (threadDelay)+import System.Timeout+import Data.Time.Clock.POSIX+import Control.Concurrent.MVar import Data.IORef (IORef, readIORef, writeIORef, newIORef, atomicWriteIORef) import Monky.Modules-import Control.Monad (when)+import Control.Monad (when, void) import Control.Concurrent (forkIO) data ModuleWrapper = MWrapper Modules (IORef [MonkyOut]) -- |Packs a module into a wrapper with an IORef for cached output-packMod :: Modules -> IO ModuleWrapper-packMod x@(Poll (NMW m _)) = do- sref <- newIORef []- initialize m- return (MWrapper x sref)-packMod x@(Evt (DW m)) = do- sref <- newIORef []- _ <- forkIO (startEvtLoop m (atomicWriteIORef sref))- return $ MWrapper x sref+packMod :: MVar Bool -> Modules -> IO ModuleWrapper+packMod _ x@(Poll (NMW m _)) = do+ sref <- newIORef []+ initialize m+ return (MWrapper x sref)+packMod mvar x@(Evt (DW m)) = do+ sref <- newIORef []+ _ <- forkIO . startEvtLoop m $ \val -> do+ atomicWriteIORef sref val+ void $ tryPutMVar mvar True+ return $ MWrapper x sref getWrapperText :: Int -> ModuleWrapper -> IO [MonkyOut] getWrapperText tick (MWrapper (Poll (NMW m i)) r) = do- when (tick `mod` i == 0) (writeIORef r =<< getOutput m)- readIORef r+ when (tick `mod` i == 0) (writeIORef r =<< getOutput m)+ readIORef r getWrapperText _ (MWrapper (Evt _) r) = readIORef r doMonkyLine :: MonkyOutput o => Int -> o -> [ModuleWrapper] -> IO () doMonkyLine t o xs =- doLine o =<< mapM (getWrapperText t) xs+ doLine o =<< mapM (getWrapperText t) xs -mainLoop :: MonkyOutput o => Int -> o -> [ModuleWrapper] -> IO ()-mainLoop t o xs = do- doMonkyLine t o xs- threadDelay 1000000- mainLoop (t+1) o xs+doCachedLine :: MonkyOutput o => o -> [ModuleWrapper] -> IO ()+doCachedLine out xs =+ doLine out =<< mapM (\(MWrapper _ r) -> readIORef r) xs --- |Start the mainLoop of monky. This should be the return type of your main+waitTick :: MonkyOutput o => Int -> MVar Bool -> o -> [ModuleWrapper] -> IO ()+waitTick limit mvar out xs = do+ pre <- getPOSIXTime+ ret <- timeout limit $ takeMVar mvar+ case ret of+ Nothing -> return ()+ Just _ -> do+ doCachedLine out xs+ post <- getPOSIXTime+ let passed = round . (* 1000000) $ post - pre+ if passed > limit+ then return ()+ else waitTick (limit - passed) mvar out xs++mainLoop :: MonkyOutput o => Int -> MVar Bool -> Int -> o -> [ModuleWrapper] -> IO ()+mainLoop l r t o xs = do+ doMonkyLine t o xs+ waitTick l r o xs+ mainLoop l r (t+1) o xs++{- | Start the mainLoop of monky. With custom tick timer (in μs)++For 1s tick-timer pass @1000000@ to this.+This does not scale the timers for collection modules passed into it.+So if @500000@ is passed here, and a collector should update every second+it needs to update every 2nd tick, so it has to be scaled.++@+ startLoop getAsciiOut [ pollPack 1 $ getRawCPU ]++ startLoopT 500000 getAsciiOut [ pollPack 2 $ getRawCPU ]+@+-}+startLoopT :: MonkyOutput o => Int -> IO o -> [IO Modules] -> IO ()+startLoopT t out mods = do+ mvar <- newEmptyMVar+ m <- sequence mods+ l <- mapM (packMod mvar) m+ o <- out+ mainLoop t mvar 0 o l++-- | Start the mainLoop of monky. This should be the return type of your main startLoop :: MonkyOutput o => IO o -> [IO Modules] -> IO ()-startLoop o mods = do- m <- sequence mods- l <- mapM packMod m- out <- o- mainLoop 0 out l+startLoop out mods = startLoopT 1000000 out mods
Monky/CPU.hs view
@@ -1,5 +1,5 @@ {-- Copyright 2015 Markus Ongyerth, Stephan Guenther+ Copyright 2015-2017 Markus Ongyerth, Stephan Guenther This file is part of Monky. @@ -115,16 +115,23 @@ getCPUFreqsMax = mapM (fopen . pathMaxScaling) --- |Check if thermal zone is x86_pkg_temp-isX86PkgTemp :: String -> Bool-isX86PkgTemp xs = unsafePerformIO $do- str <- readFile (thermalBaseP ++ xs ++ "/type")- return (str == "x86_pkg_temp\n")+-- | Check if thermal zone is x86_pkg_temp+checkType :: (String -> Bool) -> String -> Bool+checkType f xs = unsafePerformIO $ do+ f <$> readFile (thermalBaseP ++ xs ++ "/type") --- |Try to guess the thermal zones+-- | Get the filter function for the thermal zone getter+thermalGuesser :: String -> Bool+thermalGuesser =+ let (ma, mi) = getKernelVersion+ in if ma <= 3 && mi <= 13+ then checkType ("pkg-temp-" `isPrefixOf`)+ else checkType (== "x86_pkg_temp\n")++-- | Try to guess the thermal zones guessThermalZones :: IO [String] guessThermalZones = do- filter isX86PkgTemp . filter ("thermal_zone" `isPrefixOf`) <$> tzones+ filter thermalGuesser . filter ("thermal_zone" `isPrefixOf`) <$> tzones where tzones = getDirectoryContents thermalBaseP -- |Tries to guess the thermal zone based on type
+ Monky/CUtil.hsc view
@@ -0,0 +1,82 @@+{-+ Copyright 2017 Markus Ongyerth++ This file is part of Monky.++ Monky is free software: you can redistribute it and/or modify+ it under the terms of the GNU Lesser General Public License as published by+ the Free Software Foundation, either version 3 of the License, or+ (at your option) any later version.++ Monky is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU Lesser General Public License for more details.++ You should have received a copy of the GNU Lesser General Public License+ along with Monky. If not, see <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-|+Module : Monky.CUtil+Description : Provides C utility functions+Maintainer : ongy+Stability : testing+Portability : Linux++This provides low-level utility wrappers used by Monky.Util+-}+module Monky.CUtil+ ( UName(..)+ , uname+ )+where++import Data.Word (Word)+import Foreign.Ptr+import Foreign.C.Types++import Data.Text (Text)+import qualified Data.Text.Foreign as T++import Foreign.Storable+import Foreign.Marshal.Alloc++import Control.Applicative ((<$>), (<*>))++#include <sys/utsname.h>++foreign import ccall unsafe "strlen" c_strlen :: Ptr CChar -> IO Word+foreign import ccall unsafe "uname" c_uname :: Ptr UName -> IO ()++-- | The haskell type for Cs utsname (man uname)+data UName = UName+ { _uSysName :: Text+ , _uNodeName :: Text+ , _uRelease :: Text+ , _uVersion :: Text+ , _uMachine :: Text+ } deriving (Eq, Show)++peekCString :: Ptr CChar -> IO Text+peekCString ptr = do+ len <- c_strlen ptr+ T.peekCStringLen (ptr, fromIntegral len)++instance Storable UName where+ sizeOf _ = #{size struct utsname}+ alignment _ = alignment (undefined :: CLong)+ peek p = UName+ <$> peekCString (#{ptr struct utsname, sysname} p)+ <*> peekCString (#{ptr struct utsname, nodename} p)+ <*> peekCString (#{ptr struct utsname, release} p)+ <*> peekCString (#{ptr struct utsname, version} p)+ <*> peekCString (#{ptr struct utsname, machine} p)+ poke _ _ = error "There is no reason we should EVER poke a struct utsname. Please check your code."++-- | Get a UName structure for the current kernel+uname :: IO UName+uname = alloca $ \ptr -> do+ c_uname ptr+ peek ptr
Monky/Examples/Sound/Pulse.hs view
@@ -38,13 +38,12 @@ where import Monky.Modules-import Data.Maybe (fromMaybe) import Control.Monad (void)-import Control.Concurrent.MVar-import Control.Concurrent+import Control.Monad.IO.Class import System.Environment (getProgName) +import Sound.Pulse import Sound.Pulse.Context import Sound.Pulse.Mainloop import Sound.Pulse.Mainloop.Simple@@ -83,32 +82,22 @@ else sformat ((left 3 ' ' %. int) % "%") (round rvol :: Int) fun [MonkyPlain str] --- |Start the subscription loop that will give us the updates.-startLoop :: Context -> ([MonkyOut] -> IO ()) -> Sinkinfo -> IO ()-startLoop cxt cfun info = do - void $ subscribeEvents cxt [SubscriptionMaskSink] fun- printSink cfun info- where fun :: ((SubscriptionEventFacility, SubscriptionEventType) -> Word32 -> IO ())- fun _ 0 = void $ getContextSinkByIndex cxt (siIndex info) (printSink cfun)- fun _ _ = return ()---- |Use the name (string) to find the index, print once and find the main loop-startWithName :: Context -> String -> ([MonkyOut] -> IO ()) -> IO ()-startWithName cxt name fun = void $ getContextSinkByName cxt name (startLoop cxt fun)---- |Get the default sink and start the main loop-getDefaultSink :: Context -> ([MonkyOut] -> IO ()) -> IO ()-getDefaultSink cxt cfun = void $ getServerInfo cxt fun- where fun :: ServerInfo -> IO ()- fun serv = let name = defaultSinkName serv- in startWithName cxt name cfun+-- | Find the index of our sink and register the event handler+startLoopM :: Maybe String -> ([MonkyOut] -> IO ()) -> Pulse ()+startLoopM str fun = do+ name <- maybe (defaultSinkName <$> getServerInfoM) return str+ sink <- getContextSinkByNameM name+ void $ subscribeEventsM [SubscriptionMaskSink] (sub $ siIndex sink)+ liftIO $ printSink fun sink+ where sub :: Word32 -> Context -> ((SubscriptionEventFacility, SubscriptionEventType) -> Word32 -> IO ())+ sub i cxt _ 0 = void $ getContextSinkByIndex cxt i (printSink fun)+ sub _ _ _ _ = return () --- |Try to start pulse loop. silently fail!+-- | Try to start pulse loop. silently fail! startPulse :: Maybe String -> ([MonkyOut] -> IO ()) -> IO () startPulse = startPulseMaybe (return ()) ---- |Connect to pulse server and try to start the main loop for this module.+-- | Connect to pulse server and try to start the main loop for this module. startPulseMaybe :: IO () -- ^The continuation if everything fails -> Maybe String -- ^Sink to use (Nothing for default)@@ -124,9 +113,8 @@ ContextFailed -> do hPutStrLn stderr "Could not connect to pulse :(" quitLoop impl (-1)- ContextReady -> fromMaybe- (getDefaultSink cxt fun )- (startWithName cxt <$> sinkName <*> return fun)+ ContextReady ->+ runPulse_ cxt (startLoopM sinkName fun) _ -> return () _ <- connectContext cxt Nothing [] _ <- doLoop impl
Monky/Outputs/Ascii.hs view
@@ -17,7 +17,6 @@ along with Monky. If not, see <http://www.gnu.org/licenses/>. -} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE EmptyDataDecls #-} {-| Module : Monky.Outputs.Ascii Description : Output module for Ascii@@ -30,6 +29,7 @@ module Monky.Outputs.Ascii ( AsciiOutput , getAsciiOut+ , getAsciiOutDiv ) where @@ -39,7 +39,7 @@ import qualified Data.Text.IO as T -- |The output handle for a ascii pipe-data AsciiOutput = AsciiOutput+data AsciiOutput = AsciiOutput MonkyOut doOut :: MonkyOut -> IO () doOut (MonkyPlain t) = T.putStr t@@ -57,11 +57,17 @@ doSegment x putStr "\n" hFlush stdout- doLine h (x:xs) = do+ doLine h@(AsciiOutput d) (x:xs) = do doSegment x- putStr " | "+ doOut d doLine h xs --- |Get an output handle for ascii formatting+-- |Get an output handle for ascii formatting. Divider Defaults to @" | "@ getAsciiOut :: IO AsciiOutput-getAsciiOut = return AsciiOutput+getAsciiOut = getAsciiOutDiv $ MonkyPlain " | "++-- |Get an output handle for ascii formatting+getAsciiOutDiv+ :: MonkyOut -- ^The Divider+ -> IO AsciiOutput+getAsciiOutDiv = return . AsciiOutput
Monky/Outputs/Dzen2.hs view
@@ -30,6 +30,7 @@ ( DzenOutput , getDzenOut , getDzenOut'+ , getDzenOutDiv ) where @@ -42,19 +43,19 @@ import qualified Data.Text.IO as T -- |The output handle for dzen2 pipe-data DzenOutput = DzenOutput Int Text+data DzenOutput = DzenOutput Int Text MonkyOut doOut :: DzenOutput -> MonkyOut -> IO () doOut _ (MonkyPlain t) = T.putStr t-doOut (DzenOutput _ p) (MonkyImage path _) = do+doOut (DzenOutput _ p _) (MonkyImage path _) = do T.putStr ("^i(" `T.append` p) T.putStr path T.putStr ".xbm) "-doOut (DzenOutput h _) (MonkyBar p) = do+doOut (DzenOutput h _ _) (MonkyBar p) = do T.putStr "^p(3)^p(_TOP)^r(6x" putStr . show $ h - div (h * p) 100 T.putStr ")^pa()"-doOut (DzenOutput h _) (MonkyHBar p) = do+doOut (DzenOutput h _ _) (MonkyHBar p) = do T.putStr "^r(" putStr . show $ p T.putStr ("x" `T.append` (T.pack . show $ h `div` 2) `T.append` ")")@@ -77,24 +78,33 @@ doSegment h x putStr "\n" hFlush stdout- doLine h (x:xs) = do+ doLine h@(DzenOutput _ _ d) (x:xs) = do doSegment h x- putStr " | "+ doOut h d doLine h xs -- |Get an output handle for dzen2 formatting+-- Assumes @" | "@ as divider getDzenOut :: Int -- ^The height of your dzen bar in pixel (required for block-drawing) -> Text -- ^Path to the directory cointaining your .xbm files. -> IO DzenOutput-getDzenOut h = return . DzenOutput h . flip T.append "/"+getDzenOut h p = return $ DzenOutput h (T.append p "/") $ MonkyPlain " | " -- |Get the output handle for dzen2 formatting. Will asume your .xbm files are--- |in <monkydir>/xbm/+-- in \<monkydir\>\/xbm\/ getDzenOut' :: Int -- ^The height of your dzen bar in pixel (for block drawing) -> IO DzenOutput getDzenOut' h = do pwd <- getCurrentDirectory getDzenOut h (T.pack pwd `T.append` "/xbm/")++-- |Get an output handle for dzen2 formatting+getDzenOutDiv+ :: Int -- ^The height of your dzen bar in pixel (required for block-drawing)+ -> Text -- ^Path to the directory containing your .xbm files.+ -> MonkyOut -- ^Divider+ -> IO DzenOutput+getDzenOutDiv h p d = return $ DzenOutput h (T.append p "/") d
Monky/Outputs/Guess.hs view
@@ -19,6 +19,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} {-| Module : Monky.Outputs.Guess Description : Guess the output that should be used based on pipe@@ -30,6 +31,7 @@ module Monky.Outputs.Guess ( guessOutput , GuessOut+ , guessOutputDiv ) where @@ -46,7 +48,7 @@ import Monky.Modules import Monky.Outputs.Fallback (chooseTerminalOut) import Monky.Outputs.Show (getShowOut)-import Monky.Outputs.Dzen2 (getDzenOut)+import Monky.Outputs.Dzen2 (getDzenOutDiv) import Monky.Outputs.I3 (getI3Output) import Monky.Outputs.Serialize (getSerializeOut) @@ -122,10 +124,11 @@ chooseProcessOut :: Int -> Text+ -> MonkyOut -> String -> IO GuessOut-chooseProcessOut height path x- | x == "dzen2" = GO <$> getDzenOut height path+chooseProcessOut height path divider x+ | x == "dzen2" = GO <$> getDzenOutDiv height path divider | x == "i3bar" = GO <$> getI3Output | x `elem`networkOuts = GO <$> getSerializeOut | otherwise = GO <$> getShowOut@@ -135,9 +138,18 @@ :: Int -- ^Dzen height -> Text -- ^Dzen xbm path -> IO GuessOut-guessOutput height path = do+guessOutput height path = guessOutputDiv height path $ MonkyPlain " | "++-- | Guess output based on isatty and other side of the stdout fd+guessOutputDiv+ :: Int -- ^Dzen height+ -> Text -- ^Dzen xbm path+ -> MonkyOut -- ^The Divider to use+ -> IO GuessOut+guessOutputDiv height path divider = do out <- getOutputType case out of Terminal -> GO <$> chooseTerminalOut Other -> {- for other we just use show -} GO <$> getShowOut- (Process x) -> chooseProcessOut height path x+ (Process x) -> chooseProcessOut height path divider x+
Monky/Outputs/I3.hs view
@@ -51,6 +51,10 @@ i3Full :: Text -> Text i3Full xs = "\"full_text\": \"" `T.append` xs `T.append` "\"" +makeColor :: Text -> Text -> Text+makeColor "" _ = ""+makeColor x y = T.concat [ ", \"", y, "\": \"", x, "\"" ]+ getOut :: MonkyOut -> Text getOut (MonkyPlain t) = i3Full t getOut (MonkyImage _ c) = i3Full $ T.singleton c -- Images are not supported :(@@ -58,11 +62,8 @@ getOut (MonkyHBar p) = i3Full $ T.pack (replicate (p `div` 10) '█') `T.append` (T.singleton $ hBarChar (p `mod` 10 * 10)) getOut (MonkyColor (f, b) o) = T.concat [ getOut o- , ", \"color\": \""- , f- , "\", \"background\": \""- , b- , "\""+ , makeColor f "color"+ , makeColor b "background" ] doSegment :: [MonkyOut] -> IO ()
+ Monky/Outputs/Modify.hs view
@@ -0,0 +1,49 @@+{-+ Copyright 2016 Markus Ongyerth++ This file is part of Monky.++ Monky is free software: you can redistribute it and/or modify+ it under the terms of the GNU Lesser General Public License as published by+ the Free Software Foundation, either version 3 of the License, or+ (at your option) any later version.++ Monky is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU Lesser General Public License for more details.++ You should have received a copy of the GNU Lesser General Public License+ along with Monky. If not, see <http://www.gnu.org/licenses/>.+-}+{-# LANGUAGE CPP #-}+{-|+Module : Monky.Output.Modify+Description : Monky module that modifies other outputs behaviour+Maintainer : ongy+Stability : testing+Portability : Linux++-}+module Monky.Outputs.Modify+ ( ModifyOutput+ , getModifyOutput+ )+where++#if MIN_VERSION_base(4,8,0)+#else+import Control.Applicative ((<$>))+#endif++import Monky.Modules++-- |Handle for modifying a line before it's passed to the output+data ModifyOutput a = MH ([[MonkyOut]] -> [[MonkyOut]]) a++-- |Get a handle to purely modify a line+getModifyOutput :: ([[MonkyOut]] -> [[MonkyOut]]) -> IO a -> IO (ModifyOutput a)+getModifyOutput = fmap . MH++instance MonkyOutput a => MonkyOutput (ModifyOutput a) where+ doLine (MH f x) line = doLine x $ f line
Monky/Outputs/Utf8.hs view
@@ -17,7 +17,6 @@ along with Monky. If not, see <http://www.gnu.org/licenses/>. -} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE EmptyDataDecls #-} {-| Module : Monky.Outputs.Utf8 Description : Output module for utf8@@ -30,6 +29,7 @@ module Monky.Outputs.Utf8 ( Utf8Output , getUtf8Out+ , getUtf8OutDiv ) where @@ -40,11 +40,11 @@ import qualified Data.Text.IO as T -- |The output handle for a utf8 pipe-data Utf8Output = Utf8Output+data Utf8Output = Utf8Output MonkyOut doOut :: MonkyOut -> IO () doOut (MonkyPlain t) = T.putStr t-doOut (MonkyImage _ c) = putChar c -- Images are not supported :(+doOut (MonkyImage _ c) = putChar c -- Images are not supported :( doOut (MonkyBar p) = putChar (barChar p) doOut (MonkyHBar p) = do putStr $ replicate (p `div` 10) '█'@@ -60,11 +60,18 @@ doSegment x putStr "\n" hFlush stdout- doLine h (x:xs) = do+ doLine h@(Utf8Output d) (x:xs) = do doSegment x- putStr " | "+ doOut d doLine h xs --- |Get an output handle for utf8 formatting+-- |Get an output handle for utf8 formatting. Divider defaults to @" | "@ getUtf8Out :: IO Utf8Output-getUtf8Out = return Utf8Output+getUtf8Out = getUtf8OutDiv $ MonkyPlain " | "+++-- |Get an output handle for utf8 formatting.+getUtf8OutDiv+ :: MonkyOut -- ^The divider between segments+ -> IO Utf8Output+getUtf8OutDiv = return . Utf8Output
Monky/Utility.hs view
@@ -1,5 +1,5 @@ {-- Copyright 2015,2016 Markus Ongyerth, Stephan Guenther+ Copyright 2015-2017 Markus Ongyerth, Stephan Guenther This file is part of Monky. @@ -28,26 +28,34 @@ This module provides utility functions used in monky modules -} module Monky.Utility- ( readValue- , readValues- , fopen- , fclose- , File- , readLine- , readContent- , findLine- , splitAtEvery- , maybeOpenFile- , sdivBound- , sdivUBound- , listDirectory- )+ ( readValue+ , readValues+ , fopen+ , fclose+ , File+ , readLine+ , readContent+ , findLine+ , splitAtEvery+ , maybeOpenFile+ , sdivBound+ , sdivUBound+ , listDirectory+ , C.UName+ , getUname+ , getKernelVersion+ ) where +import Data.Word (Word)+import qualified Monky.CUtil as C import System.IO+import System.IO.Unsafe (unsafePerformIO) import Data.List (isPrefixOf) import Data.Maybe (fromMaybe)+import qualified Data.Text as T+import qualified Data.Text.Read as T import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS @@ -172,3 +180,15 @@ sdivUBound x y _ = x `div` y infixl 7 `sdivBound`, `sdivUBound`++-- This should never change while we are on the same kernel+-- | Get the kernel name/version/release and so forth+getUname :: C.UName+getUname = unsafePerformIO C.uname++-- | Get the kernel version as (major, minor)+getKernelVersion :: (Word, Word)+getKernelVersion =+ let txt = T.splitOn (T.pack ".") . C._uRelease $ getUname+ (Right major: Right minor:_) = fmap T.decimal txt+ in (fst major, fst minor)
bin/Main.hs view
@@ -43,6 +43,7 @@ ) where +import GHC.IO.Handle (hDuplicate) import Monky.Version (getVersion) import Control.Monad (when, unless) import Data.List (isSuffixOf, nub, sort)@@ -50,7 +51,7 @@ import System.Exit (ExitCode(..), exitFailure) import System.IO (withFile, IOMode(..), hPutStr, hPutStrLn, stderr) import System.Posix.Process (executeFile)-import System.Process (system)+import System.Process (shell, waitForProcess, CreateProcess(..), createProcess, StdStream(..)) import Data.Monoid ((<>)) import Options.Applicative@@ -153,12 +154,20 @@ files <- getDirectoryContents "." return $ "monky.hs" `notElem` files +runGHC :: Config -> IO ExitCode+runGHC c = do+ let com = "ghc " ++ compilerFlags ++ " monky.hs -o " ++ exeName c+ let proc = shell com+ file <- hDuplicate stderr+ (_, _, _, h) <- createProcess proc { std_out = UseHandle file }+ waitForProcess h + compile :: Config -> IO () compile c = unless (confNoCompile c) $ do exists <- doesFileExist "monky.hs" when exists $ do- ret <- system ("ghc " ++ compilerFlags ++ " monky.hs -o " ++ exeName c)+ ret <- runGHC c case ret of (ExitFailure _) -> do hPutStrLn stderr "Compilation failed"
monky.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 2.1.0.0+version: 2.1.3.0 -- The ABOVE LINE has to stay AS IS (except for version changes) for the -- template to work properly@@ -145,10 +145,11 @@ exposed-modules: Monky.Outputs.Dzen2 Monky.Outputs.Ascii Monky.Outputs.Utf8 Monky.Outputs.Guess exposed-modules: Monky.Outputs.Show Monky.Outputs.Fallback Monky.Outputs.Serialize Monky.Outputs.I3+ exposed-modules: Monky.Outputs.Modify exposed-modules: Monky.Examples.Modify Monky.IP Monky.IP.Raw exposed-modules: Monky.Outputs.Unicode Monky.Examples.Images- other-modules: Monky.Template Monky.VersionTH+ other-modules: Monky.Template Monky.VersionTH Monky.CUtil build-depends: base >=4.6.0.1 && <=5, directory, time@@ -173,7 +174,7 @@ if impl(ghc >= 7.8) if flag(pulse)- build-depends: pulseaudio+ build-depends: pulseaudio >= 0.0.2.0 && < 0.1.0.0 exposed-modules: Monky.Examples.Sound.Pulse ghc-options: -Wall