diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,165 @@
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+ This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+ 0. Additional Definitions.
+
+ As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+ "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+ An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+ A "Combined Work" is a work produced by combining or linking an
+Application with the Library. The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+ The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+ The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+ 1. Exception to Section 3 of the GNU GPL.
+
+ You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+ 2. Conveying Modified Versions.
+
+ If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+ a) under this License, provided that you make a good faith effort to
+ ensure that, in the event an Application does not supply the
+ function or data, the facility still operates, and performs
+ whatever part of its purpose remains meaningful, or
+
+ b) under the GNU GPL, with none of the additional permissions of
+ this License applicable to that copy.
+
+ 3. Object Code Incorporating Material from Library Header Files.
+
+ The object code form of an Application may incorporate material from
+a header file that is part of the Library. You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+ a) Give prominent notice with each copy of the object code that the
+ Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the object code with a copy of the GNU GPL and this license
+ document.
+
+ 4. Combined Works.
+
+ You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+ a) Give prominent notice with each copy of the Combined Work that
+ the Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the Combined Work with a copy of the GNU GPL and this license
+ document.
+
+ c) For a Combined Work that displays copyright notices during
+ execution, include the copyright notice for the Library among
+ these notices, as well as a reference directing the user to the
+ copies of the GNU GPL and this license document.
+
+ d) Do one of the following:
+
+ 0) Convey the Minimal Corresponding Source under the terms of this
+ License, and the Corresponding Application Code in a form
+ suitable for, and under terms that permit, the user to
+ recombine or relink the Application with a modified version of
+ the Linked Version to produce a modified Combined Work, in the
+ manner specified by section 6 of the GNU GPL for conveying
+ Corresponding Source.
+
+ 1) Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (a) uses at run time
+ a copy of the Library already present on the user's computer
+ system, and (b) will operate properly with a modified version
+ of the Library that is interface-compatible with the Linked
+ Version.
+
+ e) Provide Installation Information, but only if you would otherwise
+ be required to provide such information under section 6 of the
+ GNU GPL, and only to the extent that such information is
+ necessary to install and execute a modified version of the
+ Combined Work produced by recombining or relinking the
+ Application with a modified version of the Linked Version. (If
+ you use option 4d0, the Installation Information must accompany
+ the Minimal Corresponding Source and Corresponding Application
+ Code. If you use option 4d1, you must provide the Installation
+ Information in the manner specified by section 6 of the GNU GPL
+ for conveying Corresponding Source.)
+
+ 5. Combined Libraries.
+
+ You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+ a) Accompany the combined library with a copy of the same work based
+ on the Library, uncombined with any other library facilities,
+ conveyed under the terms of this License.
+
+ b) Give prominent notice with the combined library that part of it
+ is a work based on the Library, and explaining where to find the
+ accompanying uncombined form of the same work.
+
+ 6. Revised Versions of the GNU Lesser General Public License.
+
+ The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+ If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
diff --git a/Monky.hs b/Monky.hs
new file mode 100644
--- /dev/null
+++ b/Monky.hs
@@ -0,0 +1,83 @@
+{-
+ Copyright 2015 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-|
+Module : Monky
+Description : The main module for monky
+Maintainer : ongy, moepi
+Stability : testing
+Portability : Linux
+
+This module contains the main logic for monky.
+This has to be included in the Monky.hs. The entry point for monky is startLoop
+which has to be called with a ['IO' 'Modules'].
+This type was chosen to make the syntax in the config file prettier.
+
+The submodules of this generally provide an interface based on handles.
+To use them, get the handle at the beginning of you application and hand it to
+other functions later on.
+-}
+module Monky
+ ( startLoop
+ )
+where
+
+
+import Control.Concurrent (threadDelay)
+import Data.IORef (IORef, readIORef, writeIORef, newIORef, atomicWriteIORef)
+import Monky.Modules
+import Control.Monad (when)
+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
+
+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
+getWrapperText _ (MWrapper (Evt _) r) = readIORef r
+
+doMonkyLine :: MonkyOutput o => Int -> o -> [ModuleWrapper] -> IO ()
+doMonkyLine t o 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
+
+-- |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
diff --git a/Monky/Alsa.hsc b/Monky/Alsa.hsc
new file mode 100644
--- /dev/null
+++ b/Monky/Alsa.hsc
@@ -0,0 +1,306 @@
+{-
+ Copyright 2015 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-|
+Module : Monky.Alsa
+Description : Allows acces to information about the alsa sound system
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+This module provides access to basic audio information provided by the alsa
+audio system.
+This MAY work with pulse, but will report useless/inaccurate values.
+-}
+module Monky.Alsa
+ ( VOLHandle
+ , destroyVOLHandle
+ , getMute
+ , getVolumeRaw
+ , getVolumePercent
+ , updateVOLH
+ , getVOLHandle
+ , isLoaded
+ , getPollFDs
+ )
+where
+
+import Control.Monad.Trans
+import Control.Monad.Trans.Except
+import Data.IORef
+import Foreign.C.String (CString, withCString)
+import Foreign.C.Types (CInt(..), CShort, CLong)
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Array
+import Foreign.Ptr
+import Foreign.Storable
+import Monky.Template
+import System.Posix.Types
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+#include
+
+data PollFD = POLLFD CInt CShort CShort
+
+instance Storable PollFD where
+ sizeOf _ = #{size struct pollfd}
+ alignment _ = alignment (undefined :: CLong)
+ peek p = do
+ fd <- #{peek struct pollfd, fd} p
+ events <- #{peek struct pollfd, events} p
+ revents <- #{peek struct pollfd, revents} p
+ return (POLLFD fd events revents)
+ poke p (POLLFD fd events revents) = do
+ #{poke struct pollfd, fd} p fd
+ #{poke struct pollfd, events} p events
+ #{poke struct pollfd, revents} p revents
+
+type PollFDPtr = Ptr PollFD
+
+liftExceptT :: ((a -> m (Either e b)) -> m (Either e b)) -> (a -> ExceptT e m b) -> ExceptT e m b
+liftExceptT g f = ExceptT (g (runExceptT . f))
+
+data RegOpt
+data MClass
+
+data Mixer
+type MixerHandle = Ptr Mixer
+type MixerHandleAlloc = Ptr MixerHandle
+
+data Sid
+type SidHandle = Ptr Sid
+type SidHandleAlloc = Ptr SidHandle
+
+data Elem
+type ElemHandle = Ptr Elem
+
+importLib "LibAlsa" "libasound.so"
+ [ ("mixer_open", "snd_mixer_open", "MixerHandleAlloc -> Int -> IO CInt")
+ , ("mixer_attach", "snd_mixer_attach", "MixerHandle -> CString -> IO CInt")
+ , ("mixer_register", "snd_mixer_selem_register", "MixerHandle -> Ptr RegOpt -> Ptr MClass -> IO CInt")
+ , ("mixer_load", "snd_mixer_load", "MixerHandle -> IO CInt")
+
+ , ("sid_sindex", "snd_mixer_selem_id_set_index", "SidHandle -> CInt -> IO ()")
+ , ("sid_sname", "snd_mixer_selem_id_set_name", "SidHandle -> CString -> IO ()")
+ , ("sid_alloc", "snd_mixer_selem_id_malloc", "SidHandleAlloc -> IO CInt")
+ , ("sid_free", "snd_mixer_selem_id_free", "SidHandle -> IO ()")
+
+ , ("elem_gvrange", "snd_mixer_selem_get_playback_volume_range", "ElemHandle -> Ptr CInt -> Ptr CInt -> IO CInt")
+ , ("elem_gvol", "snd_mixer_selem_get_playback_volume", "ElemHandle -> CInt -> Ptr CInt -> IO CInt")
+ , ("elem_gmute", "snd_mixer_selem_get_playback_switch", "ElemHandle -> CInt -> Ptr CInt -> IO CInt")
+
+ , ("elem_find", "snd_mixer_find_selem", "MixerHandle -> SidHandle -> IO ElemHandle")
+ , ("mixer_handle_events", "snd_mixer_handle_events", "MixerHandle -> IO ()")
+ , ("get_pdescs", "snd_mixer_poll_descriptors", "MixerHandle -> PollFDPtr -> CInt -> IO CInt")
+ , ("get_pdescc", "snd_mixer_poll_descriptors_count", "MixerHandle -> IO CInt")
+
+ , ("mixer_close", "snd_mixer_close", "MixerHandle -> IO Int")
+ ]
+
+
+
+
+getPollDescs :: MixerHandle -> LibAlsa -> IO [CInt]
+getPollDescs h l = do
+ count <- get_pdescc l h
+ allocaArray (fromIntegral count) $ \ptr -> do
+ c2 <- get_pdescs l h ptr count
+ if count == c2
+ then map (\(POLLFD fd _ _) -> fd) <$> (peekArray (fromIntegral c2) ptr)
+ else error "libalsa returned more (or less) fds than it adveritses!"
+
+
+openMixer :: LibAlsa -> ExceptT Int IO MixerHandle
+openMixer l = liftExceptT alloca $ \ptr -> do
+ rval <- liftIO (mixer_open l ptr 0)
+ if rval < 0
+ then throwE $ fromIntegral rval
+ else liftIO (peek ptr)
+
+
+mixerAttach :: MixerHandle -> String -> LibAlsa -> ExceptT Int IO ()
+mixerAttach handle card l = do
+ rval <- liftIO (withCString card $ mixer_attach l handle)
+ if rval < 0
+ then throwE $ fromIntegral rval
+ else liftIO (return ())
+
+
+mixerRegister :: MixerHandle -> LibAlsa -> ExceptT Int IO ()
+mixerRegister handle l = do
+ rval <- liftIO (mixer_register l handle nullPtr nullPtr)
+ if rval < 0
+ then throwE $ fromIntegral rval
+ else liftIO (return ())
+
+
+mixerLoad :: MixerHandle -> LibAlsa -> ExceptT Int IO ()
+mixerLoad handle l = do
+ rval <- liftIO (mixer_load l handle)
+ if rval < 0
+ then throwE $ fromIntegral rval
+ else liftIO (return ())
+
+
+withSid :: LibAlsa -> (SidHandle -> IO a) -> IO a
+withSid l fun = alloca $ \ptr -> do
+ rval <- sid_alloc l ptr
+ if rval < 0
+ then error "Failed to allocate sid"
+ else do
+ handle <- peek ptr
+ comp <- fun handle
+ sid_free l handle
+ return comp
+
+
+sidSet :: SidHandle -> Int -> String -> LibAlsa -> IO ()
+sidSet handle index name l = do
+ withCString name $ sid_sname l handle
+ sid_sindex l handle $ fromIntegral index
+
+
+getElem :: MixerHandle -> String -> Int -> LibAlsa -> IO ElemHandle
+getElem handle name index l = withSid l $ \sid -> do
+ sidSet sid index name l
+ elem_find l handle sid
+
+
+isMute :: ElemHandle -> LibAlsa -> IO Bool
+isMute handle l = alloca $ \ptr -> do
+ _ <- elem_gmute l handle 0 ptr
+ val <- peek ptr
+ return $ val == 0
+
+
+getVolumeRange :: ElemHandle -> LibAlsa -> IO (Int, Int)
+getVolumeRange handle l = alloca $ \lower -> alloca $ \upper -> do
+ _ <- elem_gvrange l handle lower upper
+ lowerv <- peek lower
+ upperv <- peek upper
+ return (fromIntegral lowerv, fromIntegral upperv)
+
+
+getVolume :: ElemHandle -> LibAlsa -> IO Int
+getVolume handle l = alloca $ \ptr -> do
+ _ <- elem_gvol l handle 0 ptr
+ val <- peek ptr
+ return $ fromIntegral val
+
+
+getMixerHandle :: String -> LibAlsa -> ExceptT Int IO MixerHandle
+getMixerHandle card l = do
+ handle <- openMixer l
+ mixerAttach handle card l
+ mixerRegister handle l
+ mixerLoad handle l
+ return handle
+
+
+percentize :: Int -> Int -> Int -> Int
+percentize val lower upper = 100 * (val - lower) `div` (upper-lower)
+
+
+-- |The handle exported by this module
+data VOLHandle = VOLH LibAlsa MixerHandle ElemHandle (IORef Int) (IORef Bool) Int Int | Err
+
+{- |Update the volume handle.
+
+This function has to be called to update the handle internally.
+Calling this will get the current state into the handle, which can then by
+queried by the other functions. Until this is called again, the results of other
+functions will not update to the current state of the system.
+-}
+updateVOLH :: VOLHandle -> IO ()
+updateVOLH (VOLH l handle ehandle valr muter _ _) = do
+ mixer_handle_events l handle
+ val <- getVolume ehandle l
+ mute <- isMute ehandle l
+ writeIORef valr val
+ writeIORef muter mute
+updateVOLH Err = return ()
+
+-- |Get the raw volume value from alsa
+getVolumeRaw :: VOLHandle -> IO Int
+getVolumeRaw (VOLH _ _ _ valr _ _ _) = readIORef valr
+getVolumeRaw Err = return 0
+
+{- |Get the volume in percent (100% = loudest 0%=lowest)
+
+0% does not equal a muted device.
+-}
+getVolumePercent :: VOLHandle -> IO Int
+getVolumePercent (VOLH _ _ _ valr _ lower upper) = do
+ val <- readIORef valr
+ return $ percentize val lower upper
+getVolumePercent Err = return 0
+
+-- |return 'True' if the device is muted
+getMute :: VOLHandle -> IO Bool
+getMute (VOLH _ _ _ _ muter _ _) = readIORef muter
+getMute Err = return True
+
+
+getVOLHandleInt :: Either Int MixerHandle -> LibAlsa -> IO VOLHandle
+getVOLHandleInt (Right handle) l = do
+ ehandle <- getElem handle "Master" 0 l
+ if ehandle == nullPtr
+ then return Err
+ else do
+ (lower, upper) <- getVolumeRange ehandle l
+ val <- getVolume ehandle l
+ mute <- isMute ehandle l
+ volref <- newIORef val
+ muteref <- newIORef mute
+ return (VOLH l handle ehandle volref muteref lower upper)
+getVOLHandleInt _ _ = return Err
+
+-- |Check if there was an error creating the handle
+isLoaded :: VOLHandle -> Bool
+isLoaded Err = False
+isLoaded _ = True
+
+
+-- |Get PollFds for polling interface
+getPollFDs :: VOLHandle -> IO [Fd]
+getPollFDs (VOLH l h _ _ _ _ _) = map Fd <$> getPollDescs h l
+getPollFDs Err = return []
+
+-- | Close the mixer handle and unload alsa library
+destroyVOLHandle :: VOLHandle -> IO ()
+destroyVOLHandle (VOLH a m _ _ _ _ _) =
+ mixer_close a m >> destroyLibAlsa a
+destroyVOLHandle Err = return ()
+
+{- |Create an 'VOLHandle'
+
+This function returns a type save error value if any alsa function fails
+-}
+getVOLHandle :: String -- ^The audio-card to use
+ -> IO VOLHandle
+getVOLHandle card = do
+ l <- getLibAlsa
+ handle <- runExceptT (getMixerHandle card l)
+ getVOLHandleInt handle l
diff --git a/Monky/Battery.hs b/Monky/Battery.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Battery.hs
@@ -0,0 +1,194 @@
+{-
+ Copyright 2015 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-# LANGUAGE CPP #-}
+{-|
+Module : Monky.Battery
+Description : Allows access to information about a battery connected to the system
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+This module allows to read information about a battery connected to the system.
+
+This module does not support every setup yet.
+The files in /sys/ used by this module are driver dependend.
+If it crashes monky for you setup please make a bug report with an
+`ls /sys/class/power_supply/" ++ e ++ "/` attached.
+-}
+
+module Monky.Battery
+ ( getBatteryHandle
+ , getBatteryHandle'
+ , getCurrentStatus
+ , getCurrentLevel
+ , BatteryHandle
+ , getTimeLeft
+ , getLoading
+ , BatteryState(..)
+ )
+where
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+import Data.Maybe (fromMaybe)
+import Data.IORef
+import System.Directory
+import Monky.Utility
+
+-- FilesArray for the files, those have to be handled different so they
+-- get their own type for pattern matching
+-- Everything needed as state will be carried in the battery handle
+-- |The handle exported by this module
+data BatteryHandle = BatH FilesArray (IORef Int)
+
+--PowerNow will use: power_now energy_now energy_full
+--ChargeNow will use: voltage_now current_now current_avg charge_now charge_full
+data FilesArray = PowerNow File File File File |
+ ChargeNow File File (Maybe File) File File File deriving(Show)
+
+-- |Datatype to represent battery state
+data BatteryState = BatFull | BatLoading | BatDraining
+
+pnowPath :: String -> String
+pnowPath e = "/sys/class/power_supply/" ++ e ++ "/power_now"
+enowPath :: String -> String
+enowPath e = "/sys/class/power_supply/" ++ e ++ "/energy_now"
+efullPath :: String -> String
+efullPath e = "/sys/class/power_supply/" ++ e ++ "/energy_full"
+vnowPath :: String -> String
+vnowPath e = "/sys/class/power_supply/" ++ e ++ "/voltage_now"
+cnowPath :: String -> String
+cnowPath e = "/sys/class/power_supply/" ++ e ++ "/current_now"
+cavgPath :: String -> String
+cavgPath e = "/sys/class/power_supply/" ++ e ++ "/current_avg"
+chnowPath :: String -> String
+chnowPath e = "/sys/class/power_supply/" ++ e ++ "/charge_now"
+chfullPath :: String -> String
+chfullPath e = "/sys/class/power_supply/" ++ e ++ "/charge_full"
+adpPath :: String -> String
+adpPath e = "/sys/class/power_supply/"++ e ++"/online"
+
+-- |Internal function for getCurrentStatus
+getCurrentStatusInt :: File -> IO Int
+getCurrentStatusInt = readValue
+
+
+getCurrentStatusM :: BatteryHandle -> IO Int
+getCurrentStatusM (BatH (PowerNow _ _ _ adp) _) =
+ getCurrentStatusInt adp
+getCurrentStatusM (BatH (ChargeNow _ _ _ _ _ adp) _) =
+ getCurrentStatusInt adp
+
+-- |Get the current state of the battery (loading/draining/full)
+getCurrentStatus :: BatteryHandle -> IO BatteryState
+getCurrentStatus h = do
+ val <- getCurrentStatusM h
+ case val of
+ 1 -> return BatLoading
+ 0 -> return BatDraining
+ _ -> return BatFull
+
+-- |Internal function for getcurrentLevel
+getCurrentLevelInt :: File -> File -> IO Int
+getCurrentLevelInt n f = do
+ now <- readValue n
+ full <- readValue f
+ return $ now * 100 `div` full
+
+-- |Get the charge left in the battery in percent.
+getCurrentLevel :: BatteryHandle -> IO Int
+getCurrentLevel (BatH (PowerNow _ now full _) _) =
+ getCurrentLevelInt now full
+getCurrentLevel (BatH (ChargeNow _ _ _ now full _) _) =
+ getCurrentLevelInt now full
+
+
+-- |Internal function for getTimeLeft
+getTimeLeftInt :: File -> File -> File -> Int -> File -> IO (Int, Int)
+getTimeLeftInt n c f s adp = do
+ online <- getCurrentStatusInt adp
+ now <- readValue n
+ full <- readValue f
+ let gap = if online == 0 then now else full - now
+ change <- readValue c
+ let avg = (change * 20 + s * 80) `div` 100
+ return (if avg >= 3600 then gap `div` (avg `div` 3600) else 0, avg)
+
+-- |Get current loading speed in Watt/s
+getLoading :: BatteryHandle -> IO Float
+getLoading (BatH (PowerNow pnow _ _ _) _) = do
+ power <- readLine pnow
+ return $(read power :: Float) / 1000000
+getLoading (BatH (ChargeNow vnow cnow _ _ _ _) _) = do
+ voltage <- readLine vnow
+ current <- readLine cnow
+ let pow = ((read voltage :: Float) * (read current :: Float)) / 1000000000000
+ return pow
+
+-- |Get an approximated amount of seconds left until the battery runs out
+getTimeLeft :: BatteryHandle -> IO Int
+getTimeLeft (BatH (PowerNow pnow enow efull adp) s)= do
+ c <- readIORef s
+ (t, n) <- getTimeLeftInt enow pnow efull c adp
+ writeIORef s n
+ return t
+getTimeLeft (BatH (ChargeNow _ cnow cavg chnow chfull adp) s)= do
+ c <- readIORef s
+ (t, _) <- getTimeLeftInt chnow (fromMaybe cnow cavg) chfull c adp
+ return $ (floor . sqrt $(fromIntegral t :: Float)) * 60
+
+-- |Create a power handle that uses the power_now file
+createPowerNowHandle :: String -> String -> IO BatteryHandle
+createPowerNowHandle e b = do
+ power_now <- fopen $ pnowPath b
+ energy_now <- fopen $ enowPath b
+ energy_full <- fopen $ efullPath b
+ adp_online <- fopen $ adpPath e
+ ref <- newIORef (0 :: Int)
+ return $BatH (PowerNow power_now energy_now energy_full adp_online) ref
+
+-- |Create a power handle that uses the charge_now file
+createChargeNowHandle :: String -> String -> IO BatteryHandle
+createChargeNowHandle e b = do
+ voltage_now <- fopen $ vnowPath b
+ current_now <- fopen $ cnowPath b
+ exists <- doesFileExist $ cavgPath b
+ current_avg <- if exists then Just <$> fopen (cavgPath b) else return Nothing
+ charge_now <- fopen $ chnowPath b
+ charge_full <- fopen $ chfullPath b
+ adp_online <- fopen $ adpPath e
+ ref <- newIORef (0 :: Int)
+ return $BatH (ChargeNow voltage_now current_now current_avg charge_now charge_full adp_online) ref
+
+-- |Create a 'BatteryHandle'
+getBatteryHandle :: String -- ^The name of the wall socket adapter used by the battery
+ -> String -- ^The name of the battery
+ -> IO BatteryHandle
+getBatteryHandle e b = do
+ exists <- doesFileExist $ pnowPath b
+ if exists
+ then createPowerNowHandle e b
+ else createChargeNowHandle e b
+
+-- |Version which defaults to "BAT0"
+getBatteryHandle' :: String -> IO BatteryHandle
+getBatteryHandle' = flip getBatteryHandle "BAT0"
diff --git a/Monky/Blkid.hs b/Monky/Blkid.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Blkid.hs
@@ -0,0 +1,103 @@
+{-
+ Copyright 2015 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE CPP #-}
+{-|
+Module : Monky.Blkid
+Description : Minimal access to liblkid
+Maintainer : ongy
+Stability : experimental
+Portability : Linux
+
+This module allows access to libblkid functionality
+
+Since the library does not have to exist on every system we link
+against it on runtime when needed.
+We don't have a handle or something cool like that, so we will just
+load it when needed und unload again after
+-}
+module Monky.Blkid
+ ( evaluateTag
+ , evaluateSpec
+ , evaluateTag'
+ , evaluateSpec'
+ , withLibBlkid
+ )
+where
+
+import Monky.Template
+
+import Foreign.Ptr
+import Foreign.C.String
+import Foreign.Marshal.Alloc
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+
+data Cache
+
+importLib "LibBlkid" "libblkid.so"
+ [ ( "c_evt", "blkid_evaluate_tag", "CString -> CString -> Ptr Cache -> IO CString")
+ , ( "c_evs", "blkid_evaluate_spec", "CString -> Ptr Cache -> IO CString")
+ ]
+
+getAndFreeString :: CString -> IO String
+getAndFreeString ptr = do
+ ret <- peekCString ptr
+ free ptr
+ return ret
+
+
+maybeGetString :: CString -> IO (Maybe String)
+maybeGetString ptr = if ptr == nullPtr
+ then return Nothing
+ else Just <$> getAndFreeString ptr
+
+-- |Version to reuse the LibBlkid
+evaluateTag' :: String -> String -> LibBlkid -> IO (Maybe String)
+evaluateTag' t v l = do
+ ptr <- withCString t (\ct -> withCString v (\cv -> c_evt l ct cv nullPtr))
+ maybeGetString ptr
+
+-- |version to reuse the LibBlkid
+evaluateSpec' :: String -> LibBlkid -> IO (Maybe String)
+evaluateSpec' s l = do
+ ptr <- withCString s (\cs -> c_evs l cs nullPtr)
+ maybeGetString ptr
+
+-- |Evaluate a tag
+evaluateTag :: String -> String -> IO (Maybe String)
+evaluateTag t v = withLibBlkid $ evaluateTag' t v
+
+-- |Evaluate a spec
+evaluateSpec :: String -> IO (Maybe String)
+evaluateSpec = withLibBlkid . evaluateSpec'
+
+-- |Execute an IO action with an instance of LibBlkid
+withLibBlkid :: (LibBlkid -> IO a) -> IO a
+withLibBlkid a = do
+ l <- getLibBlkid
+ ret <- a l
+ destroyLibBlkid l
+ return ret
diff --git a/Monky/CPU.hs b/Monky/CPU.hs
new file mode 100644
--- /dev/null
+++ b/Monky/CPU.hs
@@ -0,0 +1,251 @@
+{-
+ Copyright 2015 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-# LANGUAGE CPP #-}
+{-|
+Module : Monky.CPU
+Description : Allows access to information about the systems cpu
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+-}
+module Monky.CPU
+ ( CPUHandle
+ , TempHandle
+ , FreqHandle
+ , NumaHandle(..)
+ , getCPUHandle
+ , getCPUPercent
+ , getNumaPercent
+ , getCPUTemp
+ , getCPUMaxScalingFreq
+ , ScalingType(..)
+ , getNumaHandles
+
+ , guessThermalZone
+ , getThermalZone
+ , getThermalZones
+
+ , getFreqHandle
+ , getFreqNuma
+ )
+where
+
+import Data.Char (isDigit)
+import System.IO.Unsafe (unsafePerformIO)
+import System.Directory (getDirectoryContents)
+import Monky.Utility
+import Data.List (isPrefixOf)
+import Data.Maybe (listToMaybe, fromMaybe)
+import Data.IORef
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as BS (readInt, words, unpack)
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+
+{- Stat work all-}
+-- |The handle exported by this module
+data CPUHandle = CPUH File (IORef [Int]) (IORef [Int])
+-- |The handle for themperature
+newtype TempHandle = TH (Maybe File)
+-- |The handle for cpu frequency
+newtype FreqHandle = FH [File]
+
+-- Wrapper around numa nodes for stat reading
+-- |Numa aware version of 'CPUHandle'
+data NumaHandle = NumaHandle
+ { numaCpus :: [String]
+ , numaHandle :: CPUHandle
+ }
+
+
+-- |Which values should be returned by getCPUFreq
+data ScalingType
+ = ScalingMax -- ^Use the maximum frequencie allowed
+ | ScalingCur -- ^Use the current frequencie used
+ | ScalingNone -- ^Don't open any files for scaling type
+
+
+pathStat :: String
+pathStat = "/proc/stat"
+
+pathCPUBase :: String
+pathCPUBase = "/sys/devices/system/cpu"
+
+thermalBaseP :: String
+thermalBaseP = "/sys/class/thermal/"
+
+pathTemp :: String -> String
+pathTemp zone = thermalBaseP ++ zone ++ "/temp"
+
+pathMaxScaling :: String -> String
+pathMaxScaling str = "/sys/devices/system/cpu/" ++ str ++ "/cpufreq/scaling_max_freq"
+
+pathCurScaling :: String -> String
+pathCurScaling str = "/sys/devices/system/cpu/" ++ str ++ "/cpufreq/scaling_cur_freq"
+
+pathNumaBase :: String
+pathNumaBase = "/sys/devices/system/node/"
+
+getCPUFreqsCur :: [String] -> IO [File]
+getCPUFreqsCur = mapM (fopen . pathCurScaling)
+
+getCPUFreqsMax :: [String] -> IO [File]
+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")
+
+-- |Try to guess the thermal zones
+guessThermalZones :: IO [String]
+guessThermalZones = do
+ filter isX86PkgTemp . filter ("thermal_zone" `isPrefixOf`) <$> tzones
+ where tzones = getDirectoryContents thermalBaseP
+
+-- |Tries to guess the thermal zone based on type
+guessThermalZone :: IO (Maybe String)
+guessThermalZone = fmap listToMaybe guessThermalZones
+
+-- |Calcualate the work done by the cores (all, work)
+calculateWork :: [[Int]] -> ([Int], [Int])
+calculateWork xs =
+ let work = map (sum . take 3) xs
+ sall = zipWith (\x y -> x + sum y) work (map (drop 3) xs) in
+ (sall, work)
+
+
+calculatePercent :: [Int] -> [Int] -> [Int] -> [Int] -> [Int]
+calculatePercent sall work owork oall =
+ let cwork = zipWith (-) work owork
+ call = zipWith (-) sall oall in
+ zipWith (sdivBound . (* 100)) cwork call
+
+
+readVals :: [ByteString] -> [Int]
+readVals = map (fst . fromMaybe (error "CPUModule: Something in /proc/stat was unexpted") . BS.readInt) . tail
+
+
+getPercent :: ([String] -> Bool) -> CPUHandle -> IO [Int]
+getPercent f (CPUH file aref wref) = do
+ content <- map BS.words <$> readContent file
+ let cpus = filter (f . map BS.unpack) content
+ let d = map readVals cpus
+ let (sall, work) = calculateWork d
+ a <- readIORef aref
+ w <- readIORef wref
+ writeIORef wref work
+ writeIORef aref sall
+ return $ calculatePercent sall work w a
+
+-- |Get the cpu usage in percent for each (virtual) cpu
+getCPUPercent :: CPUHandle -> IO [Int]
+getCPUPercent = getPercent (\(x:_) -> "cpu" `isPrefixOf` x && length x > 3)
+
+-- |Read node information
+getNumaPercent :: NumaHandle -> IO [Int]
+getNumaPercent (NumaHandle cpus h) =
+ getPercent (\xs -> head xs `elem` cpus) h
+
+-- |get current CPU temperature
+getCPUTemp :: TempHandle -> IO Int
+getCPUTemp (TH Nothing) = return (-1)
+getCPUTemp (TH (Just f)) = do
+ temp <- readValue f
+ return (temp `div` 1000)
+
+
+getMax :: [Int] -> Int
+getMax = foldr max (-1)
+
+{- |This function returns a frequency according the 'ScalingType' of the handle.
+
+The returned valued will be the max of all (virtual) proceessors on the system.
+-}
+getCPUMaxScalingFreq :: FreqHandle -> IO Float
+getCPUMaxScalingFreq (FH files) = do
+ vals <- mapM readValue files
+ return (fromIntegral (getMax vals) / 1000000)
+
+-- open the files to read the frequency from
+getCPUFreqs :: ScalingType -> [String] -> IO [File]
+getCPUFreqs ScalingMax = getCPUFreqsMax
+getCPUFreqs ScalingCur = getCPUFreqsCur
+getCPUFreqs ScalingNone = (\_ -> return [])
+
+
+getCPUs :: String -> IO [String]
+getCPUs = fmap (filter isCPU) . getDirectoryContents
+ where isCPU ys = "cpu" `isPrefixOf` ys && all isDigit (drop 3 ys)
+
+
+-- |Get a frequency handle by type
+getFreqHandle :: ScalingType -> IO FreqHandle
+getFreqHandle t = do
+ cpus <- getCPUs pathCPUBase
+ FH <$> getCPUFreqs t cpus
+
+-- |Get a frequency handle limited to the cpus the numa handle uses
+getFreqNuma :: ScalingType -> NumaHandle -> IO FreqHandle
+getFreqNuma t (NumaHandle cpus _) =
+ FH <$> getCPUFreqs t cpus
+
+
+getHandle :: String -> IO NumaHandle
+getHandle path = do
+ getNumaHandle =<< getCPUs path
+
+-- |Raw-ish access to numa handle, this can be (ab)used to make your own filter on cpus
+getNumaHandle
+ :: [String] -- ^CPU "names" to include ([cpu0, cpu1, cpu2, ..])
+ -> IO NumaHandle
+getNumaHandle cpus = do
+ workref <- newIORef ([0] :: [Int])
+ allref <- newIORef ([0] :: [Int])
+ stat <- fopen pathStat
+ return $ NumaHandle cpus (CPUH stat allref workref)
+
+-- |Create an 'CPUHandle'
+getCPUHandle :: IO CPUHandle
+getCPUHandle = numaHandle <$> getHandle pathCPUBase
+
+-- |Get the CPUs thermal zone
+getThermalZone :: String -> IO TempHandle
+getThermalZone = fmap (TH . Just) . fopen . pathTemp
+
+-- |Get the CPUs thermal zones, will be same order as numa nodes (hopefully)
+getThermalZones :: IO [TempHandle]
+getThermalZones = do
+ real <- mapM (fmap (TH . Just) . fopen . pathTemp) =<< guessThermalZones
+ return (real ++ repeat (TH Nothing))
+
+-- |Get the Numa aware handle
+getNumaHandles :: IO [NumaHandle]
+getNumaHandles = do
+ nodes <- filter isNode <$> getDirectoryContents pathNumaBase
+ mapM (getHandle . (pathNumaBase ++)) nodes
+ where isNode = ("node" `isPrefixOf`)
diff --git a/Monky/Connectivity.hsc b/Monky/Connectivity.hsc
new file mode 100644
--- /dev/null
+++ b/Monky/Connectivity.hsc
@@ -0,0 +1,173 @@
+{-
+ 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 .
+-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE LambdaCase #-}
+{-|
+Module : Monky.Connectivity
+Description : Allows the user to get a connected state
+Maintainer : ongy
+Stability : experimental
+Portability : Linux
+
+This module checks periodically if the current system
+can establish a network connection (TCP) to a given host
+on a given port. It does not care about reject, it is
+intended to test whether a firewall drops packages or
+a (tethered) connection is stable.
+-}
+module Monky.Connectivity
+ ( ConnHandle
+ , getConnH
+ , hasConn
+ )
+where
+
+import Data.Bits ((.|.))
+import Control.Concurrent (threadWaitWrite, threadDelay, forkIO)
+import Data.Word (Word64,Word32,Word16)
+import Foreign.C.Error (getErrno, Errno(..), eINPROGRESS)
+import Foreign.C.Types (CInt(..), CLong(..))
+import Foreign.Marshal.Utils (with)
+import Foreign.Marshal.Alloc (alloca, allocaBytes)
+import Foreign.Ptr (Ptr, castPtr)
+import Foreign.C.String (CString, withCString, peekCString)
+import Foreign.C.Types (CChar)
+import Foreign.Storable (Storable(..))
+import System.Posix.Types (Fd(..))
+import System.Timeout (timeout)
+import Data.IORef (IORef, newIORef, writeIORef, readIORef)
+
+
+import System.IO.Unsafe (unsafePerformIO)
+
+#include
+#include
+#include
+
+-- |The Haskell type for the C struct sockaddr
+newtype Port = Port Word16 deriving (Eq, Show)
+newtype IP4 = IP4 Word32 deriving (Eq)
+data Sockaddr = Socka Int Port IP4 deriving (Eq, Show)
+
+-- |Raw socket calls, we node those
+foreign import ccall "socket" c_socket :: CInt -> CInt -> CInt -> IO CInt
+foreign import ccall "close" c_close :: CInt -> IO ()
+foreign import ccall "connect" c_connect :: CInt -> Ptr Sockaddr -> CInt -> IO CInt
+
+foreign import ccall "inet_pton" c_pton :: CInt -> CString -> Ptr IP4 -> IO ()
+foreign import ccall "inet_ntop" c_ntop :: CInt -> Ptr IP4 -> Ptr CChar -> Word64 -> IO (Ptr CChar)
+-- This isn't really IO, since it is deterministic and doesn't have sideeffects
+foreign import ccall "htons" htons :: Word16 -> Word16
+foreign import ccall "htonl" htonl :: Word32 -> Word32
+foreign import ccall "ntohl" ntohl :: Word32 -> Word32
+
+
+instance Storable Sockaddr where
+ sizeOf _ = #{size struct sockaddr_in}
+ alignment _ = alignment (undefined :: CLong)
+ peek p = do
+ fam <- #{peek struct sockaddr_in, sin_family} p
+ port <- #{peek struct sockaddr_in, sin_port} p
+ ip <- #{peek struct sockaddr_in, sin_addr} p
+ return (Socka fam (Port port) (IP4 ip))
+ poke p (Socka fam (Port port) (IP4 ip)) = do
+ #{poke struct sockaddr_in, sin_family} p fam
+ #{poke struct sockaddr_in, sin_port} p port
+ #{poke struct sockaddr_in, sin_addr} p ip
+
+
+instance Storable IP4 where
+ sizeOf _ = 4
+ alignment _ = alignment (undefined :: Word32)
+ -- be compatible with the default implementation hsc chooses
+ peek p = fmap (IP4 . ntohl) . peek $ castPtr p
+ poke p (IP4 w) = poke (castPtr p) $ htonl w
+
+
+
+instance Show IP4 where
+ show = showIP
+
+
+showIPIO :: IP4 -> IO String
+showIPIO ip = allocaBytes #{const INET_ADDRSTRLEN} (\str ->
+ with ip (\ptr -> c_ntop #{const AF_INET} ptr str #{const INET_ADDRSTRLEN}) >> peekCString str)
+
+-- All sideeffects are contained in the IO action and it is deterministic, so we can drop the IO
+showIP :: IP4 -> String
+showIP ip = unsafePerformIO (showIPIO ip)
+{-# NOINLINE showIP #-}
+
+
+parseIPIO :: String -> IO IP4
+parseIPIO xs =
+ withCString xs (\str -> do
+ alloca (\ptr -> c_pton #{const AF_INET} str ptr >> peek ptr))
+
+-- All sideeffects are contained in the IO action and it is deterministic, so we can drop the IO
+parseIP :: String -> IP4
+parseIP str = unsafePerformIO (parseIPIO str)
+{-# NOINLINE parseIP #-}
+
+
+-- TODO maybe create an echo service so we don't have to do the socket call all the time
+tryConn :: String -> Int -> IO Bool
+tryConn ip port = do
+ socket <- c_socket #{const AF_INET} (#{const SOCK_STREAM} .|. #{const SOCK_NONBLOCK}) 0
+ -- This will always be -1 because of how unblocking sockets work
+ _ <- with (Socka #{const AF_INET} (Port . htons $fromIntegral port) (parseIP ip))
+ (\ptr ->c_connect socket ptr (fromIntegral $sizeOf (undefined :: Sockaddr)))
+ (Errno con) <- getErrno
+ ret <- if (Errno con) == eINPROGRESS
+ then timeout (500 * 1000) (threadWaitWrite (Fd socket)) >>=
+ \case
+ Nothing -> return True
+ Just _ -> return False
+ else return False
+ c_close socket
+ return ret
+
+-- |The handle exposed by this module
+data ConnHandle = ConnH String Int (IORef Bool)
+
+
+-- |Get the current connected state from the handle
+hasConn :: ConnHandle -> IO Bool
+hasConn (ConnH _ _ r) = readIORef r
+
+
+updateLoop :: ConnHandle -> IO ()
+updateLoop h@(ConnH ip port ref) = do
+ writeIORef ref =<< tryConn ip port
+ -- Sleep 1 second
+ threadDelay (1000*1000)
+ updateLoop h
+
+-- |Get a handle to check for connectivity
+getConnH
+ :: String -- ^The Host to use for connectivity probing
+ -> Int -- ^Which port to use for connecivity probing (drop is bad)
+ -> IO ConnHandle
+getConnH ip port = do
+ ref <- newIORef False
+ let h = ConnH ip port ref
+ _ <- forkIO (updateLoop h)
+ return h
+
+
diff --git a/Monky/Disk.hs b/Monky/Disk.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Disk.hs
@@ -0,0 +1,109 @@
+{-
+ Copyright 2015 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-|
+Module : Monky.Disk
+Description : Allows access to information about a btrfs pool
+Maintainer : moepi
+Stability : experimental
+Portability : Linux
+
+This module allows for some support for btrfs devices.
+This may be renamed in the future when a general block-device module appears.
+-}
+module Monky.Disk
+ ( DiskHandle
+ , getDiskReadWrite
+ , getDiskFree
+ , getDiskHandle
+ )
+where
+
+import Monky.Utility
+import Data.Time.Clock.POSIX
+import Data.IORef
+
+import Monky.Disk.Common
+import Monky.Disk.Btrfs
+import Monky.Disk.Device
+
+-- |The handle xported by this module
+-- A disk may have multiple physical devices so we use lists for them
+data DiskHandle = DiskH FSI [File] [IORef Int] [IORef Int] (IORef POSIXTime)
+
+
+sectorSize :: Int
+sectorSize = 512
+
+
+-- |Get the read write rates from the disk (in bytes/s)
+getDiskReadWrite :: DiskHandle -> IO (Int, Int)
+getDiskReadWrite (DiskH _ fs readrefs writerefs timeref) = do
+ contents <- mapM readValues fs
+ time <- getPOSIXTime
+ let nreads = map (\c -> (c !! 2) * sectorSize) contents
+ let writes = map (\c -> (c !! 6) * sectorSize) contents
+ oreads <- mapM readIORef readrefs
+ owrites <- mapM readIORef writerefs
+ otime <- readIORef timeref
+ let creads = zipWith (-) nreads oreads
+ let cwrites = zipWith (-) writes owrites
+ let ctime = time - otime
+ _ <- sequence $zipWith writeIORef readrefs nreads
+ _ <- sequence $zipWith writeIORef writerefs writes
+ writeIORef timeref time
+ return (sum $map (`sdivBound` round ctime) creads, sum $map (`sdivBound` round ctime) cwrites)
+
+
+-- |Get the space left on the disk
+getDiskFree :: DiskHandle -> IO Int
+getDiskFree (DiskH (FSI h) _ _ _ _) = getFsFree h
+
+
+getBtrfsDH :: (BtrfsHandle, [String]) -> IO DiskHandle
+getBtrfsDH (h, devs) = do
+ -- Open the stat file for each physical device
+ fs <- mapM (\dev -> fopen (blBasePath ++ dev ++ "/stat")) devs
+ -- this gets the right number of IORefs without number hacking
+ wfs <- mapM (\_ -> newIORef 0) devs
+ rfs <- mapM (\_ -> newIORef 0) devs
+ t <- newIORef 0
+ return (DiskH (FSI h) fs wfs rfs t)
+
+
+getBlockDH :: (BlockHandle, String) -> IO DiskHandle
+getBlockDH (h, dev) = do
+ f <- fopen (blBasePath ++ dev ++ "/stat")
+ wf <- newIORef 0
+ rf <- newIORef 0
+ t <- newIORef 0
+ return (DiskH (FSI h) [f] [wf] [rf] t)
+
+
+-- |Get the disk handle
+getDiskHandle :: String -> IO DiskHandle
+getDiskHandle uuid = do
+-- First try btrfs file systems
+ btrfs <- getBtrfsHandle uuid
+ case btrfs of
+ (Just x) -> getBtrfsDH x
+ Nothing -> do
+ block <- getBlockHandle uuid
+ case block of
+ Just x -> getBlockDH x
+ Nothing -> error "Disk currently does not support your setup"
diff --git a/Monky/Disk/Btrfs.hs b/Monky/Disk/Btrfs.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Disk/Btrfs.hs
@@ -0,0 +1,115 @@
+{-
+ Copyright 2015 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-# LANGUAGE CPP #-}
+{-|
+Module : Monky.Disk.Btrfs
+Description : Allows access to information about a btrfs pool
+Maintainer : ongy
+Stability : experimental
+Portability : Linux
+
+This module allows for some support for btrfs devices.
+This may be renamed in the future when a general block-device module appears.
+-}
+module Monky.Disk.Btrfs
+ ( BtrfsHandle
+ , getBtrfsHandle
+ , getFSDevices
+ )
+where
+
+import Monky.Utility
+import System.Directory (doesDirectoryExist)
+
+import Monky.Disk.Common
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+
+-- Size data metadata system
+-- |The FsInfo exported by this module
+data BtrfsHandle = BtrfsH Int File File File
+
+instance FsInfo BtrfsHandle where
+ getFsSize = return . getSize
+ getFsUsed = getUsed
+
+
+fsBasePath :: String
+fsBasePath = "/sys/fs/btrfs/"
+
+
+sectorSize :: Int
+sectorSize = 512
+
+
+getSize :: BtrfsHandle -> Int
+getSize (BtrfsH s _ _ _) = s
+
+
+getUsed :: BtrfsHandle -> IO Int
+getUsed (BtrfsH _ d m s) = do
+ dv <- readValue d
+ mv <- readValue m
+ sm <- readValue s
+ return $ dv + mv + sm
+
+-- |Get the block devices used by a btrfs FileSystem. This resolves mappers as far as possible
+getFSDevices :: String -> IO [String]
+getFSDevices fs = do
+ let devP = fsBasePath ++ fs ++ "/devices/"
+ concat <$> (mapM mapperToDev =<< listDirectory devP)
+
+
+getBtrfsHandle' :: String -> IO BtrfsHandle
+getBtrfsHandle' fs = do
+ devices <- getFSDevices fs
+ sizes <- mapM (\dev -> fmap read $ readFile (blBasePath ++ dev ++ "/size")) devices
+ let size = sum sizes
+ d <- fopen (fsBasePath ++ fs ++ "/allocation/data/bytes_used")
+ m <- fopen (fsBasePath ++ fs ++ "/allocation/metadata/bytes_used")
+ s <- fopen (fsBasePath ++ fs ++ "/allocation/system/bytes_used")
+ return (BtrfsH (size*sectorSize) d m s)
+
+{-| Try to create a btfshanlde given the UUID
+
+This will create a 'BtrfsHandle' which is an instance of FsInfo and
+a list of block devices that are slaves of our file system.
+
+This allows the upper layer to monitor the read/write rates of all
+block devices that belong to our file system and report them as
+read/write rate for the file system.
+
+Due to compression and encryption the read/write rate on the block
+device may be quite different to the one that application see.
+-}
+getBtrfsHandle
+ :: String -- ^The UUID of the file system to monitor
+ -> IO (Maybe (BtrfsHandle, [String]))
+getBtrfsHandle fs = do
+ e <- doesDirectoryExist (fsBasePath ++ fs)
+ if e
+ then do
+ h <- getBtrfsHandle' fs
+ devs <- getFSDevices fs
+ return $ Just (h, devs)
+ else return Nothing
diff --git a/Monky/Disk/Common.hs b/Monky/Disk/Common.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Disk/Common.hs
@@ -0,0 +1,120 @@
+{-
+ Copyright 2015 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE CPP #-}
+{-|
+Module : Monky.Disk.Common
+Description : Provides the common disk interfaces
+Maintainer : moepi
+Stability : experimental
+Portability : Linux
+
+This provides the class used by file system specific implementations
+-}
+
+module Monky.Disk.Common
+ ( FSI(FSI)
+ , FsInfo(..)
+ , fsToFSI
+
+ , blBasePath
+ , devToMapper
+ , mapperToDev
+ )
+where
+
+import Monky.Utility
+import System.Directory (doesDirectoryExist)
+import Data.List (nub, sort)
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+
+{-| Type class that should be instanciated by file system handlers
+
+The Monky.Disk module is designed to work with different handlers
+specialized for different file systems and a generic block device
+handler.
+
+This typeclass gives the interface a file system handler has to
+implement to be usable.
+-}
+class FsInfo a where
+ -- |Get the bytes free on the file system
+ getFsFree :: a -> IO Int
+ getFsFree h = do
+ s <- getFsSize h
+ u <- getFsUsed h
+ return (s - u)
+ -- |Get the total size of the file system
+ getFsSize :: a -> IO Int
+ getFsSize h = do
+ u <- getFsUsed h
+ f <- getFsFree h
+ return (u + f)
+ -- |Get the bytes used by the file system
+ getFsUsed :: a -> IO Int
+ getFsUsed h = do
+ s <- getFsSize h
+ f <- getFsFree h
+ return (s - f)
+ -- |Get all data, might be more efficient
+ -- (Size, Free, Used)
+ getFsAll :: a -> IO (Int, Int, Int)
+ getFsAll h = do
+ s <- getFsSize h
+ f <- getFsFree h
+ u <- getFsUsed h
+ return (s, f, u)
+
+-- |Existential datatype to wrap 'FsInfo' instances
+data FSI = forall a. FsInfo a => FSI a
+
+-- |Wrap a 'FsInfo' into an 'FSI'
+fsToFSI :: FsInfo a => a -> FSI
+fsToFSI = FSI
+
+-- |The base path of block devices on the system
+blBasePath :: String
+blBasePath = "/sys/class/block/"
+
+-- |Get the physical block devices supporting some device
+mapperToDev :: String -> IO [String]
+mapperToDev x = sort . nub <$> do
+ let path = blBasePath ++ x ++ "/slaves/"
+ e <- doesDirectoryExist path
+ if e
+ then do
+ rec <- mapM mapperToDev =<< listDirectory path
+ return $ concat rec
+ else return [x]
+
+-- |Get the "top most" virtual device(s) based on the physical device
+devToMapper :: String -> IO [String]
+devToMapper x = sort . nub <$> do
+ let path = blBasePath ++ x ++ "/holders/"
+ holders <- listDirectory path
+ if null holders
+ then return [x]
+ else do
+ rec <- mapM devToMapper holders
+ return $ concat rec
diff --git a/Monky/Disk/Device.hs b/Monky/Disk/Device.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Disk/Device.hs
@@ -0,0 +1,113 @@
+{-
+ Copyright 2015 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-# LANGUAGE CPP #-}
+{-|
+Module : Monky.Disk.Device
+Description : Allows access to information about generic block device
+Maintainer : ongy
+Stability : experimental
+Portability : Linux
+
+This module allows to read generic information about a block device
+and its file system.
+
+It only works if the file system is mounted when the handle is created
+since it needs to *find* the mount point to get information about the
+file system
+-}
+module Monky.Disk.Device
+ ( BlockHandle(..)
+ , getBlockHandle
+
+ , devToMount
+ )
+where
+
+import System.Posix.StatVFS
+import Data.Maybe (listToMaybe)
+import Data.List (isSuffixOf)
+
+import Monky.Blkid
+import Monky.Disk.Common
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+
+{- |Get "the" mountpoint of a device.
+
+Returns a mointpoint of a device. If there are multiple mountpoints, this will
+return the first one found.
+First one is mostly determined by order in /proc/mounts and should be the one
+that was mounted first (time since boot).
+-}
+devToMount :: String -> IO (Maybe String)
+devToMount dev = do
+ masters <- devToMapper dev
+ mounts <- map (take 2 . words) . lines <$> readFile "/proc/mounts"
+ return . listToMaybe . map (!! 1) $ filter (isDev masters) mounts
+ where
+ isDev masters [x, _] = any (\master -> ('/':master) `isSuffixOf` x) masters
+ isDev _ _ = error "devToMount: How does take 2 not match [_, _]?"
+
+
+-- Size data metadata system
+-- |The FsInfo handle exported by this module
+data BlockHandle = BlockH FilePath
+
+instance FsInfo BlockHandle where
+ getFsSize = getSize
+ getFsFree = getFree
+
+
+getSize :: BlockHandle -> IO Int
+getSize (BlockH path) = do
+ fstat <- statVFS path
+ return $fromIntegral (fromIntegral (statVFS_blocks fstat) * statVFS_frsize fstat)
+
+
+getFree :: BlockHandle -> IO Int
+getFree (BlockH path) = do
+ fstat <- statVFS path
+ return $fromIntegral (fromIntegral (statVFS_bavail fstat) * statVFS_frsize fstat)
+
+
+getBlockHandle' :: String -> IO (Maybe (BlockHandle, String))
+getBlockHandle' dev = do
+ path <- devToMount dev
+ case path of
+ Just x -> return $Just (BlockH x, dev)
+ Nothing -> return Nothing
+
+{- |Get a fs handle for 'normal' devices
+
+This uses fsStat to get file system information.
+
+fsStat takes the mount point of the file system, so we need to find the mount point.
+
+In case of mapper devices, this is done by going through the chain of slaves.
+-}
+getBlockHandle :: String -> IO (Maybe (BlockHandle, String))
+getBlockHandle fs = do
+ dev <- evaluateTag "UUID" fs
+ case dev of
+ Just x -> getBlockHandle' (reverse $takeWhile (/= '/') $reverse x)
+ Nothing -> return Nothing
diff --git a/Monky/Examples/Alsa.hs b/Monky/Examples/Alsa.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Examples/Alsa.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module : Monky.Examples.Alsa
+Description : An example module instance for the alsa module
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+-}
+module Monky.Examples.Alsa
+ ( getVOLHandle
+ , AlsaH
+ )
+where
+
+import Monky.Alsa hiding (getVOLHandle)
+import qualified Monky.Alsa as A (getVOLHandle)
+import Monky.Modules
+import Monky.Examples.Utility
+
+import Formatting
+import Data.Text (Text)
+
+{- ALSA module -}
+getVolumeStr :: VOLHandle -> IO Text
+getVolumeStr h = do
+ updateVOLH h
+ m <- getMute h
+ v <- getVolumePercent h
+ if m
+ then return "Mute"
+ else return $ sformat ((left 3 ' ' %. int) % "%") v
+
+getVOLOutput :: VOLHandle -> IO [MonkyOut]
+getVOLOutput h = do
+ out <- getVolumeStr h
+ return [MonkyPlain out]
+
+instance PollModule AlsaH where
+ getOutput (AH h) = getVOLOutput h
+
+instance EvtModule AlsaH where
+ startEvtLoop (AH h) r = do
+ [fd] <- getPollFDs h
+ r =<< getOutput (AH h)
+ loopFd h fd r getVOLOutput
+
+-- |The handle type for this module
+newtype AlsaH = AH VOLHandle
+
+-- |Get a handle which allows access to audio (alsa) subsystem information
+getVOLHandle :: String -- ^The audio-card to use
+ -> IO AlsaH
+getVOLHandle = fmap AH . A.getVOLHandle
diff --git a/Monky/Examples/Battery.hs b/Monky/Examples/Battery.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Examples/Battery.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module : Monky.Examples.Battery
+Description : An example module instance for the battery module
+Maintainer : ongy, moepi
+Stability : testing
+Portability : Linux
+
+-}
+module Monky.Examples.Battery
+ ( getBatteryHandle
+ , getBatteryHandle'
+ , BatteryH
+ )
+where
+
+import Formatting
+import Data.Text (Text)
+import Data.Composition ((.:))
+
+import Monky.Modules
+import Monky.Battery hiding (getBatteryHandle, getBatteryHandle')
+import qualified Monky.Battery as B (getBatteryHandle, getBatteryHandle')
+
+{- Battery Module -}
+batteryColor :: BatteryState -> Int -> Text
+batteryColor BatLoading _ = "#5fff5f"
+batteryColor _ p
+ | p < 20 = "#ffff00"
+ | p < 15 = "#ffd700"
+ | p < 10 = "#ffaf00"
+ | p < 5 = "#ff0000"
+ | otherwise = ""
+
+batterySymbol :: BatteryState -> Int -> Text
+batterySymbol BatLoading _ = "ac_01"
+batterySymbol _ p
+ | p < 50 = "bat_low_01"
+ | p < 20 = "bat_empty_01"
+ | otherwise = "bat_full_01"
+
+instance PollModule BatteryH where
+ getOutput (BH bh) = do
+ p <- getCurrentLevel bh
+ s <- getTimeLeft bh
+ online <- getCurrentStatus bh
+ pow <- getLoading bh
+ let h = s `div` 3600
+ m = (s `mod` 3600) `div` 60
+ return
+ [ MonkyImage (batterySymbol online p) '🔋'
+ , MonkyColor (batteryColor online p, "") $
+ MonkyPlain $ sformat (fixed 1 % "W " % int % "% " % (left 2 ' ' %. int) % ":" % (left 2 '0' %. int)) pow p h m
+ ]
+
+-- |The handle type for this module
+newtype BatteryH = BH BatteryHandle
+
+-- |Create a 'BatteryHandle'
+getBatteryHandle :: String -- ^The name of the wall socket adapter used by the battery
+ -> String -- ^The name of the battery
+ -> IO BatteryH
+getBatteryHandle = fmap BH .: B.getBatteryHandle
+
+
+-- |Version of 'getBatteryHandle' that defaults to "BAT0"
+getBatteryHandle' :: String -> IO BatteryH
+getBatteryHandle' = fmap BH . B.getBatteryHandle'
diff --git a/Monky/Examples/CPU.hs b/Monky/Examples/CPU.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Examples/CPU.hs
@@ -0,0 +1,195 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module : Monky.Examples.CPU
+Description : An example module instance for the cpu module
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+-}
+module Monky.Examples.CPU
+ ( getCPUHandle
+ , getCPUHandle'
+ , getNumaHandles
+ , getNumaHandles'
+
+ , C.ScalingType(..)
+
+ , CPUHandle
+ , NumaHandle
+
+ , FreqHandle
+ , TempHandle
+
+ , getFreqHandle
+ , getFreqNuma
+
+ , getTempHandle
+ , getTempHandle'
+ , getTempHandles
+
+ , getRawNumas
+ , getRawCPU
+ )
+where
+
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import Formatting
+import Data.List (intercalate)
+
+import Monky.Modules
+import qualified Monky.CPU as C
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+{- SHARED -}
+
+{- CPU Module -}
+cpuColor :: Int -> Text
+cpuColor p
+ | p < 15 = "#00d700"
+ | p < 50 = "#ffff5f"
+ | p < 90 = "#ffd700"
+ | otherwise = "#ff0000"
+
+printBar :: Int -> MonkyOut
+printBar h =
+ MonkyColor (cpuColor h, "#262626") (MonkyBar h)
+
+printXbm :: MonkyOut
+printXbm = MonkyImage "cpu" ' '--'🖩' Disabled because of compile errors
+
+printFrequency :: Float -> MonkyOut
+printFrequency = MonkyPlain . sformat (fixed 1 % "G")
+
+printThemp :: Int -> MonkyOut
+printThemp = MonkyPlain . sformat (" " % int % "°C")
+
+getNumaNode :: C.NumaHandle -> IO [MonkyOut]
+getNumaNode nh = map printBar <$> C.getNumaPercent nh
+
+-- |Handle to get the cpu usage stats
+newtype RawCPU = RawCPU C.CPUHandle
+-- |Numa aware handle to get cpu usage stats
+newtype RawNuma = RawNuma C.NumaHandle
+
+instance PollModule RawCPU where
+ getOutput (RawCPU h) =
+ map printBar <$> C.getCPUPercent h
+
+instance PollModule RawNuma where
+ getOutput (RawNuma h) = getNumaNode h
+
+-- |Handle to access cpu frequency information
+newtype FreqHandle = FH C.FreqHandle
+-- |Handle to acces thermal zone information
+newtype TempHandle = TH C.TempHandle
+
+instance PollModule FreqHandle where
+ getOutput (FH fh) =
+ return . printFrequency <$> C.getCPUMaxScalingFreq fh
+
+instance PollModule TempHandle where
+ getOutput (TH th) =
+ return . printThemp <$> C.getCPUTemp th
+
+{- NORMAL -}
+-- |The handle type for the default setup
+data CPUHandle = CPH FreqHandle RawCPU TempHandle
+-- |The handle type for the default setup (numa aware)
+data NumaHandle = NUH [(FreqHandle, RawNuma, TempHandle)]
+
+-- |Get a handle to access max node frequency
+getFreqHandle :: C.ScalingType -> IO FreqHandle
+getFreqHandle = fmap FH . C.getFreqHandle
+
+-- |Numa away version of 'getFreqHandle'
+getFreqNuma :: C.ScalingType -> RawNuma -> IO FreqHandle
+getFreqNuma t (RawNuma h) = FH <$> C.getFreqNuma t h
+
+-- |Get the 'TempHandle' for the system (tries to guess CPU zone)
+getTempHandle' :: IO TempHandle
+getTempHandle' = getTempHandle . fromMaybe (error "Could not find thermal zone") =<< C.guessThermalZone
+
+-- |Get a 'TempHandle' for each cpu termal zone on the system. will be infinite list, with invalidated zones for convinience
+getTempHandles :: IO [TempHandle]
+getTempHandles = fmap (map TH ) C.getThermalZones
+
+-- |Get a 'TempHandle' for the specified thermal zone
+getTempHandle :: String -> IO TempHandle
+getTempHandle = fmap TH . C.getThermalZone
+
+-- |Get a raw CPU handle
+getRawCPU :: IO RawCPU
+getRawCPU = RawCPU <$> C.getCPUHandle
+
+-- |Get raw numa aware cpu handles
+getRawNumas :: IO [RawNuma]
+getRawNumas = map RawNuma <$> C.getNumaHandles
+
+{- |Get a 'CPUHandle'
+
+This is a shiny combination of the raw handles exported by this module
+-}
+getCPUHandle
+ :: C.ScalingType -- ^The type of scaling frequency that should be reported
+ -> String -- ^The thermal zone of the cpu
+ -> IO CPUHandle
+getCPUHandle s t = do
+ fh <- getFreqHandle s
+ raw <- getRawCPU
+ th <- getTempHandle t
+ return $ CPH fh raw th
+
+-- |Same as 'getCPUHandle' but tries to guess the thermal zone
+getCPUHandle' :: C.ScalingType -> IO CPUHandle
+getCPUHandle' s = do
+ fh <- getFreqHandle s
+ raw <- getRawCPU
+ th <- getTempHandle'
+ return $ CPH fh raw th
+
+-- |Numa aware version of 'getCPUHandle'
+getNumaHandles
+ :: C.ScalingType -- ^The type of scaling frequency that should be reported
+ -> [String] -- ^A list of thermal zones for our numa handles
+ -> IO NumaHandle
+getNumaHandles st zones = do
+ raw <- getRawNumas
+ th <- mapM getTempHandle zones
+ fh <- mapM (getFreqNuma st) raw
+ return . NUH $ zip3 fh raw th
+
+-- |Same as 'getNumaHandles' but tries to guess the thermal zone
+getNumaHandles' :: C.ScalingType -> IO NumaHandle
+getNumaHandles' st = do
+ raw <- getRawNumas
+ zones <- getTempHandles
+ fh <- mapM (getFreqNuma st) raw
+ return . NUH $ zip3 fh raw zones
+
+
+
+
+formatNumaNode :: (FreqHandle, RawNuma, TempHandle) -> IO [MonkyOut]
+formatNumaNode (fh, rh, th) = do
+ freq <- getOutput fh
+ raw <- getOutput rh
+ temp <- getOutput th
+ return (freq ++ raw ++ temp)
+
+instance PollModule CPUHandle where
+ getOutput (CPH fh rh th) = do
+ cp <- getOutput rh
+ ct <- getOutput th
+ cf <- getOutput fh
+ return (printXbm: cf ++ cp ++ ct)
+
+instance PollModule NumaHandle where
+ getOutput (NUH xs) =
+ (printXbm:) . intercalate [(MonkyPlain (" - "))] <$> mapM formatNumaNode xs
diff --git a/Monky/Examples/Combine.hs b/Monky/Examples/Combine.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Examples/Combine.hs
@@ -0,0 +1,135 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-|
+Module : Monky.Examples.Combine
+Description: Combine multiple modules into one (to avoid seperators)
+Maintainer: ongy
+Stability: testing
+Portability: linux
+
+The functions in this module can be used to avoid printing seperators between modules.
+
+Nearly equivalend example (image is missing):
+
+@
+pollPack 1 $ getCPUHandle' ScalingCur
+pollPack 1 $ (getFreqHandle ScalingCur) `combine` getRawCPU `combine` getTempHandle'
+@
+
+The main function exported by this module are:
+ * 'combine'
+ * 'combineD'
+ * 'combineE'
+ * 'combineF'
+
+They are mainly overloads of the same concept, for combinations of 'EvtModule' and 'PollModule'
+
+The mixed functions ('combineD' and 'combineF') create a 'PollModule'. The 'EvtModule' will update
+a cache in the new module and output will be updated when the 'PollModule' is asked to do so.
+
+NOTE: because of this, the event will be handled when it is detected, but the output will not update
+until the 'PollModule' wrapper ticks once.
+-}
+module Monky.Examples.Combine
+ ( CombiHandle
+ , combine
+
+ , EvtCombi
+ , combineE
+
+ , EPCombi
+ , combineF
+
+ , PECombi
+ , combineD
+ )
+where
+
+import Monky.Modules
+import Control.Concurrent (forkIO)
+import Control.Concurrent.MVar (MVar, withMVar, newMVar)
+import Data.IORef (IORef, readIORef, atomicWriteIORef, newIORef)
+
+-- |Wrapper type for 'PollModule's
+data (PollModule a, PollModule b) => CombiHandle a b = C a b
+
+instance (PollModule a, PollModule b) => PollModule (CombiHandle a b) where
+ getOutput (C a b) = do
+ c <- getOutput a
+ d <- getOutput b
+ return (c ++ d)
+ initialize (C a b) = initialize a >> initialize b
+
+-- |Combine two 'PollModule's. The first arguments output will be printed first
+combine :: (PollModule a, PollModule b) => IO a -> IO b -> IO (CombiHandle a b)
+combine a b = do
+ c <- a
+ d <- b
+ return $ C c d
+
+-- Module handle a, b. IORef for caching a, b. MVar to implement boolean, containing value doesn't matter
+-- |Wrapper type for 'EvtModule's
+data (EvtModule a, EvtModule b) => EvtCombi a b = EC a b (IORef [MonkyOut]) (IORef [MonkyOut]) (MVar Bool)
+
+instance (EvtModule a, EvtModule b) => EvtModule (EvtCombi a b) where
+ startEvtLoop (EC a b r1 r2 m) act = do
+ _ <- forkIO $ startEvtLoop a (\out -> withMVar m $ \_ -> do
+ atomicWriteIORef r1 out
+ other <- readIORef r2
+ act (out ++ other))
+ startEvtLoop b (\out -> withMVar m $ \_ -> do
+ atomicWriteIORef r2 out
+ other <- readIORef r1
+ act (other ++ out))
+
+-- |Combine two 'EvtModule's. The first argument will be printed first.
+combineE :: (EvtModule a, EvtModule b) => IO a -> IO b -> IO (EvtCombi a b)
+combineE a b = do
+ m1 <- a
+ m2 <- b
+ r1 <- newIORef []
+ r2 <- newIORef []
+ m <- newMVar True
+ return $ EC m1 m2 r1 r2 m
+
+-- |Wrapper type for mixed combination.
+data (EvtModule a, PollModule b) => EPCombi a b = EP a b (IORef [MonkyOut])
+
+instance (EvtModule a, PollModule b) => PollModule (EPCombi a b) where
+ initialize (EP a b r) = do
+ startEvtLoop a (atomicWriteIORef r)
+ initialize b
+ getOutput (EP _ b r) = do
+ o1 <- readIORef r
+ o2 <- getOutput b
+ return (o1 ++ o2)
+
+-- |Combine a 'EvtModule' with a 'PollModule'. This will alwasy create a 'PollModule'.
+-- |Event updates will not be displayed until the poll modules ticks once.
+combineF :: (EvtModule a, PollModule b) => IO a -> IO b -> IO (EPCombi a b)
+combineF a b = do
+ m1 <- a
+ m2 <- b
+ r <- newIORef []
+ return $ EP m1 m2 r
+
+
+-- |Wrapper type for mixed combination.
+data (PollModule a, EvtModule b) => PECombi a b = PE a b (IORef [MonkyOut])
+
+instance (PollModule a, EvtModule b) => PollModule (PECombi a b) where
+ initialize (PE a b r) = do
+ startEvtLoop b (atomicWriteIORef r)
+ initialize a
+ getOutput (PE a _ r) = do
+ o1 <- getOutput a
+ o2 <- readIORef r
+ return (o1 ++ o2)
+
+-- |Look at 'combineF' for documentation
+combineD :: (PollModule a, EvtModule b) => IO a -> IO b -> IO (PECombi a b)
+combineD a b = do
+ m1 <- a
+ m2 <- b
+ r <- newIORef []
+ return $ PE m1 m2 r
diff --git a/Monky/Examples/Connectivity.hs b/Monky/Examples/Connectivity.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Examples/Connectivity.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-|
+Module : Monky.Examples.Connectivity
+Description : Simple Connectivity example
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+-}
+module Monky.Examples.Connectivity
+ ( getConnH
+ , Conn
+ )
+where
+
+import Data.Composition ((.:))
+import Data.Text (Text)
+import Monky.Modules
+import Monky.Connectivity hiding (getConnH)
+import qualified Monky.Connectivity as C (getConnH)
+
+showCon :: Bool -> Text
+showCon False = "Unconnected"
+showCon True = " Connected"
+
+-- |The handle type for this module
+newtype Conn = Conn ConnHandle
+
+-- |Get a handle that allows testing for connectivity to a server
+getConnH
+ :: String -- ^The Host to use for connectivity probing
+ -> Int -- ^Which port to use for connecivity probing (drop is bad)
+ -> IO Conn
+getConnH = fmap Conn .: C.getConnH
+
+instance PollModule Conn where
+ getOutput (Conn h) = fmap (\e -> [MonkyPlain $ showCon e]) $ hasConn h
diff --git a/Monky/Examples/Disk.hs b/Monky/Examples/Disk.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Examples/Disk.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module : Monky.Examples.Disk
+Description : An example module instance for the disk module
+Maintainer : moepi
+Stability : testing
+Portability : Linux
+
+-}
+module Monky.Examples.Disk
+ ( getDiskHandle
+ , DiskH
+ )
+where
+
+import Formatting
+
+import Monky.Examples.Utility
+import Monky.Modules
+import Monky.Disk hiding (getDiskHandle)
+import qualified Monky.Disk as D (getDiskHandle)
+
+-- |The handle type for this module
+newtype DiskH = DH DiskHandle
+
+-- |Get a disk handle
+getDiskHandle
+ :: String -- ^The UUID of the device to monitor. It has to be mounted at monky startup!
+ -> IO DiskH
+getDiskHandle = fmap DH . D.getDiskHandle
+
+{- Disk module -}
+instance PollModule DiskH where
+ getOutput (DH dh) = do
+ (dr, dw) <- getDiskReadWrite dh
+ df <- getDiskFree dh
+ return
+ [ MonkyImage "diskette" ' '-- '🖪' also disabled for compat reasons
+ , MonkyPlain $ sformat (stext % " " % stext % " " % stext) (convertUnitSI df "B") (convertUnitSI dr "B" ) (convertUnitSI dw "B")
+ ]
diff --git a/Monky/Examples/File.hs b/Monky/Examples/File.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Examples/File.hs
@@ -0,0 +1,37 @@
+{-|
+Module : Monky.Examples.File
+Description : Display the first line in a file each tick
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+-}
+module Monky.Examples.File
+ ( FileHandle
+ , getFileHandle
+ )
+where
+
+import Monky.Modules
+import Monky.Utility (fopen, readLine, File)
+
+import qualified Data.Text.Encoding as T
+
+-- |The handle type for this module
+newtype FileHandle = FH File
+
+getFile :: FileHandle -> File
+getFile (FH f) = f
+
+-- |Get the file handle
+getFileHandle
+ :: String -- ^Path to the file
+ -> IO FileHandle
+getFileHandle = fmap FH . fopen
+
+instance PollModule FileHandle where
+ getOutput h = do
+ line <- readLine . getFile $ h
+ return [MonkyPlain $ T.decodeUtf8 line]
+
+-- TODO EvtModule with inotify?
diff --git a/Monky/Examples/IBus.hs b/Monky/Examples/IBus.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Examples/IBus.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE CPP #-}
+{-|
+Module : Monky.Examples.IBus
+Description : An example of how to use the ibus-hs package
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+This module provides an example of how to use the ibus-hs package.
+
+This is only usefull if you have ibus installed and active on your
+system.
+
+This module will display the current global engine and provides
+event driven updates.
+For better usability the names returned by ibus can be remapped
+to something more readable by the mapping given to the creation
+function.
+-}
+module Monky.Examples.IBus
+ ( getIBusH
+ , IBusH
+ )
+where
+
+import qualified Data.Text as T
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+import DBus.Client (clientErrorMessage)
+import Control.Exception (try)
+import Control.Monad (void)
+
+import Monky.Modules
+
+import IBus
+import IBus.EngineDesc
+
+-- |The handle type for this module
+data IBusH = IBusH IBusClient [(String, MonkyOut)]
+
+instance PollModule IBusH where
+ getOutput (IBusH h m) = do
+ engine <- try $ engineName <$> getIBusEngine h
+ case engine of
+ (Left e) -> return [MonkyPlain . T.pack $ clientErrorMessage e]
+ (Right x) -> return [remapEngine m x]
+
+instance EvtModule IBusH where
+ startEvtLoop ih@(IBusH h m) r = do
+ r =<< getOutput ih
+ void $ subscribeToEngine h $ \xs -> do
+ let engine = head xs
+ r [remapEngine m engine]
+
+-- |Get an IBusH used by this module
+getIBusH
+ :: [(String, MonkyOut)] -- ^A mapping from engine names to display names for those engines
+ -> IO IBusH -- ^The handle that can be given to 'pack'
+getIBusH m = fmap (`IBusH` m) iBusConnect
+
+remapEngine :: [(String, MonkyOut)] -> String -> MonkyOut
+remapEngine [] x = MonkyPlain $ T.pack x
+remapEngine ((l,r):xs) x = if l == x
+ then r
+ else remapEngine xs x
diff --git a/Monky/Examples/MPD.hs b/Monky/Examples/MPD.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Examples/MPD.hs
@@ -0,0 +1,105 @@
+{-|
+Module : Monky.Examples.MPD
+Description : An example module instance for the MPD module
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+module Monky.Examples.MPD
+ ( MPDHandle
+ , getMPDHandle
+ )
+where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+import Data.IORef
+import Data.Maybe (fromMaybe)
+import System.IO (hPutStrLn, stderr)
+import System.Posix.Types (Fd)
+
+import Monky.MPD
+import Monky.Modules
+import Monky.Examples.Utility
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+getPlayingSong :: State -> MPDSocket -> IO (Either String SongInfo)
+getPlayingSong Playing s = getMPDSong s
+getPlayingSong _ _ = return (Left "Not playing")
+
+
+extractTitle :: SongInfo -> Maybe Text
+extractTitle = tagTitle . songTags
+
+
+getSongTitle :: MPDSocket -> IO Text
+getSongTitle sock = getMPDStatus sock >>= getSong
+ where getSong (Left x) = return . T.pack $ x
+ getSong (Right status) = getTitle <$> getPlayingSong (state status) sock
+ getTitle (Left x) = T.pack x
+ getTitle (Right x) = fromMaybe "No Title" $extractTitle x
+
+
+-- |The handle for this example
+data MPDHandle = MPDHandle String String (IORef (Maybe MPDSocket))
+
+
+-- TODO ignoring errors is never a good idea
+getEvent :: MPDSocket -> IO Text
+getEvent s = do
+ _ <- readOk s
+ t <- getSongTitle s
+ _ <- goIdle s " player"
+ return t
+
+
+getFd :: MPDSocket -> IO [Fd]
+getFd s = do
+ fd <- getMPDFd s
+ _ <- goIdle s " player"
+ return [fd]
+
+
+instance PollModule MPDHandle where
+ getOutput (MPDHandle _ _ s) = do
+ r <- readIORef s
+ case r of
+ Nothing -> return [MonkyPlain "Broken"]
+ (Just x) -> do
+ ret <- getSongTitle x
+ return [MonkyPlain ret]
+ initialize (MPDHandle h p r) = do
+ s <- getMPDSocket h p
+ case s of
+ (Right x) -> writeIORef r (Just x)
+ (Left _) -> return ()
+
+
+instance EvtModule MPDHandle where
+ startEvtLoop h@(MPDHandle _ _ s) fun = do
+ initialize h
+ fun =<< getOutput h
+ r <- readIORef s
+ case r of
+ Nothing -> hPutStrLn stderr "Could not initialize MPDHandle :("
+ (Just x) -> do
+ [fd] <- getFd x
+ loopFd x fd fun (fmap (\y -> [MonkyPlain y]) . getEvent)
+
+
+-- |Get an 'MPDHandle' (server has to be running when this is executed)
+getMPDHandle
+ :: String -- ^The host to connect to
+ -> String -- ^The port to connect to
+ -> IO MPDHandle
+getMPDHandle h p = MPDHandle h p <$> newIORef Nothing
+
diff --git a/Monky/Examples/Memory.hs b/Monky/Examples/Memory.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Examples/Memory.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module : Monky.Examples.Memory
+Description : An example module instance for the memory module
+Maintainer : ongy, moepi
+Stability : testing
+Portability : Linux
+
+-}
+module Monky.Examples.Memory
+ ( getMemoryHandle
+ , getMemoryBarHandle
+
+ , MHandle
+ , MBHandle
+ )
+where
+
+import Monky.Examples.Utility
+import Monky.Modules
+
+import Monky.Memory hiding (getMemoryHandle)
+import qualified Monky.Memory as M (getMemoryHandle)
+
+-- |Simple handle to display current memory available
+newtype MHandle = MH MemoryHandle
+
+-- |Get the the memory handle
+getMemoryHandle :: IO MHandle
+getMemoryHandle = fmap MH $ M.getMemoryHandle
+
+{- Memory Module -}
+instance PollModule MHandle where
+ getOutput (MH h) = do
+ mp <- getMemoryAvailable h
+ return
+ [ MonkyImage "mem" '🐏'
+ , MonkyPlain $ convertUnitB (mp * 1024) "B"
+ ]
+
+-- |Handle to display the current memory usage (used/caches/free) as horizontal bar
+data MBHandle = MBH Float MemoryHandle
+
+-- |Get the 'MBHandle'
+getMemoryBarHandle
+ :: Float -- ^A factor to modify bar length. Total-length: 100/f
+ -> IO MBHandle
+getMemoryBarHandle f = fmap (MBH f) $ M.getMemoryHandle
+
+
+getUsagePercents :: MemoryHandle -> IO (Int,Int)
+getUsagePercents h = do
+ (total, avail, free, _) <- getMemoryStats h
+ return ((total - avail) * 100 `div` total, (total - free) * 100 `div` total)
+
+newBar :: Float -> (Int, Int) -> [MonkyOut]
+newBar f (u, us) =
+ let used = round $ fromIntegral u / f
+ cached = round $ fromIntegral (us - u) / f
+ fill = round (100 / f) - used - cached in
+ [ MonkyHBar used
+ , MonkyColor ("#444444", "") (MonkyHBar cached)
+ , MonkyColor ("#262626", "") (MonkyHBar fill)
+ ]
+
+getNMemoryOut :: MemoryHandle -> Float -> IO [MonkyOut]
+getNMemoryOut h f = do
+ percents <- getUsagePercents h
+ return $ MonkyImage "mem" '🐏':newBar f percents
+
+instance PollModule MBHandle where
+ getOutput (MBH f h) = getNMemoryOut h f
diff --git a/Monky/Examples/Network.hs b/Monky/Examples/Network.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Examples/Network.hs
@@ -0,0 +1,94 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module : Monky.Examples.Network
+Description : An example module instance for the network module
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+-}
+module Monky.Examples.Network
+ ( getNetworkHandles'
+ , getStaticHandle
+ , getDynamicHandle
+
+ , NetworkDynHandle
+ , NetworkStaticHandle
+ )
+where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.IORef (readIORef)
+
+import Monky.Examples.Utility
+import Monky.Modules
+import Monky.Network
+
+import qualified Monky.Network.Dynamic as D
+import qualified Monky.Network.Static as S
+
+data NetworkHandles' = NH' Text NetworkHandles
+
+-- |Handle for dynamic network handling
+data NetworkDynHandle = DH Text D.UHandles
+-- |HAndle for a staticly configured network interface
+data NetworkStaticHandle = SH Text S.NetworkHandle
+
+-- |Actually get the network handle
+getNetworkHandles'
+ :: Text -- ^The string to use when the network is disconnected
+ -> [String] -- ^The Network adapters to monitor
+ -> IO NetworkHandles'
+getNetworkHandles' e = fmap (NH' e) . getNetworkHandles
+
+-- |Get a handle for a static network interface
+getStaticHandle
+ :: Text -- ^The string to use when network is disconnected
+ -> String -- ^Name of the network interface
+ -> IO NetworkStaticHandle
+getStaticHandle e = fmap (SH e) . S.getNetworkHandle
+
+-- |Get a handle that will update with new or disappearing network interfaces
+getDynamicHandle
+ :: Text -- ^The string to use when network is disconnected
+ -> (String -> Bool) -- ^The filter function for the dynamic handle
+ -> IO NetworkDynHandle
+getDynamicHandle e = fmap (DH e) . D.getUHandles
+
+
+
+{- 2.0 STUFF -}
+{- Network Module -}
+
+formatNNetworkText :: Text -> Maybe (Int, Int) -> Text
+formatNNetworkText e Nothing = e
+formatNNetworkText _ (Just (r, w)) =
+ convertUnit r "B" "k" "M" "G" `T.append` (' ' `T.cons` convertUnit w "B" "k" "M" "G")
+
+
+getNNetworkText :: Text -> NetworkHandles -> IO [MonkyOut]
+getNNetworkText e nh = do
+ nv <- getReadWriteMulti nh
+ return [MonkyPlain $ formatNNetworkText e nv]
+
+
+getNDNetworkText :: Text -> D.Handles -> IO [MonkyOut]
+getNDNetworkText e nh = do
+ nv <- D.getMultiReadWrite nh
+ return [MonkyPlain $ formatNNetworkText e nv]
+
+
+instance PollModule NetworkDynHandle where
+ getOutput (DH e h) = getNDNetworkText e =<< readIORef (fst h)
+
+instance PollModule NetworkHandles' where
+ getOutput (NH' e h) = getNNetworkText e h
+
+instance PollModule NetworkStaticHandle where
+ getOutput (SH e h) = do
+ rates <- S.getReadWrite h
+ return [MonkyPlain $ formatNNetworkText e rates]
+
diff --git a/Monky/Examples/Plain.hs b/Monky/Examples/Plain.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Examples/Plain.hs
@@ -0,0 +1,27 @@
+{-|
+Module : Monky.Examples.Plain
+Description: Print some constant values
+Maintainer: ongy
+Stability: testing
+Portability: linux
+-}
+module Monky.Examples.Plain
+ ( MonkyList(..)
+ , getPlain
+ )
+where
+
+import Monky.Modules
+
+-- |The type for this functionality
+newtype MonkyList = MonkyList [MonkyOut]
+
+instance PollModule MonkyList where
+ getOutput (MonkyList x) = return x
+
+instance EvtModule MonkyList where
+ startEvtLoop (MonkyList xs) a = a xs
+
+-- |Get a 'MonkyList' for familiar syntax
+getPlain :: [MonkyOut] -> IO MonkyList
+getPlain = return . MonkyList
diff --git a/Monky/Examples/Prepend.hs b/Monky/Examples/Prepend.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Examples/Prepend.hs
@@ -0,0 +1,127 @@
+{-
+ 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 .
+-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE CPP #-}
+{-|
+Module : Monky.Prepend
+Description: Prepend something to a module
+Maintainer: ongy
+Stability: testing
+Portability: linux
+
+The *Prepend/Append functions can be used instead of pollPack/evtPack.
+If you want to chain a prepended module into something else, use the raw Constructors.
+@
+packPrepend [MonkyPlain "CPU"] 1 $ getCPUHandle ScalingCur
+pack 1 $ Prep [MonkyPlain "CPU"] <$> getCPUHandle ScalingCur
+@
+-}
+
+module Monky.Examples.Prepend
+ ( PrepHandle(..)
+ , PostHandle(..)
+
+ , packPrepend
+ , packAppend
+
+ , EvtPrepHandle(..)
+ , EvtPostHandle(..)
+
+ , evtPrepend
+ , evtAppend
+ )
+where
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+import Monky.Modules
+
+-- |The handle used by this module, contains underlying module and string
+data PrepHandle = forall m . PollModule m => Prep [MonkyOut] m
+
+-- |The handle used by this module, contains underlying module and string
+data PostHandle = forall m . PollModule m => Post [MonkyOut] m
+
+instance PollModule PrepHandle where
+ getOutput (Prep t m) = (t ++) <$> getOutput m
+ initialize (Prep _ m) = initialize m
+
+instance PollModule PostHandle where
+ getOutput (Post t m) = (++t) <$> getOutput m
+ initialize (Post _ m) = initialize m
+
+{-| Create a module that should be prepended with some string
+
+This allows you to prepend an instance of a module with a fixed
+String.
+
+For usage look at 'pollPack'.
+-}
+packPrepend :: PollModule a
+ => [MonkyOut] -- ^The String to prepend
+ -> Int -- ^The refresh rate for this module
+ -> IO a -- ^The function to get the module
+ -> IO Modules -- ^The returned handle
+packPrepend x i m = pollPack i (Prep x <$> m)
+
+{-| Create a module that should be appended with some string
+
+This allows you to append an instance of a module with a fixed
+String.
+
+For usage look at 'pollPack'.
+-}
+packAppend :: PollModule a
+ => [MonkyOut] -- ^The String to prepend
+ -> Int -- ^The refresh rate for this module
+ -> IO a -- ^The function to get the module
+ -> IO Modules -- ^The returned handle
+packAppend x i m = pollPack i (Post x <$> m)
+
+
+-- |'EvtModule' prepend type
+data EvtPrepHandle = forall m . EvtModule m => EvtPrep [MonkyOut] m
+-- |'EvtModule' append type
+data EvtPostHandle = forall m . EvtModule m => EvtPost [MonkyOut] m
+
+instance EvtModule EvtPrepHandle where
+ startEvtLoop (EvtPrep x m) a =
+ startEvtLoop m (\xs -> a (x ++ xs))
+
+instance EvtModule EvtPostHandle where
+ startEvtLoop (EvtPost x m) a =
+ startEvtLoop m (\xs -> a (xs ++ x))
+
+-- |'packPrepend' for 'EvtModule's
+evtPrepend :: EvtModule a
+ => [MonkyOut]
+ -> IO a
+ -> IO Modules
+evtPrepend x m = evtPack $ EvtPrep x <$> m
+
+-- |'packAppend' for 'EvtModule's
+evtAppend :: EvtModule a
+ => [MonkyOut]
+ -> IO a
+ -> IO Modules
+evtAppend x m = evtPack $ EvtPost x <$> m
+
diff --git a/Monky/Examples/Time.hs b/Monky/Examples/Time.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Examples/Time.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module : Monky.Examples.Time
+Description : An example module instance for the time module
+Maintainer : ongy, moepi
+Stability : testing
+Portability : Linux
+
+-}
+module Monky.Examples.Time
+ ( getTimeHandle
+ , getFancyTimeHandle
+
+ , THandle
+ , FTHandle
+ )
+where
+
+import Formatting
+import qualified Data.Text as T
+
+import Control.Arrow ((***))
+
+import Monky.Modules
+import Monky.Time hiding (getTimeHandle)
+import qualified Monky.Time as MT (getTimeHandle)
+
+-- |Handle for accessing system time
+newtype THandle = TH TimeHandle
+
+-- |Get a 'THandle'
+getTimeHandle :: String -- ^The format that should be used for 'getTime' in strftime format
+ -> IO THandle
+getTimeHandle = fmap TH . MT.getTimeHandle
+
+{- Time Module -}
+instance PollModule THandle where
+ getOutput (TH h) = do
+ ts <- getTime h
+ return
+ [ MonkyImage "clock" '🕐'
+ , MonkyPlain $ T.pack ts
+ ]
+
+{- Time Module -}
+timeToXBM :: (Int, Int) -> (Int, Int)
+timeToXBM = (`mod` 12) *** (`div` 15)
+--timeToXBM (h, m) = (xh, xm)
+-- where xh = h `mod` 12
+-- xm = m `div` 15
+
+-- |Like 'THandle' but uses a fancy variant of clock images
+newtype FTHandle = FTH TimeHandle
+
+-- |Get a 'FTHandle'
+getFancyTimeHandle :: String -- ^The format that should be used for 'getTime' in strftime format
+ -> IO FTHandle
+getFancyTimeHandle = fmap FTH . MT.getTimeHandle
+
+instance PollModule FTHandle where
+ getOutput (FTH h) = do
+ ts <- getTime h
+ t <- getHM h
+ let (th, tm) = timeToXBM t
+ return
+ [ MonkyImage (sformat (int % "-" % int) th tm) '🕐'
+ , MonkyPlain . T.pack $ ts
+ ]
+
diff --git a/Monky/Examples/Utility.hs b/Monky/Examples/Utility.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Examples/Utility.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module : Monky.Examples.Utility
+Description : Provides utility functions for module implementations
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+This module provides utility functions used in monky modules
+-}
+module Monky.Examples.Utility
+ ( loopFd
+ , convertUnit
+ , convertUnitB
+ , convertUnitSI
+ )
+where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Formatting
+
+import Control.Monad (unless)
+import Control.Concurrent (threadWaitRead)
+import System.Posix.Types (Fd)
+import Monky.Modules
+
+
+-- |Utility Function for eventing modules
+loopFd
+ :: h -- ^Some kind of module handle
+ -> Fd -- ^The FD to block on
+ -> ([MonkyOut] -> IO ()) -- ^The update consume function
+ -> (h -> IO [MonkyOut]) -- ^The function to generate the output
+ -> IO () -- ^This will loop for you
+loopFd h fd r f = do
+ threadWaitRead fd
+ out <- f h
+ unless (null out) (r out)
+ loopFd h fd r f
+
+
+-- |Convert a number into a fixed length strings
+convertUnit :: Int -> Text -> Text -> Text -> Text -> Text
+convertUnit = flip convertUnitT 1000 . fromIntegral
+
+
+-- |Convert a number into a reasonable scale for binary units
+convertUnitB :: Integral a => a -> Text -> Text
+convertUnitB rate b = convertUnitT (fromIntegral rate) 1024 (" " `T.append` b) "ki" "Mi" "Gi"
+
+
+-- |Convert a number into a reasonable scale for SI units
+convertUnitSI :: Integral a => a -> Text -> Text
+convertUnitSI rate b = convertUnitT (fromIntegral rate) 1000 b "k" "M" "G"
+
+convertUnitT :: Float -> Int -> Text -> Text -> Text -> Text -> Text
+convertUnitT rate step bs ks ms gs
+ | rate < fromIntegral (kf ) = sformat ((left 4 ' ' %. fixed 0) % stext) rate bs
+ | rate < fromIntegral (kf * 10 ) = sformat ((left 4 ' ' %. fixed 2) % stext) kv ks
+ | rate < fromIntegral (kf * 100 ) = sformat ((left 4 ' ' %. fixed 1) % stext) kv ks
+ | rate < fromIntegral (kf * 1000) = sformat ((left 4 ' ' %. fixed 0) % stext) kv ks
+ | rate < fromIntegral (mf * 10 ) = sformat ((left 4 ' ' %. fixed 2) % stext) mv ms
+ | rate < fromIntegral (mf * 100 ) = sformat ((left 4 ' ' %. fixed 1) % stext) mv ms
+ | rate < fromIntegral (mf * 1000) = sformat ((left 4 ' ' %. fixed 0) % stext) mv ms
+ | rate < fromIntegral (gf * 10 ) = sformat ((left 4 ' ' %. fixed 2) % stext) gv gs
+ | rate < fromIntegral (gf * 100 ) = sformat ((left 4 ' ' %. fixed 1) % stext) gv gs
+ | rate < fromIntegral (gf * 1000) = sformat ((left 4 ' ' %. fixed 0) % stext) gv gs
+ | otherwise = sformat ((left 4 ' ' %. expt 1) % stext) gv gs
+ where
+ kf = 1 * step
+ mf = kf * step
+ gf = mf * step
+ kv = rate / fromIntegral kf
+ mv = rate / fromIntegral mf
+ gv = rate / fromIntegral gf
+
+
diff --git a/Monky/Examples/Wifi.hs b/Monky/Examples/Wifi.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Examples/Wifi.hs
@@ -0,0 +1,83 @@
+{-|
+Module : Monky.Examples.Wifi
+Description : An example module instance for the wifi module
+Maintainer : ongy
+Stability : experimental
+Portability : Linux
+-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+module Monky.Examples.Wifi
+ ( getWifiHandle
+ , WifiHandle
+ , WifiFormat(..)
+ )
+where
+
+import Formatting
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Maybe (fromMaybe)
+
+import Monky.Modules
+import Monky.Examples.Utility
+import Monky.Wifi
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+-- Socket Interface Conversion Offline
+-- |The handle type for this module
+data WifiHandle = WH SSIDSocket Interface (WifiStats -> Text) Text
+
+-- |A typesafe version of a format string
+data WifiFormat
+ = FormatChannel -- ^Print the current networks channel
+ | FormatRates -- ^Print the current network max supported rate (always 54Mbit/s for me)
+ | FormatName -- ^Print the ESSID of the current network, may look weird because SSIDs are
+ | FormatFreq -- ^Print the frequency the current network sends on (related to channel)
+ | FormatMBM -- ^I think something something signal strength
+ | FormatText Text -- ^Print a plaintext string
+
+getFun :: WifiFormat -> WifiStats -> Text
+getFun FormatChannel = sformat int . wifiChannel
+getFun FormatRates = flip convertUnitSI "B" . maximum . wifiRates
+getFun FormatName = T.pack . wifiName
+getFun FormatFreq = sformat int . wifiFreq
+getFun FormatMBM = sformat int . wifiMBM
+getFun (FormatText str) = const str
+
+getFunction :: [WifiFormat] -> WifiStats -> Text
+getFunction xs = T.concat . (\a -> map (($ a) . getFun) xs)
+
+-- |Get a wifi handle
+getWifiHandle
+ :: [WifiFormat] -- ^Format "String" for output generation
+ -> Text -- ^Text that should be displayed when wifi is disconnected
+ -> String -- ^Name of the interface
+ -> IO WifiHandle
+getWifiHandle f d n = do
+ let fun = getFunction f
+ s <- getSSIDSocket
+ i <- fromMaybe (error ("Could not find interface: " ++ n)) <$> getInterface s n
+ return (WH s i fun d)
+
+getEventOutput :: WifiHandle -> IO [MonkyOut]
+getEventOutput (WH s i f d) = do
+ new <- gotReadable s i
+ case new of
+ (WifiConnect x) -> return [MonkyPlain $ f x]
+ WifiNone -> return []
+ WifiDisconnect -> return [MonkyPlain d]
+
+instance EvtModule WifiHandle where
+ startEvtLoop h@(WH s _ _ _) r = do
+ r =<< getOutput h
+ loopFd h (getWifiFd s) r getEventOutput
+
+instance PollModule WifiHandle where
+ getOutput (WH s i f d) = do
+ ret <- getCurrentWifiStats s i
+ return [MonkyPlain $ maybe d f ret]
diff --git a/Monky/MPD.hs b/Monky/MPD.hs
new file mode 100644
--- /dev/null
+++ b/Monky/MPD.hs
@@ -0,0 +1,376 @@
+{-
+ Copyright 2015 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+{-|
+Module : Monky.MPD
+Description : Allows to query information from an mpd server
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+This module creates a persistant connection to an mpd server and allows to query
+information or react to events waited for with MPDs idle
+-}
+module Monky.MPD
+ ( MPDSocket
+ , State(..)
+ , TagCollection(..)
+ , SongInfo(..)
+ , Status(..)
+ , getMPDStatus
+ , getMPDSong
+ , getMPDSocket
+ , closeMPDSocket
+ , getMPDFd
+ , readOk
+ , goIdle
+ , doQuery -- This might not stay
+ )
+where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as E
+import qualified Data.Text.Read as R
+
+import System.IO.Error
+import GHC.IO.Exception
+import Control.Exception (try)
+import Control.Monad (join, void, unless)
+import Control.Monad.Trans
+import Control.Monad.Trans.Except
+import Data.Char (isSpace)
+import Data.List (isPrefixOf)
+import Data.Maybe (isJust,fromJust)
+import System.Posix.Types (Fd(..))
+import System.Timeout (timeout)
+import Network.Socket hiding (recv)
+import Network.Socket.ByteString
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.Map as M
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+type MPDSock = Socket
+-- |A type safe socket for this module, basically a handle
+newtype MPDSocket = MPDSocket MPDSock
+
+-- |The current state of the MPD player submodule
+data State
+ = Playing -- ^Playing
+ | Stopped -- ^Stopped
+ | Paused -- ^Paused
+ deriving (Show, Eq) -- If it wasn't obvious
+
+-- |Collection of tags MPD supports
+data TagCollection = TagCollection
+ {
+ tagArtist :: Maybe Text
+ , tagArtistSort :: Maybe Text
+ , tagAlbum :: Maybe Text
+ , tagAlbumSort :: Maybe Text
+ , tagAlbumArtist :: Maybe Text
+ , tagAlbumArtistSort :: Maybe Text
+ , tagTitle :: Maybe Text
+ , tagTrack :: Maybe Text
+ , tagName :: Maybe Text
+ , tagGenre :: Maybe Text
+ , tagDate :: Maybe Text
+ , tagComposer :: Maybe Text
+ , tagPerformer :: Maybe Text
+ , tagComment :: Maybe Text
+ , tagDisc :: Maybe Text
+ , tagMArtistid :: Maybe Text
+ , tagMAlbumid :: Maybe Text
+ , tagMAlbumArtistid :: Maybe Text
+ , tagMTrackid :: Maybe Text
+ , tagMReleaseTrackid :: Maybe Text
+ } deriving (Show, Eq)
+
+-- |Information about an song
+data SongInfo = SongInfo
+ {
+ songFile :: Text
+ , songRange :: Maybe (Float, Float)
+ , songMTime :: Maybe Text
+ , songTime :: Maybe Int
+ , songDuration :: Maybe Float
+ , songTags :: TagCollection
+ , songPos :: Maybe Int
+ , songInfoId :: Maybe Int
+ , songPriority :: Maybe Int
+ } deriving (Show, Eq)
+
+-- |Haskell type for the data returned by MPDs status command
+data Status = Status
+ { -- We get those values every time with current versions (maybe for outdated mpd)
+ volume :: Int
+ , repeats :: Bool
+ , random :: Bool
+ , single :: Maybe Bool --added with 0.15
+ , consume :: Maybe Bool --added with 0.15
+ , playlist :: Int
+ , playlistLength :: Int
+ , state :: State
+ , mixrAmpdb :: Float
+
+ -- Those values may be sent with the state for current versions
+ , xfade :: Maybe Int
+ , mixrAmpDelay :: Maybe Int
+ , song :: Maybe Int --playlist song number
+ , songId :: Maybe Int --playlist songid
+ , nextSong :: Maybe Int --added with 0.15
+ , nextSongId :: Maybe Int --added with 0.15
+ , time :: Maybe Int
+ , elapsed :: Maybe Float --added with 0.16
+ , bitrate :: Maybe Int
+ , duration :: Maybe Int --added with 0.20
+ , audio :: Maybe (Int,Int,Int)
+ , updating :: Maybe Int
+ , mpderror :: Maybe Text
+ } deriving (Show, Eq)
+
+-- This isn't nice, but OK for now
+readText :: Integral a => Text -> a
+readText t = let (Right (x, _)) = R.decimal t in x
+
+
+rethrowSExcpt :: String -> IOError -> ExceptT String IO a
+rethrowSExcpt xs e = throwE (xs ++ ": " ++ show e)
+
+
+trySExcpt :: String -> IO a -> ExceptT String IO a
+trySExcpt l f = liftIO (try f) >>= rethrow
+ where rethrow (Left x) = rethrowSExcpt l x
+ rethrow (Right x) = return x
+
+-- |Close the 'MPDSocket' when it is no longer required
+closeMPDSocket :: MPDSocket -> IO ()
+closeMPDSocket (MPDSocket sock) = close sock
+
+-- Is this connection exception recoverable or should we just die?
+recoverableCon :: IOError -> Bool
+recoverableCon x
+ | ioeGetErrorType x == NoSuchThing = True
+ | otherwise = False
+
+
+tryConnect :: [AddrInfo] -> MPDSock -> ExceptT String IO MPDSock
+tryConnect [] _ = error "Tryed to connect with non existing socket"
+tryConnect (x:xs) sock =
+ liftIO (try $connect sock (addrAddress x)) >>= handleExcpt
+ where handleExcpt (Right _) = return sock
+ handleExcpt (Left y) = if recoverableCon y
+ then liftIO (close sock) >> openMPDSocket xs
+ else rethrowSExcpt "Connect" y
+
+
+doMPDConnInit :: MPDSock -> IO (Maybe String)
+doMPDConnInit s = join <$> timeout (500 * 1000) (do
+ v <- BS.unpack <$> recv s 64
+ if "OK MPD " `isPrefixOf` v
+ then return . Just $ drop 7 v
+ else return Nothing)
+
+-- |Open one MPDSock connected to a host specified by one of the 'MPDInfo'
+-- or throw an exception (either ran out of hosts or something underlying failed)
+openMPDSocket :: [AddrInfo] -> ExceptT String IO MPDSock
+openMPDSocket [] = throwE "Could not open connection"
+openMPDSocket ys@(x:xs) = do
+ sock <- trySExcpt "socket" $ openSocket x
+ csock <- tryConnect ys sock
+ version <- trySExcpt "readInit" $ doMPDConnInit csock
+ if isJust version
+ then liftIO $ return csock
+ else liftIO (close sock) >> openMPDSocket xs
+ where openSocket y = socket (addrFamily y) (addrSocketType y) (addrProtocol y)
+
+-- |Get a new 'MPDSocket'
+getMPDSocket
+ :: String -- ^The host the server is on
+ -> String -- ^The port the server listens on
+ -> IO (Either String MPDSocket)
+getMPDSocket host port = do
+ xs <- getAddrInfo (Just $ defaultHints {addrFlags = [AI_V4MAPPED]}) (Just host) (Just port)
+ sock <- runExceptT $ openMPDSocket xs
+ return $ fmap MPDSocket sock
+
+-- |Get the raw 'Fd' from the 'MPDSocket' for eventing api
+getMPDFd :: MPDSocket -> IO Fd
+getMPDFd (MPDSocket s) = return . Fd $fdSocket s
+
+
+recvMessage :: MPDSock -> ExceptT String IO [Text]
+recvMessage sock =
+ trySExcpt "receive" $ T.lines . E.decodeUtf8 <$> recv sock 4096
+
+
+sendMessage :: MPDSock -> String -> ExceptT String IO ()
+sendMessage sock message = void $
+ trySExcpt "send" (sendAll sock $BS.pack message)
+
+{- |Send a query to the MPD server and return a list of answers (line by line)
+
+This does not filter out errors, error checking has to be done by the user.
+This does filter out the last OK though
+-}
+doQuery :: MPDSocket -> String -> ExceptT String IO [Text]
+doQuery (MPDSocket s) m = sendMessage s (m ++ "\n") >> (f <$> recvMessage s)
+ where f = filter (/= "OK")
+
+-- |Get the OK sent by mpd after idle out of the pipe
+readOk :: MPDSocket -> IO (Either String ())
+readOk (MPDSocket s) = runExceptT $ do
+ resp <- recvMessage s
+ unless (resp == ["OK"]) (throwE . T.unpack . T.concat $ resp)
+
+{- |Go into MPDs 'idle' mode, this does return, but MPD wont time us out and
+will notify us if something happens
+-}
+goIdle
+ :: MPDSocket
+ -> String -- ^The string that should be send with idle (list of subsystems)
+ -> IO (Either String ())
+goIdle (MPDSocket s) xs = runExceptT $ void $ sendMessage s ("idle" ++ xs ++ "\n")
+
+
+getAudioTuple :: Text -> (Int,Int,Int)
+getAudioTuple xs =
+ let (Right (x, ys)) = R.decimal xs
+ (Right (y, zs)) = R.decimal $ T.tail ys
+ (Right (z, _)) = R.decimal $ T.tail zs
+ in (x, y, z)
+
+
+getState :: Text -> State
+getState "play" = Playing
+getState "stop" = Stopped
+getState "pause" = Paused
+getState xs = error ("Got unknown state: " ++ T.unpack xs)
+
+
+parseStatusRec :: M.Map Text Text -> [Text] -> Status
+parseStatusRec m (x:xs) = let (key,value) = T.break (== ' ') x in
+ parseStatusRec (M.insert (T.init key) (T.tail value) m) xs
+parseStatusRec m [] = Status
+ { volume = fromJust $ getInt "volume"
+ , repeats = fromJust $ getBool "repeat"
+ , random = fromJust $ getBool "random"
+ , single = getBool "single"
+ , consume = getBool "consume"
+ , playlist = fromJust $ getInt "playlist"
+ , playlistLength = fromJust $ getInt "playlistlength"
+ , state = getState_ m
+ , song = getInt "song"
+ , songId = getInt "songid"
+ , nextSong = getInt "nextsong"
+ , nextSongId = getInt "nextsongid"
+ , time = fmap (readText . T.takeWhile (/= ':')) $getVal "time"
+ , elapsed = read . T.unpack <$> M.lookup "elapsed" m
+ , duration = getInt "duration"
+ , bitrate = getInt "bitrate"
+ , xfade = getInt "xfade"
+ , mixrAmpdb = fromJust . fmap readF $ getVal "mixrampdb"
+ , mixrAmpDelay = getInt "mixrampdelay"
+ , audio = getAudio m
+ , updating = getInt "updating_db"
+ , mpderror = M.lookup "error" m
+ }
+ where getVal = flip M.lookup m
+ getBool = fmap (== ("1" :: Text)) . getVal
+ getInt = fmap readText . getVal
+ getState_ = getState . fromJust . M.lookup "state"
+ getAudio = fmap getAudioTuple . M.lookup "audio"
+ readF t = let (Right (x, _)) = R.rational t in x
+
+
+parseSongInfoRec :: M.Map Text Text -> [Text] -> SongInfo
+-- use init to drop the ':' for keys
+-- use break instead of words because of comment or artist
+parseSongInfoRec m (x:xs) = let (key, value) = T.break isSpace x in
+ parseSongInfoRec (M.insert (T.init key) (T.tail value) m) xs
+parseSongInfoRec m [] = let tags = TagCollection {
+ tagArtist = M.lookup "Artist" m
+ , tagArtistSort = M.lookup "ArtistSort" m
+ , tagAlbum = M.lookup "Album" m
+ , tagAlbumSort = M.lookup "AlbumSort" m
+ , tagAlbumArtist = M.lookup "AlbumArtist" m
+ , tagAlbumArtistSort = M.lookup "AlbumArtistSort" m
+ , tagTitle = M.lookup "Title" m
+ , tagTrack = M.lookup "Track" m
+ , tagName = M.lookup "Name" m
+ , tagGenre = M.lookup "Genre" m
+ , tagDate = M.lookup "Date" m
+ , tagComposer = M.lookup "Composer" m
+ , tagPerformer = M.lookup "Performer" m
+ , tagComment = M.lookup "Comment" m
+ , tagDisc = M.lookup "Disc" m
+
+ , tagMArtistid = M.lookup "MUSICBRAINZ_ARTISTID" m
+ , tagMAlbumid = M.lookup "MUSICBRAINZ_ALBUMID" m
+ , tagMAlbumArtistid = M.lookup "MUSICBRAINZ_ALBUMARTISTID" m
+ , tagMTrackid = M.lookup "MUSICBRAINZ_TRACKID" m
+ , tagMReleaseTrackid = M.lookup "MUSICBRAINZ_RELEASETRACKID" m
+ } in
+ SongInfo {
+ songFile = fromJust $M.lookup "file" m
+ , songRange = readT <$> M.lookup "Range" m
+ , songMTime = M.lookup "Last-Modified" m
+ , songTime = mRead "Time"
+ , songDuration = readF <$> M.lookup "duration" m
+ , songTags = tags
+ , songPos = mRead "Pos"
+ , songInfoId = mRead "Id"
+ , songPriority = mRead "Prio"
+ }
+ where readT xs =
+ let (Right (x, ys)) = R.rational xs
+ (Right (y, _)) = R.rational . T.tail $ ys in
+ (x, y)
+ mRead = fmap (readText) . flip M.lookup m
+ readF t = let (Right (x, _)) = R.rational t in x
+
+
+parseStatus :: [Text] -> Status
+parseStatus [] = error "Called parseStatus with []"
+parseStatus xs@(x:_) = if "ACK" `T.isPrefixOf` x
+ then error (T.unpack x)
+ else parseStatusRec M.empty xs
+
+-- |Get the current status or an error from the MPD server
+getMPDStatus :: MPDSocket -> IO (Either String Status)
+getMPDStatus s = do
+ resp <- runExceptT $ doQuery s "status"
+ return $ fmap parseStatus resp
+
+parseSongInfo :: [Text] -> SongInfo
+parseSongInfo [] = error "Called parseSongInfo with []"
+parseSongInfo xs@(x:_) = if "ACK" `T.isPrefixOf` x
+ then error (T.unpack x)
+ else parseSongInfoRec M.empty xs
+
+-- |Get the information about the song currently beeing player from the MPD server
+getMPDSong :: MPDSocket -> IO (Either String SongInfo)
+getMPDSong s = do
+ resp <- runExceptT $ doQuery s "currentsong"
+ return $ fmap parseSongInfo resp
diff --git a/Monky/Memory.hs b/Monky/Memory.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Memory.hs
@@ -0,0 +1,99 @@
+{-
+ Copyright 2015,2016 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module : Monky.Memory
+Description : Allows to access information about they systems main memory
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+-}
+module Monky.Memory
+ ( MemoryHandle
+ , getMemoryAvailable
+ , getMemoryHandle
+ , getMemoryTotal
+ , getMemoryUsed
+ , getMemoryFree
+ , getMemoryStats
+ )
+where
+
+import Monky.Utility (fopen, readContent, File)
+import Data.Maybe (fromMaybe, listToMaybe)
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as BS
+
+
+-- |The memory handle used for all functions
+data MemoryHandle = MemoryH File
+
+path :: String
+path = "/proc/meminfo"
+
+getVal :: ByteString -> Int
+getVal = fst . fromMaybe (error "Failed to read as int in memory module") . BS.readInt . (!! 1) . BS.words
+
+
+findLine :: ByteString -> [ByteString] -> Maybe ByteString
+findLine x = listToMaybe . filter (x `BS.isPrefixOf`)
+
+-- |Return the memory available to processes
+getMemoryAvailable :: MemoryHandle -> IO Int
+getMemoryAvailable (MemoryH f) = do
+ contents <- readContent f
+ return $getVal $fromMaybe "a 0" $findLine "MemAvailable" contents
+
+-- |Get the total amount of memory in the system
+getMemoryTotal :: MemoryHandle -> IO Int
+getMemoryTotal (MemoryH f) = do
+ contents <- readContent f
+ return $getVal $fromMaybe "a 0" $findLine "MemTotal" contents
+
+
+-- |Get the amount of memory rported as free by the kernel
+getMemoryFree :: MemoryHandle -> IO Int
+getMemoryFree (MemoryH f) = do
+ contents <- readContent f
+ return . getVal . fromMaybe "a 0" . findLine "MemFree" $contents
+
+-- |Get the amount of memory used by the kernel and processes
+getMemoryUsed :: MemoryHandle -> IO Int
+getMemoryUsed h = do
+ (_, _, _, used) <- getMemoryStats h
+ return used
+
+-- |Get memory statistics in one got (with only one read) (total, avail, free, used)
+getMemoryStats :: MemoryHandle -> IO (Int, Int, Int, Int)
+getMemoryStats (MemoryH f) = do
+ contents <- readContent f
+ let avail = getVal . fromMaybe "a 0" . findLine "MemAvailable" $ contents
+ total = getVal . fromMaybe "a 0" . findLine "MemTotal" $ contents
+ free = getVal . fromMaybe "a 0" . findLine "MemFree" $ contents
+ used = (total - avail)
+ return (total, avail, free, used)
+
+
+-- |Get a memory handle
+getMemoryHandle :: IO MemoryHandle
+getMemoryHandle = do
+ file <- fopen path
+ return $MemoryH file
diff --git a/Monky/Modules.hs b/Monky/Modules.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Modules.hs
@@ -0,0 +1,153 @@
+{-
+ Copyright 2015,2016 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE CPP #-}
+{-|
+Module : Monky.Modules
+Description : The module definition used by 'startLoop'
+Maintainer : ongy, moepi
+Stability : experimental
+Portability : Linux
+
+The EvtModule and PollModule classes have to be implemented by monky compatible modules
+-}
+module Monky.Modules
+ ( MonkyOut(..)
+ , MonkyOutput(..)
+ , PollModule(..)
+ , EvtModule(..)
+ , Modules(..)
+ , EvtModules(..)
+ , PollModules(..)
+ , pollPack
+ , evtPack
+ )
+where
+
+import Control.Arrow ((***))
+import Data.Word (Word8)
+import Data.Text (Text)
+import qualified Data.Text.Encoding as E
+
+import Data.Serialize
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+-- |A data type to encode general output types
+data MonkyOut
+ = MonkyPlain Text -- ^Plaintext output
+ | MonkyBar Int -- ^A Vertical bar, in %
+ | MonkyHBar Int -- ^A horizontal bar, in pixel
+ -- Temporary (FG,BG)
+ -- Color format (and somewhat image) are not fix yet, so don't rely on them to much
+ | MonkyColor (Text, Text) MonkyOut -- ^Colorize the enclosed output TODO: Color format
+ | MonkyImage Text Char -- ^Path to an image to display (for icons), or Unicode glyph that should be used
+ deriving (Show, Read)
+
+-- |Class that output converters have to implement
+class MonkyOutput a where
+ -- |Create one tick of output from a list of collection module output
+ doLine
+ :: a -- ^The output handle, may have a connection handle
+ -> [[MonkyOut]] -- ^The outputs generated by collection modules
+ -> IO () -- ^IO() since the output module chooses how to transfer the data to the display client
+
+-- |The "New" class for collection modules
+class PollModule a where
+ -- |Get the current (new) output
+ getOutput
+ :: a -- ^The handle, may store data from previous calls
+ -> IO [MonkyOut] -- ^A list of outputs to build
+ -- |Initialize the module, this is called once before data collection starts
+ initialize
+ :: a -- ^The handle to initialize
+ -> IO ()
+ -- |Default implementation
+ initialize _ = return ()
+
+-- |The class for eventing modules
+class EvtModule a where
+ {- |Start your own event loop. The second argument is the consumer of your output.
+
+ Doing this in an opaque way gives a way to chain actions to your event handling
+ -}
+ startEvtLoop :: a -> ([MonkyOut] -> IO ()) -> IO ()
+
+-- |A wrapper around module instances so they can be put into a list.
+data PollModules = forall a . PollModule a => NMW a Int
+-- |A wrapper around EvtModule for so they can be in a list
+data EvtModules = forall a . EvtModule a => DW a
+
+-- |Wrapper around 'PollModules' and 'EvtModules' so we can pass all modules in one list to 'startLoop'
+data Modules
+ = Poll PollModules
+ | Evt EvtModules
+
+-- |Function to make packaging modules easier
+pollPack :: PollModule a
+ => Int -- ^The refresh rate for this module
+ -> IO a -- ^The function to get a module (get??Handle)
+ -> IO Modules -- ^The packed module ready to be given to 'startLoop'
+pollPack i = fmap (Poll . flip NMW i)
+
+
+-- |'pollPack' for 'EvtModule's
+evtPack :: EvtModule a
+ => IO a
+ -> IO Modules
+evtPack = fmap (Evt . DW)
+
+-- "Official" Serialize instance for sending MonkyOuts over the network
+instance Serialize MonkyOut where
+ put (MonkyPlain t) = do
+ put (1 :: Word8)
+ put $ E.encodeUtf8 t
+ put (MonkyBar i) = do
+ put (2 :: Word8)
+ put i
+ put (MonkyHBar i) = do
+ put (3 :: Word8)
+ put i
+ put (MonkyColor c out) = do
+ put (4 :: Word8)
+ put $ E.encodeUtf8 *** E.encodeUtf8 $ c
+ put out
+ put (MonkyImage t c) = do
+ put (5 :: Word8)
+ put $ E.encodeUtf8 t
+ put c
+
+ get = do
+ t <- get :: Get Word8
+ case t of
+ 1 -> MonkyPlain . E.decodeUtf8 <$> get
+ 2 -> MonkyBar <$> get
+ 3 -> MonkyHBar <$> get
+ 4 -> do
+ c <- get
+ out <- get
+ return $ MonkyColor (E.decodeUtf8 *** E.decodeUtf8 $ c) out
+ 5 -> do
+ i <- E.decodeUtf8 <$> get
+ c <- get
+ return $ MonkyImage i c
+ _ -> fail ("Could not decode MonkyOut, got type: " ++ show t)
diff --git a/Monky/Network.hs b/Monky/Network.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Network.hs
@@ -0,0 +1,66 @@
+{-
+ Copyright 2015,2016 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-|
+Module : Monky.Network
+Description : Allows access to information about they systems network
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+This module allows to add multiple network interfaces.
+If multiple network interfaces are active the first one in the list will be
+used.
+-}
+module Monky.Network
+ ( NetworkHandles
+ , getReadWriteMulti
+ , getNetworkHandles
+ )
+where
+
+
+import Monky.Network.Static
+
+-- |The handle exported by this module
+data NetworkHandles = NetHs [NetworkHandle]
+
+getMultiReadWriteInt :: [NetworkHandle] -> IO (Maybe (Int, Int))
+getMultiReadWriteInt [] = return Nothing
+getMultiReadWriteInt (x:xs) = do
+ val <- getReadWrite x
+ case val of
+ Nothing -> getMultiReadWriteInt xs
+ _ -> return val
+
+{- |Get the read/write rate of the first interface in the list that is connected
+
+The value will be a tuple (Read, Write) in bit/s or 'Nothing' if no network is
+connected.
+-}
+getReadWriteMulti :: NetworkHandles -> IO (Maybe (Int, Int))
+getReadWriteMulti (NetHs xs) = getMultiReadWriteInt xs
+
+-- |Create a 'NetworkHandles' for the list of networks
+getNetworkHandles :: [String] -- ^A list of interface names, the display order will be the same as the order in this list
+ -> IO NetworkHandles
+getNetworkHandles [] = return $NetHs []
+getNetworkHandles (x:xs) = do
+ handle <- getNetworkHandle x
+ (NetHs ns) <- getNetworkHandles xs
+ return (NetHs (handle:ns))
diff --git a/Monky/Network/Dynamic.hs b/Monky/Network/Dynamic.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Network/Dynamic.hs
@@ -0,0 +1,175 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP #-}
+{-|
+Module : Monky.Network.Dynamic
+Description : Allows access to information about they systems network
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+This module exports a handle to access dynamic network configurations.
+
+This will update when a new network interface appears or disappears.
+The value returned by this will be the sum over all interfaces.
+-}
+
+module Monky.Network.Dynamic
+ ( getUHandles
+ , UHandles
+ , Handles
+ , getMultiReadWrite
+ )
+where
+
+import Data.Bits ((.|.))
+import Control.Monad (when)
+import Control.Concurrent (forkIO, threadWaitRead)
+import Data.IntMap.Strict (IntMap)
+import qualified Data.IntMap.Strict as IM
+import qualified Data.Map as M
+import Data.IORef
+
+import qualified Data.ByteString.Char8 as BS
+
+import System.Linux.Netlink
+import System.Linux.Netlink.Constants
+import System.Linux.Netlink.Route
+
+import Monky.Network.Static
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+-- |A Wrapper than also carries the name, for comparision
+data NetHandle = NetHandle String NetworkHandle
+
+-- |The map we keep our handles in (the Int is the Interface ID on the system)
+type Handles = IntMap NetHandle
+
+-- |The actual handel exposed and used by this module
+type UHandles = (IORef Handles, String -> Bool)
+
+instance Show NetHandle where
+ show (NetHandle x _) = x
+
+
+-- |The fold function used for 'getMultiReadWrite' handling the IO and Maybe stuff
+foldF :: NetworkHandle -> IO (Maybe (Int, Int)) -> IO (Maybe (Int, Int))
+foldF h o = do
+ m <- getReadWrite h
+ case m of
+ (Just (r, w)) -> do
+ om <- o
+ case om of
+ Just (oldr, oldw) -> return $ Just (oldr + r, oldw + w)
+ Nothing -> return $ Just (r, w)
+ Nothing -> o
+
+-- |Get the sum of all read/write rates from our network devices or Nothing if none is active
+getMultiReadWrite :: Handles -> IO (Maybe (Int, Int))
+getMultiReadWrite =
+ IM.foldr (\(NetHandle _ v) -> foldF v) (return Nothing)
+
+-- |Logic for adding a new device to our Handles
+gotNew :: Int -> String -> Handles -> IO Handles
+gotNew index name m =
+ case IM.lookup index m of
+ Nothing -> do
+ h <- getNetworkHandle name
+ return $IM.insert index (NetHandle name h) m
+ Just (NetHandle x v) -> if x == name
+ then return m
+ else do
+ h <- getNetworkHandle name
+ closeNetworkHandle v
+ return $IM.adjust (const (NetHandle name h)) index m
+
+-- |Logic for removing a handle form Handles after we lost the interface
+lostOld :: Int -> Handles -> IO Handles
+lostOld index m = case IM.lookup index m of
+ Nothing -> return m
+ (Just (NetHandle _ h)) ->
+ closeNetworkHandle h >>
+ return (IM.delete index m)
+
+-- |The packet used to drump all current network devices
+requestPacket :: RoutePacket
+requestPacket =
+ let flags = fNLM_F_REQUEST .|. fNLM_F_MATCH .|. fNLM_F_ROOT
+ header = Header eRTM_GETLINK flags 42 0
+ msg = NLinkMsg 0 0 0 in
+ Packet header msg M.empty
+
+-- |Read the interface name and index from 'RoutePacket'
+readInterface :: RoutePacket -> (Int, String)
+readInterface (Packet _ msg attrs) =
+ let (Just name) = M.lookup eIFLA_IFNAME attrs
+ names = init $ BS.unpack name -- Drop \0
+ index = interfaceIndex msg in
+ (fromIntegral index, names)
+readInterface x = error ("Something went wrong while getting interfaces: " ++ show x)
+
+-- |Get all current interfaces from our system
+getCurrentDevs :: IO [(Int, String)]
+getCurrentDevs = do
+ sock <- makeSocket
+ ifs <- query sock requestPacket
+ closeSocket sock
+ return $map readInterface ifs
+
+-- |Get the 'Handles' wrapper for all current interfaces
+getNetworkHandles :: (String -> Bool) -> IO Handles
+getNetworkHandles f = do
+ interfaces <- filter (f . snd) <$> getCurrentDevs
+ foldr build (return IM.empty) interfaces
+ where build (index, dev) m =
+ gotNew index dev =<< m
+
+-- |Handle an incomming rtneltink message and update the handle
+doUpdate :: UHandles -> RoutePacket -> IO ()
+doUpdate (mr, f) (Packet hdr msg attrs)
+-- for now we will assume that we want the interface
+ | messageType hdr == eRTM_NEWLINK = do
+ let (Just name) = M.lookup eIFLA_IFNAME attrs
+ let names = init $BS.unpack name -- Drop \0
+ when (f names) $ do -- Add
+ let index = interfaceIndex msg
+ m <- readIORef mr
+ nm <- gotNew (fromIntegral index) names m
+ writeIORef mr nm
+ | messageType hdr == eRTM_DELLINK = do
+ let index = interfaceIndex msg
+ m <- readIORef mr
+ nm <- lostOld (fromIntegral index) m
+ writeIORef mr nm
+ | otherwise = return ()
+-- Ignore everything else
+doUpdate _ _ = return ()
+
+-- |Updater loop, it blocks on the netlink socker until it gets a message
+updaterLoop :: NetlinkSocket -> UHandles -> IO ()
+updaterLoop sock h = do
+ threadWaitRead (getNetlinkFd sock)
+ packet <- recvOne sock :: IO [RoutePacket]
+ mapM_ (doUpdate h) packet
+ updaterLoop sock h
+
+-- |Start the update loop for adding/removing interfaces
+updater :: UHandles -> IO ()
+updater h = do
+ sock <- makeSocket
+ joinMulticastGroup sock 1
+ updaterLoop sock h
+
+-- |Get the new handle this module exports and start its updater loop
+getUHandles
+ :: (String -> Bool) -- ^Will be given the name of the handle, only add interface if this returns true (think of it as filter over all possible interfaces)
+ -> IO UHandles
+getUHandles f = do
+ handle <- getNetworkHandles f
+ ref <- newIORef handle
+ _ <- forkIO (updater (ref, f))
+ return (ref, f)
diff --git a/Monky/Network/Static.hs b/Monky/Network/Static.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Network/Static.hs
@@ -0,0 +1,132 @@
+{-
+ 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 .
+-}
+{-|
+Module : Monky.Network.Static
+Description : Allows access to information about they systems network
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+This module should be used for static network configurations
+-}
+module Monky.Network.Static
+ ( getReadWrite
+ , NetworkHandle
+ , getNetworkHandle
+ , closeNetworkHandle
+ )
+where
+
+import Monky.Utility
+import Data.Time.Clock.POSIX
+import Data.IORef
+import System.IO.Error (catchIOError)
+
+
+-- |Current state of network device
+data NetState
+ = Down -- ^It is down, consider off
+ | Up -- ^It is up, consider on
+ | Unknown -- ^Unknown, kernel docu says to consider on
+ | Dormant -- ^Dormant, consider off
+
+-- |Get the current network adapter state from kernel
+getState :: NetworkHandle -> IO NetState
+getState (NetH _ _ statef _ _ _) = do
+-- the read can throw an exception if the interface disapperad, we just consider it down
+ state <- catchIOError (readLine statef) (\_ -> return "down")
+ return $ case state of
+ "up" -> Up
+ "down" -> Down
+ "unknown" -> Unknown
+ "dormant" -> Dormant
+ _ -> error ("Don't know the network state \"" ++ state ++ "\" yet")
+
+
+-- |Internal handle represanting exactly one interface
+data NetworkHandle = NetH File File File (IORef Int) (IORef Int) (IORef POSIXTime)
+
+basePath :: String
+basePath = "/sys/class/net/"
+
+
+readPath :: String
+readPath = "/statistics/rx_bytes"
+
+
+writePath :: String
+writePath = "/statistics/tx_bytes"
+
+
+statePath :: String
+statePath = "/operstate"
+
+-- Pure part of read/write rate calculation
+calculateRates :: Int -> Int -> Int -> Int -> POSIXTime -> POSIXTime -> (Int, Int)
+calculateRates oread nread owrite nwrite otime ntime =
+ let cread = oread - nread
+ cwrite = owrite - nwrite
+ ctime = otime - ntime in
+ ((cread * 8) `sdivBound` round ctime,
+ (cwrite * 8) `sdivBound` round ctime)
+
+-- IO Part of read/write rate calculation
+getReadWriteReal :: NetworkHandle -> IO (Int, Int)
+getReadWriteReal (NetH readf writef _ readref writeref timeref) = do
+ nread <- readValue readf
+ nwrite <- readValue writef
+ ntime <- getPOSIXTime
+
+ oread <- readIORef readref
+ owrite <- readIORef writeref
+ otime <- readIORef timeref
+
+ writeIORef readref nread
+ writeIORef writeref nwrite
+ writeIORef timeref ntime
+
+ return $ calculateRates oread nread owrite nwrite otime ntime
+
+-- |Get the (read, write) rate of the network interface. This is averaged over the time between calls
+getReadWrite :: NetworkHandle -> IO (Maybe (Int, Int))
+getReadWrite h = do
+ state <- getState h
+ case state of
+ Up -> fmap Just . getReadWriteReal $ h
+ Unknown -> fmap Just . getReadWriteReal $ h
+ _ -> return Nothing
+
+-- |Get a 'NetworkHandle'
+getNetworkHandle
+ :: String -- ^Name of the interface to monitor
+ -> IO NetworkHandle
+getNetworkHandle dev = do
+ readf <- fopen $path ++ readPath
+ writef <- fopen $path ++ writePath
+ statef <- fopen $path ++ statePath
+ readref <- newIORef (1 :: Int)
+ writeref <- newIORef (1 :: Int)
+ timeref <- newIORef (0 :: POSIXTime)
+ return $NetH readf writef statef readref writeref timeref
+ where path = basePath ++ dev
+
+-- |Close a network handle after it is no longer needed (the device disappeared)
+closeNetworkHandle :: NetworkHandle -> IO ()
+closeNetworkHandle (NetH readf writef statef _ _ _) =
+ mapM_ fclose [readf, writef, statef]
diff --git a/Monky/Outputs/Ascii.hs b/Monky/Outputs/Ascii.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Outputs/Ascii.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-|
+Module : Monky.Outputs.Ascii
+Description : Output module for Ascii
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+This module provides the output generation for ascii outputs
+-}
+module Monky.Outputs.Ascii
+ ( AsciiOutput
+ , getAsciiOut
+ )
+where
+
+import System.IO (hFlush, stdout)
+import Monky.Modules
+
+import qualified Data.Text.IO as T
+
+-- |The output handle for a ascii pipe
+data AsciiOutput = AsciiOutput
+
+doOut :: MonkyOut -> IO ()
+doOut (MonkyPlain t) = T.putStr t
+doOut (MonkyImage _ _) = return () -- Images are not supported :(
+doOut (MonkyBar p) = putStr (show p) >> putChar '%'
+doOut (MonkyHBar p) = putStr $ show p
+doOut (MonkyColor _ o) = doOut o
+
+doSegment :: [MonkyOut] -> IO ()
+doSegment = mapM_ doOut
+
+instance MonkyOutput AsciiOutput where
+ doLine _ [] = error "Why are you calling doLine without any modules? I don't think your config makes sense"
+ doLine _ [x] = do
+ doSegment x
+ putStr "\n"
+ hFlush stdout
+ doLine h (x:xs) = do
+ doSegment x
+ putStr " | "
+ doLine h xs
+
+-- |Get an output handle for ascii formatting
+getAsciiOut :: IO AsciiOutput
+getAsciiOut = return AsciiOutput
diff --git a/Monky/Outputs/Dzen2.hs b/Monky/Outputs/Dzen2.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Outputs/Dzen2.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module : Monky.Outputs/Dzen2
+Description : Output module for dzen2
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+This module provides the output generation for piping into a dzen2 bar
+-}
+module Monky.Outputs.Dzen2
+ ( DzenOutput
+ , getDzenOut
+ )
+where
+
+import Data.Composition ((.:))
+import System.IO (hFlush, stdout)
+import Monky.Modules
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+
+-- |The output handle for dzen2 pipe
+data DzenOutput = DzenOutput Int Text
+
+doOut :: DzenOutput -> MonkyOut -> IO ()
+doOut _ (MonkyPlain t) = T.putStr t
+doOut (DzenOutput _ p) (MonkyImage path _) = do
+ T.putStr ("^i(" `T.append` p)
+ T.putStr path
+ T.putStr ".xbm) "
+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
+ T.putStr "^r("
+ putStr . show $ p
+ T.putStr ("x" `T.append` (T.pack . show $ h `div` 2) `T.append` ")")
+-- Reverse colours for HBar to support the way we draw them
+doOut h (MonkyColor (f, b) (MonkyBar p)) = do
+ T.putStr ("^bg(" `T.append` f `T.append` ")^fg(" `T.append` b `T.append` ")")
+ doOut h (MonkyBar p)
+ T.putStr "^bg()^fg()"
+doOut h (MonkyColor (f, b) o) = do
+ T.putStr ("^bg(" `T.append` b `T.append` ")^fg(" `T.append` f `T.append` ")")
+ doOut h o
+ T.putStr "^bg()^fg()"
+
+doSegment :: DzenOutput -> [MonkyOut] -> IO ()
+doSegment h = mapM_ (doOut h)
+
+instance MonkyOutput DzenOutput where
+ doLine _ [] = error "Why are you calling doLine without any modules? I don't think your config makes sense"
+ doLine h [x] = do
+ doSegment h x
+ putStr "\n"
+ hFlush stdout
+ doLine h (x:xs) = do
+ doSegment h x
+ putStr " | "
+ doLine h xs
+
+-- |Get an output handle for dzen2 formatting
+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 = return .: DzenOutput
diff --git a/Monky/Outputs/Fallback.hs b/Monky/Outputs/Fallback.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Outputs/Fallback.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE CPP #-}
+{-|
+Module : Monky.Outputs.Fallback
+Description : Output module for doing a "best guess"
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+-}
+module Monky.Outputs.Fallback
+ ( WrapOuts
+ , getFallbackOut
+ )
+where
+
+import System.IO
+import GHC.IO.Encoding
+import Monky.Modules
+
+import Monky.Outputs.Ascii
+import Monky.Outputs.Utf8
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+-- |The datatype for wrapping outher outputs
+data WrapOuts = forall a . MonkyOutput a => WO a
+
+instance MonkyOutput WrapOuts where
+ doLine (WO o) = doLine o
+
+
+chooseTerminalOut :: IO WrapOuts
+chooseTerminalOut = do
+ l <- getLocaleEncoding
+ if textEncodingName l == "UTF-8"
+ then WO <$> getUtf8Out
+ else WO <$> getAsciiOut
+
+{- | Wrapper for normal outputs that tries to find the best output
+
+This function will check if stdout is a terminal and switch to AsciiOut or UTf8Out depending on the locale
+-}
+getFallbackOut
+ :: MonkyOutput a
+ => IO a -- ^The output to use for non-terminal mode
+ -> IO WrapOuts
+getFallbackOut o = do
+ e <- hIsTerminalDevice stdout
+ if e
+ then chooseTerminalOut
+ else WO <$> o
diff --git a/Monky/Outputs/Serialize.hs b/Monky/Outputs/Serialize.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Outputs/Serialize.hs
@@ -0,0 +1,62 @@
+{-|
+Module : Monky.Outputs.Serialize
+Description : Output module for storing
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+This output can be used to transport monky-output over the network.
+
+A simple receiver looks like:
+
+@
+{-# LANGUAGE OverloadedStrings #-}
+import Monky.Modules
+import Monky.Outputs.Dzen2
+
+import qualified Data.ByteString.Lazy as BS
+import Data.Serialize.Get
+import Data.Serialize
+
+printLine out bs = do
+ let (Right (line, xs)) = runGetLazyState get bs
+ doLine out line
+ printLine out xs
+
+main :: IO ()
+main = do
+ out <- getDzenOut 20 "\/home\/ongy\/.monky/xbm"
+ input <- BS.getContents
+ printLine out input
+@
+
+Used with:
+
+@
+socat - TCP4:127.0.0.1:1234 | .\/TestS| dzen2 -y 20 -w 1280
+socat TCP-LISTEN:1234 "EXEC:monky -d \/tmp\/monky"
+@
+-}
+module Monky.Outputs.Serialize
+ ( getSerializeOut
+ , SerializeOutput(..)
+ )
+where
+
+import System.IO (hFlush, stdout)
+import qualified Data.ByteString as BS
+import Data.Serialize
+import Monky.Modules
+
+-- |The output handle for using show instance
+data SerializeOutput = SerializeOutput
+
+instance MonkyOutput SerializeOutput where
+ doLine _ xs = do
+ BS.putStr $ encode xs
+ hFlush stdout
+
+-- |Get an output handle for show formatting
+getSerializeOut :: IO SerializeOutput
+getSerializeOut = return SerializeOutput
+
diff --git a/Monky/Outputs/Show.hs b/Monky/Outputs/Show.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Outputs/Show.hs
@@ -0,0 +1,50 @@
+{-|
+Module : Monky.Outputs.Show
+Description : Output module for storing
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+Can be used to store output or transmit in a human readable form.
+
+Simple receiver can be:
+
+@
+{-# LANGUAGE OverloadedStrings #-}
+import System.IO
+import Monky.Modules
+import Monky.Outputs.Dzen2
+
+main :: IO ()
+main = do
+ out <- getDzenOut 20 "\/home\/ongy\/.monky\/xbm"
+ input <- getContents
+ mapM_ (doLine out . read) $ lines input
+@
+
+Used with:
+
+> monky -d \/tmp\/monky | .\/Test | dzen2 -w 1280 -y 20
+
+-}
+module Monky.Outputs.Show
+ ( getShowOut
+ , ShowOutput(..)
+ )
+where
+
+import System.IO (hFlush, stdout)
+import Monky.Modules
+
+-- |The output handle for using show instance
+data ShowOutput = ShowOutput
+
+instance MonkyOutput ShowOutput where
+ doLine _ xs = do
+ putStr $ show xs
+ putStr "\n"
+ hFlush stdout
+
+-- |Get an output handle for show formatting
+getShowOut :: IO ShowOutput
+getShowOut = return ShowOutput
diff --git a/Monky/Outputs/Utf8.hs b/Monky/Outputs/Utf8.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Outputs/Utf8.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-|
+Module : Monky.Outputs.Utf8
+Description : Output module for utf8
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+This module provides the output generation for utf8 outputs
+-}
+module Monky.Outputs.Utf8
+ ( Utf8Output
+ , getUtf8Out
+ )
+where
+
+import System.IO (hFlush, stdout)
+import Monky.Modules
+
+import qualified Data.Text.IO as T
+
+-- |The output handle for a utf8 pipe
+data Utf8Output = Utf8Output
+
+barChar :: Int -> Char
+barChar i
+ | i < (100 `div` 8) = '▁'
+ | i < (100 `div` 4) = '▂'
+ | i < (100 `div` 8 * 3) = '▃'
+ | i < (100 `div` 2) = '▄'
+ | i < (100 `div` 8 * 5) = '▅'
+ | i < (100 `div` 4 * 3) = '▆'
+ | i < (100 `div` 8 * 7) = '▇'
+ | otherwise = '█'
+
+hBarChar :: Int -> Char
+hBarChar i
+ | i < (100 `div` 8) = '▏'
+ | i < (100 `div` 4) = '▎'
+ | i < (100 `div` 8 * 3) = '▍'
+ | i < (100 `div` 2) = '▌'
+ | i < (100 `div` 8 * 5) = '▋'
+ | i < (100 `div` 4 * 3) = '▊'
+ | i < (100 `div` 8 * 7) = '▉'
+ | otherwise = '█'
+
+doOut :: MonkyOut -> IO ()
+doOut (MonkyPlain t) = T.putStr t
+doOut (MonkyImage _ c) = putChar c -- Images are not supported :(
+doOut (MonkyBar p) = putChar (barChar p)
+doOut (MonkyHBar p) = do
+ putStr $ replicate (p `div` 10) '█'
+ putChar $ hBarChar (p `mod` 10 * 10)
+doOut (MonkyColor _ o) = doOut o
+
+doSegment :: [MonkyOut] -> IO ()
+doSegment = mapM_ doOut
+
+instance MonkyOutput Utf8Output where
+ doLine _ [] = error "Why are you calling doLine without any modules? I don't think your config makes sense"
+ doLine _ [x] = do
+ doSegment x
+ putStr "\n"
+ hFlush stdout
+ doLine h (x:xs) = do
+ doSegment x
+ putStr " | "
+ doLine h xs
+
+-- |Get an output handle for utf8 formatting
+getUtf8Out :: IO Utf8Output
+getUtf8Out = return Utf8Output
diff --git a/Monky/Template.hs b/Monky/Template.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Template.hs
@@ -0,0 +1,202 @@
+{-
+ Copyright 2015 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-# LANGUAGE CPP, TemplateHaskell #-}
+{-|
+Module : Monky.Template
+Description : This module provides a template haskell splice for including librarys
+Maintainer : ongy, moepi
+Stability : testing
+Portability : Linux
+
+This module is intended to be used by Monky modules, /not/ for configuration.
+
+This module provides the 'importLib' templateHaskell function to import a
+C-library easily.
+
+To use this, set the __LANGUAGE TemplateHaskell__ pragma in your module
+file and include this module.
+
+Usage:
+Use 'importLib' as top-level declaration in your file. Like:
+
+@
+importLib "LibAlsa" "libasound.so" []
+@
+
+This will create a data type for the library, and a function to get a handle for
+this library (data and get).
+To call your functions use the record syntax on that handle.
+-}
+module Monky.Template
+ ( importLib
+ , module Foreign.Ptr
+ )
+where
+
+import Control.Monad (liftM2)
+import Data.Char (isSpace)
+import Data.List (nub)
+import Foreign.Ptr (Ptr, FunPtr, castFunPtr)
+import Language.Haskell.TH
+import Monky.Utility
+import Data.Maybe (fromMaybe)
+import System.Posix.DynamicLinker (DL, dlclose, dlopen, dlsym, RTLDFlags(RTLD_LAZY))
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+monkyStrict :: Bang
+monkyStrict = Bang NoSourceUnpackedness NoSourceStrictness
+#else
+monkyStrict :: Strict
+monkyStrict = NotStrict
+#endif
+
+-- trim a string
+ltrim :: String -> String
+ltrim = dropWhile isSpace
+
+rtrim :: String -> String
+rtrim = reverse . ltrim . reverse
+
+trim :: String -> String
+trim = rtrim . ltrim
+
+-- Split type string
+prepareFun :: String -> [String]
+prepareFun = map trim . splitAtEvery "->" . trim
+
+-- get constructor name
+getName :: String -> Q Name
+getName name =
+ fromMaybe (error $ "Could not find constructor: " ++ name) <$> lookupTypeName name
+
+-- Get a type from a String, this can do ONE application, so IO works
+getType :: String -> Q Type
+getType xs = if ' ' `elem` xs
+ then let [t,a] = words xs in
+ liftM2 AppT (getT t) (getT a)
+ else getT xs
+ where getT "()" = return (TupleT 0)
+ getT ys = ConT <$> getName ys
+
+
+-- Apply arrows to create a function from types
+applyArrows :: [Type] -> Type
+applyArrows [] = error "Cannot work with empty function type"
+applyArrows [x] = x
+applyArrows (x:xs) = AppT (AppT ArrowT x) (applyArrows xs)
+
+
+-- Create function declarations for the constructor
+mkFunDesc :: (String, String) -> VarStrictTypeQ
+mkFunDesc (x,y) = do
+ t <- applyArrows <$> mapM getType (prepareFun y)
+ return (mkName x, monkyStrict, t)
+
+
+cleanName :: Char -> String
+cleanName '(' = "vo"
+cleanName ')' = "id"
+cleanName x = return x
+
+
+-- Get the transformer name, this is some ugly name mangeling
+transName :: String -> String
+transName = concatMap cleanName . ("mkFun" ++) . filter isOk
+ where isOk c = not (isSpace c) && c /= '-' && c /= '>'
+
+
+-- Get the function described by the three-tuple (Alias, C-Name, TypeString)
+getFunQ :: Name -> (String, String, String) -> Q Stmt
+getFunQ handle (alias, name, typeString) = do
+ let castFPtr = [| $(varE . mkName $ transName typeString) . castFunPtr |]
+ let getSym = [| dlsym $(varE handle) name |]
+ BindS (VarP (mkName (alias ++ "_"))) <$> [| fmap $(castFPtr) $(getSym) |]
+
+
+-- Create the return statement, this applies the constructor
+mkRet :: Name -> [String] -> Name -> Exp -> Q Stmt
+mkRet hname xs rawN raw= do
+ let funs = map (\x -> return (mkName x, VarE (mkName (x ++ "_")))) xs
+ let con = recConE hname (return (rawN,raw):funs)
+ NoBindS <$> [| return $(con) |]
+
+
+-- Create the statement to get the handle
+mkGetHandle :: Name -> String -> Q Stmt
+mkGetHandle h libname =
+ BindS (VarP h) <$> [| dlopen libname [RTLD_LAZY] |]
+
+
+-- Create the get function
+mkGetFun :: String -> String -> Name -> [(String, String, String)] -> Name -> Q [Dec]
+mkGetFun lname name hname funs raw = do
+ let funName = mkName ("get" ++ name)
+ let handle = mkName "handle"
+ ghandle <- mkGetHandle handle lname
+ funStmts <- mapM (getFunQ handle) funs
+ ret <- mkRet hname (map (\(x,_,_) -> x) funs) raw (VarE handle)
+ let fun = FunD funName [Clause [] (NormalB $ DoE (ghandle:funStmts ++ [ret])) []]
+ sig <- sigD funName [t| IO $(conT . mkName $ name) |]
+ return [sig,fun]
+
+
+-- Create the transformer function used by get
+mkTransformer :: String -> Q Dec
+mkTransformer f = do
+ let name = mkName . transName $ f
+ let ty = applyArrows <$> mapM getType (prepareFun f)
+ ForeignD . ImportF CCall Safe "dynamic" name <$> [t| (FunPtr $(ty)) -> $(ty) |]
+
+
+mkDestroyFun :: String -> Name -> Q [Dec]
+mkDestroyFun name raw = do
+ let libT = mkName name
+ let hname = mkName "handle"
+ let funName = mkName ("destroy" ++ name)
+ let body = [| dlclose ($(varE raw) $(varE hname)) |]
+
+ sig <- sigD funName [t| $(conT libT) -> IO () |]
+ fun <- funD funName [clause [varP hname] (normalB body) []]
+ return [sig ,fun]
+
+-- |Import a library
+importLib
+ :: String -- ^The name of the library data type
+ -> String -- ^The name of the library
+ -> [(String, String, String)] -- ^The functions in the library (Name, CName, Declaration)
+ -> Q [Dec]
+importLib hname lname xs = do
+ let name = mkName hname
+ funs <- mapM (mkFunDesc . (\(x,_,y) -> (x,y))) xs
+ transformers <- mapM mkTransformer $ nub $ map (\(_,_,x) -> x) xs
+ let rawRN = mkName "rawDL"
+ let raw = (rawRN, monkyStrict, ConT ''DL)
+#if MIN_VERSION_base(4,9,0)
+ let dhandle = DataD [] name [] Nothing [RecC (mkName hname) (raw:funs)] []
+#else
+ let dhandle = DataD [] name [] [RecC (mkName hname) (raw:funs)] []
+#endif
+ fun <- mkGetFun lname hname name xs rawRN
+ dest <- mkDestroyFun hname rawRN
+ return (dhandle:dest ++ transformers ++ fun)
diff --git a/Monky/Time.hs b/Monky/Time.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Time.hs
@@ -0,0 +1,73 @@
+{-
+ Copyright 2015 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-# LANGUAGE CPP #-}
+{-|
+Module : Monky.Time
+Description : Allows access to read system time
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+-}
+
+module Monky.Time
+ ( TimeHandle
+ , getTime
+ , getHM
+ , getTimeHandle
+ )
+where
+
+import Data.Time.Clock
+import Data.Time.Format
+import Data.Time.LocalTime
+
+import System.Locale.Current
+
+-- 4.8 breaks with System.Locale import
+#if MIN_VERSION_base(4,8,0)
+#else
+import System.Locale
+#endif
+
+-- |The handle exported by this module.
+data TimeHandle = TimeH TimeLocale String TimeZone
+
+doTime :: TimeLocale -> String -> TimeZone -> UTCTime -> String
+doTime tl str z t = formatTime tl str $ utcToLocalTime z t
+
+-- |Get the current time in the format given to the handle.
+getTime :: TimeHandle -> IO String
+getTime (TimeH tl str z) = do
+ t <- getCurrentTime
+ return $ doTime tl str z t
+
+-- |Get the current time (HH:MM) format for the current time zone.
+getHM :: TimeHandle -> IO (Int, Int)
+getHM (TimeH _ _ z) = do
+ t <- getCurrentTime
+ let (LocalTime _ (TimeOfDay h m _)) = utcToLocalTime z t
+ return (h, m)
+
+-- |Get a handle for this module
+getTimeHandle :: String -- ^The format that should be used for 'getTime' in strftime format
+ -> IO TimeHandle
+getTimeHandle format = do
+ z <- getCurrentTimeZone
+ tl <- currentLocale
+ return (TimeH tl format z)
diff --git a/Monky/Utility.hs b/Monky/Utility.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Utility.hs
@@ -0,0 +1,174 @@
+{-
+ Copyright 2015,2016 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP #-}
+{-|
+Module : Monky.Utility
+Description : Provides utility functions
+Maintainer : ongy, moepi
+Stability : testing
+Portability : Linux
+
+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
+ )
+where
+
+import System.IO
+import Data.List (isPrefixOf)
+
+import Data.Maybe (fromMaybe)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as BS
+
+#if MIN_VERSION_base(4,9,0)
+import System.Directory (listDirectory)
+#else
+import System.Directory (getDirectoryContents)
+
+listDirectory :: String -> IO [String]
+listDirectory = fmap (filter (not . ("." `isPrefixOf`))) . getDirectoryContents
+#endif
+
+
+class LineReadable a where
+ hGetReadable :: Handle -> IO a
+
+instance LineReadable String where
+ hGetReadable = hGetLine
+
+instance LineReadable ByteString where
+ hGetReadable = BS.hGetLine
+
+class FileReadable a where
+ hGetFile :: Handle -> IO [a]
+
+instance FileReadable String where
+ hGetFile = readStringLines
+
+instance FileReadable ByteString where
+ hGetFile = readBSLines
+
+
+
+-- |type alias to distinguish system functions from utility
+newtype File = File Handle deriving (Show, Eq)
+
+-- |Find a line in a list of Strings
+findLine :: Eq a => [a] -> [[a]] -> Maybe [a]
+findLine y (x:xs) = if y `isPrefixOf` x
+ then Just x
+ else findLine y xs
+findLine _ [] = Nothing
+
+-- |Read the first line of the file and convert it into an 'Int'
+readValue :: File -> IO Int
+readValue (File h) = do
+ hSeek h AbsoluteSeek 0
+ line <- hGetReadable h
+ let value = fmap fst $ BS.readInt line
+ return . fromMaybe (error ("Failed to read value from file:" ++ show h)) $ value
+
+-- |Read the first line of the file and convert the words in it into 'Int's
+readValues :: File -> IO [Int]
+readValues (File h) = do
+ hSeek h AbsoluteSeek 0
+ line <- hGetReadable h
+ let value = mapM (fmap fst . BS.readInt) $ BS.words line
+ return . fromMaybe (error ("Failed to read values from file:" ++ show h)) $ value
+
+-- |Read the first line of the file
+readLine :: LineReadable a => File -> IO a
+readLine (File h) = do
+ hSeek h AbsoluteSeek 0
+ hGetReadable h
+
+-- |Read a File as String line by line
+readStringLines :: Handle -> IO [String]
+readStringLines h = do
+ eof <- hIsEOF h
+ if eof
+ then return []
+ else do
+ l <- hGetReadable h
+ fmap (l:) $ readStringLines h
+
+-- |Read a File as ByteString line by line
+readBSLines :: Handle -> IO [ByteString]
+readBSLines h = fmap (BS.lines . BS.concat) $ readLines' []
+ where
+ readLines' ls = do
+ ret <- BS.hGet h 512
+ if ret == BS.empty
+ then return $ reverse ls
+ else readLines' (ret:ls)
+
+-- |Rewind the file descriptor and read the complete file as lines
+readContent :: FileReadable a => File -> IO [a]
+readContent (File h) = do
+ hSeek h AbsoluteSeek 0
+ hGetFile h
+
+-- |open a file read only
+fopen :: String -> IO File
+fopen = fmap File . flip openFile ReadMode
+
+-- |Close a file opened by 'fopen'
+fclose :: File -> IO ()
+fclose (File h) = hClose h
+
+-- |Split ys at every occurence of xs
+splitAtEvery :: String -> String -> [String]
+splitAtEvery s str = splitAtEvery' s str []
+ where splitAtEvery' _ [] zs = [zs]
+ splitAtEvery' xs (y:ys) zs = if xs `isPrefixOf` (y:ys)
+ then zs:splitAtEvery' xs (cut ys) []
+ else splitAtEvery' xs ys (zs ++ [y])
+ where cut = drop (length xs -1)
+
+-- |fmap fopen would give Maybe (IO File), this fixes that
+maybeOpenFile :: Maybe String -> IO (Maybe File)
+maybeOpenFile Nothing = return Nothing
+maybeOpenFile (Just x) = fmap Just . fopen $ x
+
+-- |0 save divide, uses maxbound for default value
+sdivBound :: (Integral a, Bounded a) => a -> a -> a
+sdivBound _ 0 = maxBound
+sdivBound x y = x `div` y
+
+-- |0 save divide, uses default value
+sdivUBound :: Integral a => a -> a -> a -> a
+sdivUBound _ 0 d = d
+sdivUBound x y _ = x `div` y
+
+infixl 7 `sdivBound`, `sdivUBound`
diff --git a/Monky/Version.hs b/Monky/Version.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Version.hs
@@ -0,0 +1,35 @@
+{-
+ Copyright 2015 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-# LANGUAGE TemplateHaskell #-}
+{-|
+Module : Monky.Version
+Description : The current version of the package, this updates from monky.hs
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+-}
+module Monky.Version
+where
+
+import Monky.VersionTH
+
+-- |The current version as 4tupel
+getVersion :: (Int, Int, Int, Int)
+getVersion = $versionTH
diff --git a/Monky/VersionTH.hs b/Monky/VersionTH.hs
new file mode 100644
--- /dev/null
+++ b/Monky/VersionTH.hs
@@ -0,0 +1,48 @@
+{-
+ Copyright 2015 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-# LANGUAGE CPP #-}
+{-|
+Module : Monky.VersionTH
+Description : The TemplateHaskell splice required by Monky.Version
+Maintainer : ongy
+Stability : testing
+Portability : Linux
+
+-}
+module Monky.VersionTH
+where
+
+import Data.List (isPrefixOf)
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+import Monky.Utility
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+-- |Get the version string from monky.cabal and convert it to a 4tupel
+versionTH :: Q Exp
+versionTH = do
+ content <- lines <$> runIO (readFile "monky.cabal")
+ let parts = map read $ splitAtEvery "." $ getVersionString content
+ returnQ . TupE $ map (LitE . IntegerL) parts
+ where getVLine = head . filter ("version:" `isPrefixOf`)
+ getVersionString = flip (!!) 1 . words . getVLine
diff --git a/Monky/Wifi.hs b/Monky/Wifi.hs
new file mode 100644
--- /dev/null
+++ b/Monky/Wifi.hs
@@ -0,0 +1,158 @@
+{-# LANGUAGE CPP #-}
+{-|
+Module : Monky.Wifi
+Description : Gives access to wifi status
+Maintainer : ongy
+Stability : experimental
+Portability : Linux
+
+-}
+module Monky.Wifi
+ ( getCurrentWifi
+ , getCurrentWifiStats
+ , getInterface
+ , gotReadable
+ , getSSIDSocket
+ , Interface
+ , SSIDSocket
+ , getWifiFd
+
+ , WifiStats(..)
+ , WifiConn(..)
+ )
+where
+
+import Data.Bits ((.&.))
+import Data.Word (Word8, Word32)
+import Data.Maybe (listToMaybe, fromMaybe)
+
+import System.Posix.Types (Fd)
+
+import System.Linux.Netlink (Packet(..), getAttributes, Attributes)
+import System.Linux.Netlink.GeNetlink (GenlHeader(..), GenlData(..))
+import System.Linux.Netlink.GeNetlink.NL80211
+import System.Linux.Netlink.GeNetlink.NL80211.Constants
+
+import qualified Data.Map as M
+
+import qualified Data.ByteString as BS
+import Data.ByteString (ByteString)
+
+import Data.Serialize (Serialize, decode)
+import Data.Serialize.Get (runGet, getWord32host)
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative ((<$>))
+#endif
+
+-- |The interface identifier
+type Interface = Word32
+-- |The socket type for this module
+type SSIDSocket = NL80211Socket
+
+-- |Enum for connection change
+data WifiConn
+ = WifiNone -- ^Nothing changed, connection unrelated message
+ | WifiDisconnect -- ^The current network was disconnectd
+ | WifiConnect WifiStats -- ^A new connection was established
+
+-- |Wifi network connection information
+data WifiStats = WifiStats
+ { wifiChannel :: Word8
+ , wifiRates :: [Word32]
+ , wifiName :: String
+ , wifiFreq :: Word32
+ , wifiMBM :: Word32
+ }
+
+-- Unsafe decode, we rely on kernel to be sensible
+uDecode :: Serialize a => Maybe ByteString -> Maybe a
+uDecode = fmap (\bs -> let (Right x) = decode bs in x)
+
+uGetWord32 :: Maybe ByteString -> Maybe Word32
+uGetWord32 = fmap (\bs -> let (Right x) = runGet getWord32host bs in x)
+
+getBssAttrs :: Attributes -> Maybe Attributes
+getBssAttrs attr = do
+ bs <- M.lookup eNL80211_ATTR_BSS attr
+ case runGet getAttributes bs of
+ (Left _) -> Nothing
+ (Right x) -> return x
+
+
+attrToStat :: NL80211Packet -> Maybe WifiStats
+attrToStat pack = do
+ pattrs <- getBssAttrs $ packetAttributes pack
+ attrs <- getWifiAttributes pack
+
+ name <- fmap show . M.lookup eWLAN_EID_SSID $ attrs
+ channel <- uDecode . M.lookup eWLAN_EID_DS_PARAMS $ attrs
+ rate <- M.lookup eWLAN_EID_SUPP_RATES attrs
+
+ freq <- uDecode . M.lookup eNL80211_BSS_FREQUENCY $ pattrs
+ mbm <- uDecode . M.lookup eNL80211_BSS_SIGNAL_MBM $ pattrs
+
+ let bs = M.lookup eWLAN_EID_EXT_SUPP_RATES attrs
+ let ratL = rate `BS.append` fromMaybe BS.empty bs
+ let rates = map (\y -> fromIntegral (y .&. 0x7F) * (500000 :: Word32)) . BS.unpack $ ratL
+
+ return $ WifiStats channel rates name freq mbm
+
+-- |Get the stats of a currently connected wifi network
+getCurrentWifiStats :: SSIDSocket -> Interface -> IO (Maybe WifiStats)
+getCurrentWifiStats s i = do
+ wifis <- getConnectedWifi s i
+ return $ attrToStat =<< listToMaybe wifis
+
+
+-- |Get only the name of the currently connected wifi
+getCurrentWifi :: SSIDSocket -> Interface -> IO (Maybe String)
+getCurrentWifi s i = fmap wifiName <$> getCurrentWifiStats s i
+
+
+-- |Get the interface id by name
+getInterface :: SSIDSocket -> String -> IO (Maybe Interface)
+getInterface s n = do
+ interfaces <- getInterfaceList s
+ return $ snd <$> listToMaybe (filter ((==) n . fst) interfaces)
+
+
+-- |get the raw fd for eventing
+getWifiFd :: SSIDSocket -> Fd
+getWifiFd = getFd
+
+-- We are only looking for ESSID right now, if we want to
+-- make this module more general, we will have to extend the
+-- return type of this function
+-- |This should be called when the fd returned by 'getWifiFd' got readable
+gotReadable :: SSIDSocket -> Interface -> IO WifiConn
+gotReadable s i = do
+-- we only care for ESSID and connect updates are a single message
+-- so this *should* be fine
+ ps <- getPacket s
+ if null ps
+ then error "Failed to get a package in gotReadable, this should not be possible"
+ else do
+ let packet = head ps
+ let cmd = genlCmd . genlDataHeader . packetCustom $ packet
+ if cmd == eNL80211_CMD_CONNECT
+ then do
+ wifi <- getCurrentWifiStats s i
+ return $ case wifi of
+ Nothing -> WifiDisconnect
+ Just x -> WifiConnect x
+ else if cmd == eNL80211_CMD_DISCONNECT
+ then let bs = M.lookup eNL80211_ATTR_IFINDEX (packetAttributes packet) in
+ if maybe False (== i) . uGetWord32 $ bs
+ then return WifiDisconnect
+ else return WifiNone
+ else return WifiNone
+
+
+-- |Get a netlink socket bound to nl80211 mlme Group
+getSSIDSocket :: IO SSIDSocket
+getSSIDSocket = do
+ s <- makeNL80211Socket
+ joinMulticastByName s "mlme"
+ return s
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/bin/Main.hs b/bin/Main.hs
new file mode 100644
--- /dev/null
+++ b/bin/Main.hs
@@ -0,0 +1,195 @@
+{-
+ Copyright 2015 Markus Ongyerth, Stephan Guenther
+
+ 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 .
+-}
+{-# LANGUAGE CPP #-}
+{-|
+Module : monky
+Description : A conky clone
+Maintainer : ongy, moepi
+Stability : testing
+Portability : Linux
+
+This application has a subset of the functionality conky provides.
+
+The goal of this application is to provide a standalone access to most system
+values without spawning thousands of processes (looking at you conky).
+
+It uses a similar configuration style to xmonad, i.e. the config file is a
+haskell source file which uses library functions provided by the application.
+
+The config file has to be placed at "~/.monky/monky.hs". Any valid Haskell
+source file should work (it is compiled with ghc --make).
+
+This executable compiles the configuration if needed, and execs into the main
+executable.
+-}
+module Main
+ ( main
+ )
+where
+
+import Monky.Version (getVersion)
+import Control.Monad (when, unless)
+import Data.List (isSuffixOf, nub, sort)
+import System.Directory
+import System.Exit (ExitCode(..), exitFailure)
+import System.IO (withFile, IOMode(..), hPutStr, hPutStrLn, stderr)
+import System.Posix.Process (executeFile)
+import System.Process (system)
+
+import Options.Applicative
+
+data Action
+ = Create
+ | ForceCompile
+ | Recompile
+ | Execute
+ deriving (Ord, Show, Eq)
+
+getActions :: Config -> [Action]
+getActions c =
+ (if confCompile c then [ForceCompile] else []) ++
+ (if confGenerate c then [Create] else []) ++
+ [Recompile, Execute]
+
+data Config = Config
+ { monkyDir :: String
+ , exeName :: String
+
+ , confCompile :: Bool
+ , confNoCompile :: Bool
+
+ , confNoExec :: Bool
+
+ , confGenerate :: Bool
+ , confNoGenerate :: Bool
+ } deriving (Show)
+
+-- Takes the current $HOME and a config dir, replaces '~' at beginning of paths
+updatePath :: Config -> String -> Config
+updatePath c home = c { monkyDir = monkyDir' }
+ where monkyDir' = case monkyDir c of
+ ('~':xs) -> home ++ xs
+ (xs) -> xs
+
+getConfigP :: Parser Config
+getConfigP = Config <$>
+ strOption (long "monky-dir" <> help "The directory monky resides in. Defaults to ~/.monky" <> short 'd' <> value "~/.monky") <*>
+ strOption (long "monky-exe" <> help "The name of the executable to be created/used." <> short 'e' <> value "monky.exe") <*>
+ switch (long "compile" <> help "Force compilation, even if helper thinks it's not needed" <> short 'c') <*>
+ switch (long "no-compile" <> help "Do not try to compile the executable" <> short 'n') <*>
+ switch (long "no-exec" <> help "Do not execute the compiled executable") <*>
+ switch (long "generate-example" <> help "Force example generation. This will overwrite existing config!") <*>
+ switch (long "no-generate-example" <> help "Don't generate the example, even if required")
+
+monkyDesc :: String
+monkyDesc = concat
+ [ "Monky version: " ++ show getVersion ++ "."
+ , "Monky helper to compile and/or execute the real monky binary"
+ , "This executable will call ghc to (re)compile the main monky.exe"
+ , "Then it will exec monky.exe which in turn will generate the output"
+ , "This file is a simple helper/wrapper. You can execute monky.exe without."
+ ]
+
+getConfig :: IO Config
+getConfig = do
+ conf <- execParser opts
+ updatePath conf <$> getHomeDirectory
+ where opts = info (helper <*> getConfigP)
+ (fullDesc <>
+ header monkyDesc)
+
+
+compilerFlags :: String
+compilerFlags = "--make -XOverloadedStrings -odir build -hidir build -O -with-rtsopts=-V0"
+
+
+changeDir :: Config -> IO ()
+changeDir c = do
+ createDirectoryIfMissing False $ monkyDir c
+ setCurrentDirectory $ monkyDir c
+
+
+exampleFile :: String
+exampleFile = unlines
+ [ "import Monky"
+ , "import Monky.Modules"
+ , ""
+ , "import Monky.Examples.CPU"
+ , "import Monky.Examples.Memory"
+ , ""
+ , "import Monky.Outputs.Ascii"
+ , ""
+ , "main :: IO ()"
+ , "main = startLoop getAsciiOut"
+ , " [ pollPack 1 $ getRawCPU"
+ , " , pollPack 1 getMemoryHandle"
+ , " ]"
+ ]
+
+createExample :: Config -> IO ()
+createExample c =
+ unless (confNoGenerate c)$ withFile "monky.hs" WriteMode (`hPutStr` exampleFile)
+
+
+shouldCreate :: IO Bool
+shouldCreate = do
+ files <- getDirectoryContents "."
+ return $ "monky.hs" `notElem` files
+
+
+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)
+ case ret of
+ (ExitFailure _) -> do
+ hPutStrLn stderr "Compilation failed"
+ exitFailure
+ ExitSuccess -> return ()
+
+
+forceRecomp :: Config -> IO ()
+forceRecomp c = unless (confNoCompile c) $ do
+ files <- getDirectoryContents "."
+ mapM_ removeFile (filter isCompiled files)
+ when (exeName c `elem` files) (removeFile (exeName c))
+ when ("build" `elem` files) (removeDirectoryRecursive "build")
+ where isCompiled s = isSuffixOf ".hi" s || isSuffixOf ".o" s
+
+
+executeMonky :: Config -> IO ()
+executeMonky c = unless (confNoExec c) $ executeFile ("./" ++ exeName c) False [] Nothing
+
+
+execAction :: Action -> (Config -> IO ())
+execAction Create = createExample
+execAction ForceCompile = forceRecomp
+execAction Recompile = compile
+execAction Execute = executeMonky
+
+
+main :: IO ()
+main = do
+ conf <- getConfig
+ changeDir conf
+ should <- shouldCreate
+ let actions = getActions conf
+ let acts = map execAction . nub . sort $ if should then Create:actions else actions
+ mapM_ ($conf) acts
diff --git a/monky.cabal b/monky.cabal
new file mode 100644
--- /dev/null
+++ b/monky.cabal
@@ -0,0 +1,168 @@
+-- Initial monky.cabal generated by cabal init. For further documentation,
+-- see http://haskell.org/cabal/users-guide/
+
+-- The name of the package.
+name: monky
+
+-- The package version. See the Haskell package versioning policy (PVP)
+-- for standards guiding when and how versions should be incremented.
+-- http://www.haskell.org/haskellwiki/Package_versioning_policy
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 2.0.0.0
+
+-- The ABOVE LINE has to stay AS IS (except for version changes) for the
+-- template to work properly
+
+-- A short (one-line) description of the package.
+synopsis: A system state collecting library and application
+
+-- A longer description of the package.
+description:
+ monky started as an alternative to conky, i3-status or similar, that's fully containing in one process.
+ Also making an effort to keep file descriptors or handles as long as possible.
+ monky 2.0 is the first version on hackage.
+ .
+ monky consists of multiple parts. A number of collection modules, output modules, "examples" and a helper application.
+ .
+ * collection modules
+ .
+ The collection modules are the core library. Collection modules export a handle that can
+ be used to get some detail about the system. They can be used without the other parts
+ of this package, but they are designed with monky in mind.
+ .
+ * output modules
+ .
+ Output modules take a monky specific output type and transform it into something that can be
+ displayed by some external application. That may be a statusbar (dzen2), the terminal,
+ a network port, that makes it accessible on another machine, or any other thing.
+ .
+ * examples
+ .
+ The examples are a group of modules, that use collection modules to create the output used
+ by the output modules. The flexibility of the examples varies greatly, some may are really
+ flexible, some are rather static. The intended usecase is for users to create their own
+ examples and use them, if they don't want to use the provided ones.
+ .
+ Later on, I want to create something like xmonad-contrib or a collection of user examples,
+ to provide better usability for users with few to no experience with haskell.
+ .
+ * helper application
+ .
+ The helper application is used to compile the actual output generator and can generate an
+ example configuration.
+ .
+ To generate an example configuration in /~\/.monky/ simply run `monky`.
+ Then modify /~\/.monky\/monky.hs/ to create your own configuration.
+ .
+ Modules can have two types. 'PollModule' and 'EvtModule'. 'PollModule's work by the main loop
+ asking the module to generate new output, while 'EvtModule's block until some event is received and
+ update their output on demand. Some handles are an instance of both, 'PollModule' and 'EvtModule'.
+ 'EvtModule' should be preferred, since they induce less load on your system.
+ The monky main-loop does one "tick" every second. 'PollModules' are updated each /N/ ticks, where
+ /N/ is passed to 'pollPack'.
+
+-- The license under which the package is released.
+license: LGPL-3
+
+-- The file containing the license text.
+license-file: LICENSE
+
+-- The package author(s).
+author: Moepi, Ongy
+
+-- An email address to which users can send suggestions, bug reports, and
+-- patches.
+maintainer: Markus Ongyerth
+
+-- A copyright notice.
+-- copyright:
+
+category: System
+
+build-type: Simple
+
+-- Extra files to be distributed with the package, such as examples or a
+-- README.
+-- extra-source-files:
+
+-- Constraint on the version of Cabal needed to build this package.
+cabal-version: >=1.10
+
+Tested-With: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1
+
+Flag ibus
+ Description: enable ibus example
+ Default: False
+
+Source-repository head
+ type: git
+ location: https://github.com/monky-hs/monky
+
+
+executable monky
+ -- .hs or .lhs file containing the Main module.
+ main-is: Main.hs
+ hs-source-dirs: bin
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- Other library packages from which modules are imported.
+ build-depends: base >=4.6.0.1 && <5, directory, process, mtl
+ build-depends: unix, containers, monky, optparse-applicative
+
+ -- Directories containing source files.
+ -- hs-source-dirs:
+
+ -- Base language which the package is written in.
+ default-language: Haskell2010
+
+ ghc-options: -Wall
+
+library
+ exposed-modules: Monky.Disk Monky.Modules Monky.Time Monky.CPU Monky.Memory Monky.Network Monky.Utility Monky.Alsa Monky.Battery Monky
+ exposed-modules: Monky.Examples.Alsa Monky.Examples.Battery Monky.Examples.CPU Monky.Examples.Disk Monky.Examples.Network Monky.Examples.Time Monky.Examples.Memory
+ exposed-modules: Monky.Disk.Btrfs Monky.Disk.Device
+ exposed-modules: Monky.Examples.Prepend Monky.Connectivity
+ exposed-modules: Monky.Wifi Monky.Examples.Wifi
+ exposed-modules: Monky.Examples.Connectivity Monky.Network.Dynamic
+ exposed-modules: Monky.Network.Static Monky.Examples.File Monky.Examples.Utility
+
+ exposed-modules: Monky.Version Monky.Examples.Combine
+ exposed-modules: Monky.Examples.Plain Monky.Disk.Common Monky.Blkid
+
+ exposed-modules: Monky.Outputs.Dzen2 Monky.Outputs.Ascii Monky.Outputs.Utf8
+ exposed-modules: Monky.Outputs.Show Monky.Outputs.Fallback Monky.Outputs.Serialize
+ other-modules: Monky.Template Monky.VersionTH
+
+
+ build-depends: base >=4.6.0.1 && <=5, directory, time
+ build-depends: text, unix, network, mtl, transformers, text
+ build-depends: template-haskell, containers, stm, statvfs
+ build-depends: bytestring, netlink, cereal, formatting, composition
+ build-depends: env-locale >= 1.0.0.1
+
+ -- force double-conversion version for old ghc/library?
+ if impl(ghc < 7.8)
+ build-depends: double-conversion == 0.2.0.6
+ if impl(ghc >= 7.8)
+ exposed-modules: Monky.MPD Monky.Examples.MPD
+ -- build-depends: socket
+ if impl(ghc < 7.10)
+ build-depends: transformers-compat, old-locale
+
+
+ if flag(ibus)
+ build-depends: ibus-hs, dbus
+ exposed-modules: Monky.Examples.IBus
+
+ ghc-options: -Wall
+ extra-libraries:
+ default-language: Haskell2010