packages feed

monky (empty) → 2.0.0.0

raw patch · 48 files changed

+5439/−0 lines, 48 filesdep +basedep +bytestringdep +cerealsetup-changed

Dependencies added: base, bytestring, cereal, composition, containers, dbus, directory, double-conversion, env-locale, formatting, ibus-hs, monky, mtl, netlink, network, old-locale, optparse-applicative, process, statvfs, stm, template-haskell, text, time, transformers, transformers-compat, unix

Files

+ LICENSE view
@@ -0,0 +1,165 @@+                  GNU LESSER GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ 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.
+ Monky.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-|+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
+ Monky/Alsa.hsc view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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 <poll.h>++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
+ Monky/Battery.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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"
+ Monky/Blkid.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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
+ Monky/CPU.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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`)
+ Monky/Connectivity.hsc view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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 <sys/types.h>+#include <sys/socket.h>+#include <netinet/ip.h>++-- |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++
+ Monky/Disk.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-|+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"
+ Monky/Disk/Btrfs.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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
+ Monky/Disk/Common.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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
+ Monky/Disk/Device.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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
+ Monky/Examples/Alsa.hs view
@@ -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
+ Monky/Examples/Battery.hs view
@@ -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'
+ Monky/Examples/CPU.hs view
@@ -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
+ Monky/Examples/Combine.hs view
@@ -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
+ Monky/Examples/Connectivity.hs view
@@ -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
+ Monky/Examples/Disk.hs view
@@ -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")+      ]
+ Monky/Examples/File.hs view
@@ -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?
+ Monky/Examples/IBus.hs view
@@ -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
+ Monky/Examples/MPD.hs view
@@ -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+
+ Monky/Examples/Memory.hs view
@@ -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
+ Monky/Examples/Network.hs view
@@ -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]+
+ Monky/Examples/Plain.hs view
@@ -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
+ Monky/Examples/Prepend.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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+
+ Monky/Examples/Time.hs view
@@ -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+      ]+
+ Monky/Examples/Utility.hs view
@@ -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++
+ Monky/Examples/Wifi.hs view
@@ -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]
+ Monky/MPD.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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
+ Monky/Memory.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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
+ Monky/Modules.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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)
+ Monky/Network.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-|+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))
+ Monky/Network/Dynamic.hs view
@@ -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)
+ Monky/Network/Static.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-|+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]
+ Monky/Outputs/Ascii.hs view
@@ -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
+ Monky/Outputs/Dzen2.hs view
@@ -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
+ Monky/Outputs/Fallback.hs view
@@ -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
+ Monky/Outputs/Serialize.hs view
@@ -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+
+ Monky/Outputs/Show.hs view
@@ -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
+ Monky/Outputs/Utf8.hs view
@@ -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
+ Monky/Template.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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 <LibAlsa> and get<LibAlsa>).+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<LibName> 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<LibName>+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)
+ Monky/Time.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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)
+ Monky/Utility.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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`
+ Monky/Version.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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
+ Monky/VersionTH.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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
+ Monky/Wifi.hs view
@@ -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
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bin/Main.hs view
@@ -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 <http://www.gnu.org/licenses/>.+-}+{-# 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
+ monky.cabal view
@@ -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 <ongy@ongy.net>++-- 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