diff --git a/Monky/Connectivity.hsc b/Monky/Connectivity.hsc --- a/Monky/Connectivity.hsc +++ b/Monky/Connectivity.hsc @@ -40,29 +40,26 @@ import Data.Bits ((.|.)) import Control.Concurrent (threadWaitWrite, threadDelay, forkIO) -import Data.Word (Word64,Word32,Word16) +import Data.Word (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.Ptr (Ptr) +import Foreign.C.Types (CInt(..), CLong(..)) import Foreign.Storable (Storable(..)) import System.Posix.Types (Fd(..)) import System.Timeout (timeout) import Data.IORef (IORef, newIORef, writeIORef, readIORef) +import Monky.IP.Raw -import System.IO.Unsafe (unsafePerformIO) + #include #include #include -- |The Haskell type for the C struct sockaddr newtype Port = Port Word16 deriving (Eq, Show) -newtype IP4 = IP4 Word32 deriving (Eq) data Sockaddr = Socka Int Port IP4 deriving (Eq, Show) -- |Raw socket calls, we node those @@ -70,12 +67,8 @@ 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 @@ -85,45 +78,11 @@ 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 + return (Socka fam (Port port) ip) + poke p (Socka fam (Port port) 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 diff --git a/Monky/Examples/Alsa.hs b/Monky/Examples/Alsa.hs --- a/Monky/Examples/Alsa.hs +++ b/Monky/Examples/Alsa.hs @@ -1,3 +1,21 @@ +{- + Copyright 2015,2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-# LANGUAGE OverloadedStrings #-} {-| Module : Monky.Examples.Alsa diff --git a/Monky/Examples/Battery.hs b/Monky/Examples/Battery.hs --- a/Monky/Examples/Battery.hs +++ b/Monky/Examples/Battery.hs @@ -1,3 +1,21 @@ +{- + Copyright 2015,2016 Markus Ongyerth, Stephan Guenther + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-# LANGUAGE OverloadedStrings #-} {-| Module : Monky.Examples.Battery @@ -19,6 +37,7 @@ import Data.Composition ((.:)) import Monky.Modules +import Monky.Examples.Images import Monky.Battery hiding (getBatteryHandle, getBatteryHandle') import qualified Monky.Battery as B (getBatteryHandle, getBatteryHandle') @@ -47,10 +66,10 @@ pow <- getLoading bh let h = s `div` 3600 m = (s `mod` 3600) `div` 60 - return - [ MonkyImage (batterySymbol online p) '🔋' + return + [ batteryImage (batterySymbol online p) , MonkyColor (batteryColor online p, "") $ - MonkyPlain $ sformat (fixed 1 % "W " % int % "% " % (left 2 ' ' %. int) % ":" % (left 2 '0' %. int)) pow p h m + MonkyPlain $ sformat ((left 4 ' ' %. fixed 1) % "W " % int % "% " % (left 2 ' ' %. int) % ":" % (left 2 '0' %. int)) pow p h m ] -- |The handle type for this module diff --git a/Monky/Examples/CPU.hs b/Monky/Examples/CPU.hs --- a/Monky/Examples/CPU.hs +++ b/Monky/Examples/CPU.hs @@ -1,3 +1,21 @@ +{- + Copyright 2015,2016 Markus Ongyerth, Stephan Guenther + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-| @@ -40,6 +58,7 @@ import Data.List (intercalate) import Monky.Modules +import Monky.Examples.Images import qualified Monky.CPU as C #if MIN_VERSION_base(4,8,0) @@ -62,13 +81,13 @@ MonkyColor (cpuColor h, "#262626") (MonkyBar h) printXbm :: MonkyOut -printXbm = MonkyImage "cpu" ' '--'🖩' Disabled because of compile errors +printXbm = cpuImage printFrequency :: Float -> MonkyOut printFrequency = MonkyPlain . sformat (fixed 1 % "G") printThemp :: Int -> MonkyOut -printThemp = MonkyPlain . sformat (" " % int % "°C") +printThemp = MonkyPlain . sformat (" " % int % "°C") getNumaNode :: C.NumaHandle -> IO [MonkyOut] getNumaNode nh = map printBar <$> C.getNumaPercent nh diff --git a/Monky/Examples/Combine.hs b/Monky/Examples/Combine.hs --- a/Monky/Examples/Combine.hs +++ b/Monky/Examples/Combine.hs @@ -1,3 +1,21 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} {-| diff --git a/Monky/Examples/Connectivity.hs b/Monky/Examples/Connectivity.hs --- a/Monky/Examples/Connectivity.hs +++ b/Monky/Examples/Connectivity.hs @@ -1,3 +1,21 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ExistentialQuantification #-} {-| diff --git a/Monky/Examples/Disk.hs b/Monky/Examples/Disk.hs --- a/Monky/Examples/Disk.hs +++ b/Monky/Examples/Disk.hs @@ -1,3 +1,21 @@ +{- + Copyright 2015,2016 Markus Ongyerth, Stephan Guenther + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-# LANGUAGE OverloadedStrings #-} {-| Module : Monky.Examples.Disk @@ -16,6 +34,7 @@ import Formatting import Monky.Examples.Utility +import Monky.Examples.Images import Monky.Modules import Monky.Disk hiding (getDiskHandle) import qualified Monky.Disk as D (getDiskHandle) @@ -35,6 +54,6 @@ (dr, dw) <- getDiskReadWrite dh df <- getDiskFree dh return - [ MonkyImage "diskette" ' '-- '🖪' also disabled for compat reasons + [ diskImage , MonkyPlain $ sformat (stext % " " % stext % " " % stext) (convertUnitSI df "B") (convertUnitSI dr "B" ) (convertUnitSI dw "B") ] diff --git a/Monky/Examples/File.hs b/Monky/Examples/File.hs --- a/Monky/Examples/File.hs +++ b/Monky/Examples/File.hs @@ -1,3 +1,21 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-| Module : Monky.Examples.File Description : Display the first line in a file each tick diff --git a/Monky/Examples/IBus.hs b/Monky/Examples/IBus.hs --- a/Monky/Examples/IBus.hs +++ b/Monky/Examples/IBus.hs @@ -1,3 +1,21 @@ +{- + Copyright 2015,2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-# LANGUAGE CPP #-} {-| Module : Monky.Examples.IBus @@ -8,7 +26,7 @@ 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 +This is only usefull if you have ibus installed and active on your system. This module will display the current global engine and provides diff --git a/Monky/Examples/Images.hs b/Monky/Examples/Images.hs new file mode 100644 --- /dev/null +++ b/Monky/Examples/Images.hs @@ -0,0 +1,69 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} +{-# LANGUAGE CPP, OverloadedStrings #-} +{-| +Module : Monky.Examples.Images +Description : Exports 'MonkyImage's that can/should be used. +Maintainer : ongy +Stability : testing +Portability : Linux + +GHC enforces some rules on unicode strings, which makes images version dependant. +This module exports the appropriate image. +-} +module Monky.Examples.Images +where + +import Data.Text (Text) +import Monky.Modules (MonkyOut(MonkyImage)) + +-- | MonkyImage for disk (primary persistent storage) +diskImage :: MonkyOut +diskImage = +#if MIN_VERSION_base(4,8,0) + MonkyImage "diskette" '🖪' +#else + MonkyImage "diskette" 'D' +#endif + +-- | MonkyImage for memory (RAM (it's a ram)) +memoryImage :: MonkyOut +memoryImage = + MonkyImage "mem" '🐏' + +-- | MonkyImage for time with custom image support +fancyTimeImage :: Text -> MonkyOut +fancyTimeImage = flip MonkyImage '🕐' + +-- | MonkyImage for time (clock) +timeImage :: MonkyOut +timeImage = fancyTimeImage "clock" + +-- | MonkyImage with custom image support (loadding etc.) +batteryImage :: Text -> MonkyOut +batteryImage = flip MonkyImage '🔋' + +-- | MonkyImage to be used for CPU +cpuImage :: MonkyOut +cpuImage = +#if MIN_VERSION_base(4,8,0) + MonkyImage "cpu" '🖩' +#else + MonkyImage "cpu" 'C' +#endif diff --git a/Monky/Examples/MPD.hs b/Monky/Examples/MPD.hs --- a/Monky/Examples/MPD.hs +++ b/Monky/Examples/MPD.hs @@ -1,3 +1,21 @@ +{- + Copyright 2015,2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-| Module : Monky.Examples.MPD Description : An example module instance for the MPD module diff --git a/Monky/Examples/Memory.hs b/Monky/Examples/Memory.hs --- a/Monky/Examples/Memory.hs +++ b/Monky/Examples/Memory.hs @@ -1,3 +1,21 @@ +{- + Copyright 2015,2016 Markus Ongyerth, Stephan Guenther + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-# LANGUAGE OverloadedStrings #-} {-| Module : Monky.Examples.Memory @@ -6,17 +24,24 @@ Stability : testing Portability : Linux +For older kernels the memory available value may be wrong. +When not provided by the kernel it's computed as `free + cached + buffers`. +If you find this to be to inacurate, use the version for memory free. +But be aware, that free memory on linux can go close to zero because of io buffers. -} module Monky.Examples.Memory ( getMemoryHandle , getMemoryBarHandle + , getMemoryFreeHandle , MHandle + , MFHandle , MBHandle ) where import Monky.Examples.Utility +import Monky.Examples.Images import Monky.Modules import Monky.Memory hiding (getMemoryHandle) @@ -25,7 +50,7 @@ -- |Simple handle to display current memory available newtype MHandle = MH MemoryHandle --- |Get the the memory handle +-- |Get the the memory handle (available) getMemoryHandle :: IO MHandle getMemoryHandle = fmap MH $ M.getMemoryHandle @@ -34,6 +59,23 @@ getOutput (MH h) = do mp <- getMemoryAvailable h return + [ memoryImage + , MonkyPlain $ convertUnitB (mp * 1024) "B" + ] + + +-- |Simple handle to display current free memory +newtype MFHandle = MFH MemoryHandle + +-- |Get the the memory handle (free) +getMemoryFreeHandle :: IO MFHandle +getMemoryFreeHandle = fmap MFH $ M.getMemoryHandle + +{- Memory Module -} +instance PollModule MFHandle where + getOutput (MFH h) = do + mp <- getMemoryFree h + return [ MonkyImage "mem" '🐏' , MonkyPlain $ convertUnitB (mp * 1024) "B" ] @@ -66,7 +108,7 @@ getNMemoryOut :: MemoryHandle -> Float -> IO [MonkyOut] getNMemoryOut h f = do percents <- getUsagePercents h - return $ MonkyImage "mem" '🐏':newBar f percents + return $ memoryImage:newBar f percents instance PollModule MBHandle where getOutput (MBH f h) = getNMemoryOut h f diff --git a/Monky/Examples/Modify.hs b/Monky/Examples/Modify.hs new file mode 100644 --- /dev/null +++ b/Monky/Examples/Modify.hs @@ -0,0 +1,87 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} +{-# LANGUAGE CPP #-} +{-| +Module : Monky.Examples.Modify +Description : Monky module that modifies other modules output +Maintainer : ongy +Stability : testing +Portability : Linux + +Example that limits MPD song title to 20 characters + +@ +import Data.Text as T + +modifyMPD :: [MonkyOut] -> [MonkyOut] +modifyMPD orig@(MonkyPlain xs:ys) = + if T.length xs > 20 + then MonkyPlain (T.take 17 xs `T.append` "..."):ys + else orig + + +evtPack $ getModifyHandle modifyMPD $ getMPDHandle "127.0.0.1" "6600" +@ + +-} +module Monky.Examples.Modify + ( ModifyHandle + , getModifyHandle + + , IOModifyHandle + , getIOModifyHandle + + ) +where + +#if MIN_VERSION_base(4,8,0) +#else +import Control.Applicative ((<$>)) +#endif + +import Monky.Modules + +-- |Handle for duing pure modification of module output +data ModifyHandle a = MH ([MonkyOut] -> [MonkyOut]) a + +-- |Get a handle to purely modify another modules output +getModifyHandle :: ([MonkyOut] -> [MonkyOut]) -> IO a -> IO (ModifyHandle a) +getModifyHandle fun = fmap (MH fun) + +instance PollModule a => PollModule (ModifyHandle a) where + initialize (MH _ m) = initialize m + getOutput (MH fun m) = fun <$> getOutput m + +instance EvtModule a => EvtModule (ModifyHandle a) where + startEvtLoop (MH fun m) f = startEvtLoop m (f . fun) + + +-- |Handle for modifying output in IO monad +data IOModifyHandle a = IOMH ([MonkyOut] -> IO [MonkyOut]) a + +-- |Get a handle that can modify another handles output in the IO monad +getIOModifyHandle :: ([MonkyOut] -> IO [MonkyOut]) -> IO a -> IO (IOModifyHandle a) +getIOModifyHandle fun = fmap (IOMH fun) + +instance PollModule a => PollModule (IOModifyHandle a) where + initialize (IOMH _ m) = initialize m + getOutput (IOMH fun m) = fun =<< getOutput m + +instance EvtModule a => EvtModule (IOModifyHandle a) where + startEvtLoop (IOMH fun m) f = startEvtLoop m (\e -> f =<< fun e) diff --git a/Monky/Examples/Network.hs b/Monky/Examples/Network.hs --- a/Monky/Examples/Network.hs +++ b/Monky/Examples/Network.hs @@ -1,3 +1,21 @@ +{- + Copyright 2015,2016 Markus Ongyerth, Stephan Guenther + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} @@ -9,7 +27,7 @@ Portability : Linux -} -module Monky.Examples.Network +module Monky.Examples.Network ( getNetworkHandles' , getStaticHandle , getDynamicHandle diff --git a/Monky/Examples/Plain.hs b/Monky/Examples/Plain.hs --- a/Monky/Examples/Plain.hs +++ b/Monky/Examples/Plain.hs @@ -1,3 +1,21 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-| Module : Monky.Examples.Plain Description: Print some constant values diff --git a/Monky/Examples/Time.hs b/Monky/Examples/Time.hs --- a/Monky/Examples/Time.hs +++ b/Monky/Examples/Time.hs @@ -1,3 +1,21 @@ +{- + Copyright 2015,2016 Markus Ongyerth, Stephan Guenther + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-# LANGUAGE OverloadedStrings #-} {-| Module : Monky.Examples.Time @@ -22,6 +40,7 @@ import Control.Arrow ((***)) import Monky.Modules +import Monky.Examples.Images import Monky.Time hiding (getTimeHandle) import qualified Monky.Time as MT (getTimeHandle) @@ -38,7 +57,7 @@ getOutput (TH h) = do ts <- getTime h return - [ MonkyImage "clock" '🕐' + [ timeImage , MonkyPlain $ T.pack ts ] @@ -63,7 +82,7 @@ t <- getHM h let (th, tm) = timeToXBM t return - [ MonkyImage (sformat (int % "-" % int) th tm) '🕐' + [ fancyTimeImage (sformat (int % "-" % int) th tm) , MonkyPlain . T.pack $ ts ] diff --git a/Monky/Examples/Utility.hs b/Monky/Examples/Utility.hs --- a/Monky/Examples/Utility.hs +++ b/Monky/Examples/Utility.hs @@ -1,3 +1,21 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-# LANGUAGE OverloadedStrings #-} {-| Module : Monky.Examples.Utility diff --git a/Monky/Examples/Wifi.hs b/Monky/Examples/Wifi.hs --- a/Monky/Examples/Wifi.hs +++ b/Monky/Examples/Wifi.hs @@ -1,3 +1,21 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-| Module : Monky.Examples.Wifi Description : An example module instance for the wifi module diff --git a/Monky/IP.hs b/Monky/IP.hs new file mode 100644 --- /dev/null +++ b/Monky/IP.hs @@ -0,0 +1,165 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} +{-# LANGUAGE TupleSections #-} +{-| +Module : Monky.IP +Description : IP information collection module +Maintainer : ongy +Stability : experimental +Portability : Linux + +Some of this should (and will) move to the netlink package at some point in time. + +This mostly exists, because both i3-status and conky have +modules like this. +IPs have become complicated and I don't really know how +to sanely display IP in formation for an interface. +Feel free to create issues/contact me on IRC if you +want to use this and need a better interface (maybe network length information?) +-} +module Monky.IP + ( IPHandle + , getSocket + , getAddresses + + , AddressFamily(..) + , IP(..) + , getRawFd + , subscribeToEvents + , handleNext + ) +where + +import System.IO (hPutStrLn, stderr) +import Data.Bits ((.|.)) +import Data.Maybe (mapMaybe) +import Data.Word (Word32) + +import System.Posix.Types (Fd) + +import System.Linux.Netlink +import System.Linux.Netlink.Constants hiding (AddressFamily) +import System.Linux.Netlink.Route + +import qualified Data.ByteString.Char8 as BSC (pack) +import qualified Data.ByteString as BS (singleton, append) + +import qualified Data.Map as M + +import Monky.IP.Raw + +-- |Handle to access information about the IPs on the system +data IPHandle = IPHandle NetlinkSocket AddressFamily Word32 + +-- This is RTNLGRP_IPV4_IFADDR, which is not currently exported by the netlink library +cRTNLGRP_IPV4_IFADDR :: Num a => a +cRTNLGRP_IPV4_IFADDR = 5 + +cRTNLGRP_IPV6_IFADDR :: Num a => a +cRTNLGRP_IPV6_IFADDR = 9 + +linkQuery :: String -> RoutePacket +linkQuery name = + let flags = fNLM_F_REQUEST -- .|. fNLM_F_MATCH .|. fNLM_F_ROOT + header = Header eRTM_GETLINK flags 0 0 + msg = NLinkMsg 0 0 0 + attrs = M.fromList [(eIFLA_IFNAME, BSC.pack name `BS.append` BS.singleton 0)] + in + Packet header msg attrs + + +getInterfaceID :: NetlinkSocket -> String -> IO Word32 +getInterfaceID sock name = do + interfaces <- query sock $ linkQuery name + let ids = map (\(Packet _ (NLinkMsg _ index _) _) -> index) interfaces + return $ head ids + +-- |Get an IPHandle to gather information about IPs on the system. +getSocket + :: String -- ^The interface to monitor + -> AddressFamily -- ^The AddressFamily to use + -> IO IPHandle +getSocket name fam = do + sock <- makeSocket + iid <- getInterfaceID sock name + return $ IPHandle sock fam iid + +-- I'm not quite sure why, but apparently RTM_GETADDR only has a version for dumps, not +-- normal requests, so we have to filter the output either way. +addressQuery :: AddressFamily -> RoutePacket +addressQuery fam = + let flags = fNLM_F_REQUEST .|. fNLM_F_MATCH .|. fNLM_F_ROOT + header = Header eRTM_GETADDR flags 0 0 + msg = NAddrMsg (familyToNum fam) 0 0 0 0 + attrs = M.empty + in + Packet header msg attrs + +-- |Get all addresses on the system (filtered by interface and type, see 'getSocket') +getAddresses :: IPHandle -> IO [IP] +getAddresses (IPHandle sock fam iid) = do + packs <- query sock $ addressQuery fam + let matching = filter (\(Packet _ (NAddrMsg _ _ _ _ aid) _) -> aid == iid) packs + let addrs = mapMaybe (M.lookup eIFLA_ADDRESS . packetAttributes) matching + return $ map (ipFromBS) addrs + +-- |Get the raw 'Fd' used by this handle. This can be used to block in RTS controlled manner +getRawFd :: IPHandle -> Fd +getRawFd (IPHandle sock _ _) = getNetlinkFd sock + +-- |Subscribe to the multicast group(s) for this handle. This has to be called ONCE before 'handleNext' can be used. +subscribeToEvents :: IPHandle -> IO () +subscribeToEvents (IPHandle sock fam _) = + let grps = case fam of + AF_UNSPEC -> [cRTNLGRP_IPV6_IFADDR, cRTNLGRP_IPV4_IFADDR] + AF_INET -> [cRTNLGRP_IPV4_IFADDR] + AF_INET6 -> [cRTNLGRP_IPV6_IFADDR] + in + mapM_ (joinMulticastGroup sock) grps + + +-- Handle -> add -> remove -> done +{- |Handle the next event from Netlink + +This will handle the next event reported by the handle. +Before this ever does anything 'subscribeToEvents' has to be called ONCE! +This function can then be called as often as needed and should be called +in a main loop. + +The functions passed may be called multiple times, and sometimes both may be called. +This is a limitation by the netlink api, that cannot be avoided without user space buffers. +-} +handleNext + :: IPHandle -- ^The handle to use + -> (IP -> IO ()) -- ^Function to call with new ip addresses + -> (IP -> IO ()) -- ^Function to call with removed addresses + -> IO () +handleNext (IPHandle sock _ iid) add remove = do + evt <- recvOne sock + let matching = filter (\(Packet _ (NAddrMsg _ _ _ _ aid) _) -> aid == iid) evt + let addrs = mapMaybe transform matching + mapM_ handle addrs + where handle (cmd, addr) + | cmd == eRTM_NEWADDR = add addr + | cmd == eRTM_DELADDR = remove addr + | otherwise = hPutStrLn stderr ("Got unexpeced message while handling IPevents: " ++ show cmd) + transform :: RoutePacket -> Maybe (MessageType, IP) + transform (Packet (Header cmd _ _ _) _ attrs) = + fmap ((cmd,) . ipFromBS) . M.lookup eIFLA_ADDRESS $ attrs + transform err = error ("Something went wrong while handling IP events: " ++ show err) diff --git a/Monky/IP/Raw.hsc b/Monky/IP/Raw.hsc new file mode 100644 --- /dev/null +++ b/Monky/IP/Raw.hsc @@ -0,0 +1,162 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-| +Module : Monky.IP.Raw +Description : Lowlevel IP interfaces +Maintainer : ongy +Stability : experimental +Portability : Linux + +This may change at any time when the main IP module changes. +Consider this API unstable! +-} +module Monky.IP.Raw + ( IP(..) + , IP4 + , IP6 + + , parseIP + , ipFromBS + , familyToNum + , AddressFamily(..) + , getAddrFamily + ) +where + +import Data.ByteString (ByteString, useAsCStringLen, packCStringLen) +import qualified Data.ByteString as BS (length) +import Data.Serialize (decode) + +import Data.Word (Word32, Word64) +import Foreign.C.String (CString, withCString, peekCString) +import Foreign.C.Types (CInt(..), CChar) +import Foreign.Marshal.Alloc (alloca, allocaBytes) +import Foreign.Marshal.Utils (with) +import Foreign.Ptr (Ptr, castPtr) +import Foreign.Storable (Storable(..)) + +import System.IO.Unsafe (unsafePerformIO) + +foreign import ccall "inet_pton" c_pton :: CInt -> CString -> Ptr IP4 -> IO () +foreign import ccall "inet_ntop" c_ntop :: CInt -> Ptr a -> Ptr CChar -> Word64 -> IO (Ptr CChar) +foreign import ccall "ntohl" ntohl :: Word32 -> Word32 +foreign import ccall "htonl" htonl :: Word32 -> Word32 + +foreign import ccall "memcpy" memcpy :: Ptr a -> Ptr b -> Word64 -> IO () + +-- |IPv4 addresses +newtype IP4 = IP4 Word32 deriving (Eq) +-- |IPv6 addresses +newtype IP6 = IP6 ByteString deriving (Eq) + +-- |Datatype for IP addresses, abstracts over v4/v6 +data IP + = IPv4 IP4 + | IPv6 IP6 + deriving (Eq) + +-- |AddressFamilies support for libraries +data AddressFamily + = AF_UNSPEC + | AF_INET + | AF_INET6 + + + +#include +#include +#include +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 Storable IP6 where + sizeOf _ = 16 + alignment _ = alignment (undefined :: Word64) + peek p = fmap IP6 $ packCStringLen (castPtr p, 16) + poke p (IP6 w) = useAsCStringLen w (\(b, _) -> memcpy p b 16) + +instance Show IP where + show (IPv4 ip) = show ip + show (IPv6 ip) = show ip + + +instance Show IP6 where + show = showIP6 + +instance Show IP4 where + show = showIP + + +showIPIO :: IP4 -> IO String +showIPIO ip = allocaBytes #{const INET_ADDRSTRLEN} (\str -> + with ip (\ptr -> c_ntop (familyToNum 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 (familyToNum AF_INET) str ptr >> peek ptr)) + +-- All sideeffects are contained in the IO action and it is deterministic, so we can drop the IO +-- |Parse an IP4 from a String +parseIP :: String -> IP4 +parseIP str = unsafePerformIO (parseIPIO str) +{-# NOINLINE parseIP #-} + + +-- |Read an IP from a ByteString. The type is determined by the size of the ByteString. +ipFromBS :: ByteString -> IP +ipFromBS bs = if BS.length bs == 16 + then IPv6 (IP6 bs) + else case decode bs of + (Left err) -> error ("Failed to decode ip: " ++ err) + (Right x) -> IPv4 (IP4 x) + + +showIP6IO :: IP6 -> IO String +showIP6IO ip = allocaBytes #{const INET_ADDRSTRLEN} (\str -> + with ip (\ptr -> c_ntop (familyToNum AF_INET6) ptr str #{const INET6_ADDRSTRLEN}) >> peekCString str) + +-- All sideeffects are contained in the IO action and it is deterministic, so we can drop the IO +showIP6 :: IP6 -> String +showIP6 ip = unsafePerformIO (showIP6IO ip) +{-# NOINLINE showIP6 #-} + + +-- A few things good to have: +-- |Get the number associated with the family address. This is for interfacing with libraries +familyToNum :: Num a => AddressFamily -> a +familyToNum AF_UNSPEC = 0 +familyToNum AF_INET = #{const AF_INET} +familyToNum AF_INET6 = #{const AF_INET6} + +-- |Get the address family for a given ip address +getAddrFamily :: IP -> AddressFamily +getAddrFamily (IPv6 _) = AF_INET6 +getAddrFamily (IPv4 _) = AF_INET diff --git a/Monky/Memory.hs b/Monky/Memory.hs --- a/Monky/Memory.hs +++ b/Monky/Memory.hs @@ -56,24 +56,39 @@ findLine :: ByteString -> [ByteString] -> Maybe ByteString findLine x = listToMaybe . filter (x `BS.isPrefixOf`) --- |Return the memory available to processes +{- |Return the memory available to userspace + +This is accurate (read from kernel) for current kernels. +Old kernel (~3.13) estimates this. Old kernels may overestimate. +-} getMemoryAvailable :: MemoryHandle -> IO Int getMemoryAvailable (MemoryH f) = do contents <- readContent f - return $getVal $fromMaybe "a 0" $findLine "MemAvailable" contents + let line = findLine "MemAvailable" contents + case line of + Nothing -> do + let buffs = fromMaybe err $ findLine "Buffers" contents + cached = fromMaybe err $ findLine "Cached" contents + free <- getMemoryFree (MemoryH f) + return $ getVal buffs + getVal cached + free + (Just x) -> return . getVal $ x + where err = error "Could not find one of the fallback values for MemAvailable, please report this together with the content of /proc/meminfo" + -- |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 + return . getVal . fromMaybe err . findLine "MemTotal" $ contents + where err = error "Could not find MemTotal in /proc/meminfo. Please report this bug with the content of /proc/meminfo" -- |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 + return . getVal . fromMaybe err . findLine "MemFree" $ contents + where err = error "Could not find MemFree in /proc/meminfo. Please report this bug with the content of /proc/meminfo" -- |Get the amount of memory used by the kernel and processes getMemoryUsed :: MemoryHandle -> IO Int diff --git a/Monky/Network/Dynamic.hs b/Monky/Network/Dynamic.hs --- a/Monky/Network/Dynamic.hs +++ b/Monky/Network/Dynamic.hs @@ -1,3 +1,21 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE CPP #-} diff --git a/Monky/Outputs/Ascii.hs b/Monky/Outputs/Ascii.hs --- a/Monky/Outputs/Ascii.hs +++ b/Monky/Outputs/Ascii.hs @@ -1,3 +1,21 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE EmptyDataDecls #-} {-| diff --git a/Monky/Outputs/Dzen2.hs b/Monky/Outputs/Dzen2.hs --- a/Monky/Outputs/Dzen2.hs +++ b/Monky/Outputs/Dzen2.hs @@ -1,3 +1,21 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-# LANGUAGE OverloadedStrings #-} {-| Module : Monky.Outputs/Dzen2 diff --git a/Monky/Outputs/Fallback.hs b/Monky/Outputs/Fallback.hs --- a/Monky/Outputs/Fallback.hs +++ b/Monky/Outputs/Fallback.hs @@ -1,3 +1,21 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE CPP #-} {-| @@ -11,6 +29,7 @@ module Monky.Outputs.Fallback ( WrapOuts , getFallbackOut + , chooseTerminalOut ) where diff --git a/Monky/Outputs/Guess.hs b/Monky/Outputs/Guess.hs new file mode 100644 --- /dev/null +++ b/Monky/Outputs/Guess.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE CPP #-} +module Monky.Outputs.Guess + ( guessOutput + , GuessOut + ) +where + +import Data.Text (Text) + +import Control.Exception (try) +import Data.Char (isDigit) +import Data.List (isPrefixOf) +import Data.Maybe (catMaybes) +import System.Directory (getDirectoryContents) +import System.IO (hIsTerminalDevice, stdout) +import System.IO.Error (IOError) +import System.Posix.Files (readSymbolicLink) + +import Monky.Modules +import Monky.Outputs.Fallback (chooseTerminalOut) +import Monky.Outputs.Show (getShowOut) +import Monky.Outputs.Dzen2 (getDzenOut) +import Monky.Outputs.I3 (getI3Output) +import Monky.Outputs.Serialize (getSerializeOut) + +#if MIN_VERSION_base(4,8,0) +#else +import Control.Applicative ((<$>)) +#endif + +data Output + = Terminal + | Process String + | Other + deriving (Eq, Ord, Show) + +data GuessOut = forall a . MonkyOutput a => GO a + +instance MonkyOutput GuessOut where + doLine (GO o) = doLine o + + +networkOuts :: [String] +networkOuts = ["netcat", "nc", "socat"] + + +fdToPath :: String -> Int -> IO String +fdToPath proc fd = readSymbolicLink ("/proc/" ++ proc ++ "/fd/" ++ show fd) + + +getProcFds :: String -> IO (Maybe (String, [(Int, String)])) +getProcFds proc = do + ret <- try $ do + fds <- map read . filter (not . isPrefixOf ".") <$> getDirectoryContents ("/proc/" ++ proc ++ "/fd/") + paths <- mapM (fdToPath proc) fds + exe <- readSymbolicLink ("/proc/" ++ proc ++ "/exe") + return (reverse . takeWhile (/= '/') . reverse $ exe, zip fds paths) + return $ case ret of + (Left (_ :: IOError)) -> Nothing + (Right x) -> Just x + + +hasPipe :: String -> (String, [(Int, String)]) -> Bool +hasPipe pipe (_, xs) = any (\(fd, path) -> path == pipe && fd /= 1) xs + + +pickCandidate :: String -> [(String, [(Int, String)])] -> Maybe String +pickCandidate _ [] = Nothing +pickCandidate _ [(x, _)] = Just x +pickCandidate pipe xs = + let std = filter (\(_, ys) -> any (\(i, path) -> i == 1 && path == pipe) ys) xs in + Just . fst $ if null std + then head xs + else head std + + +getOutputType :: IO Output +getOutputType = do + term <- hIsTerminalDevice stdout + if term + then return Terminal + else do + procs <- filter (all isDigit) <$> getDirectoryContents "/proc" + fds <- catMaybes <$> mapM getProcFds procs + own <- readSymbolicLink ("/proc/self/fd/1") + + let candidates = filter (hasPipe own) fds + let candidate = pickCandidate own candidates + return $ case candidate of + Nothing -> Other + (Just x) -> Process x + +-- Same inputs as 'gessOutput' +chooseProcessOut + :: Int + -> Text + -> String + -> IO GuessOut +chooseProcessOut height path x + | x == "dzen2" = GO <$> getDzenOut height path + | x == "i3-bar" = GO <$> getI3Output + | x `elem`networkOuts = GO <$> getSerializeOut + | otherwise = GO <$> getShowOut + +guessOutput + :: Int -- ^Dzen height + -> Text -- ^Dzen xbm path + -> IO GuessOut +guessOutput height path = do + out <- getOutputType + case out of + Terminal -> GO <$> chooseTerminalOut + Other -> {- for other we just use show -} GO <$> getShowOut + (Process x) -> chooseProcessOut height path x diff --git a/Monky/Outputs/I3.hs b/Monky/Outputs/I3.hs new file mode 100644 --- /dev/null +++ b/Monky/Outputs/I3.hs @@ -0,0 +1,100 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} +{-# LANGUAGE OverloadedStrings #-} +{-| +Module : Monky.Outputs.I3 +Description : Output module for i3-bar +Maintainer : ongy +Stability : testing +Portability : Linux + +This module provides the output generation for i3-bar outputs +-} +module Monky.Outputs.I3 + ( I3Output + , getI3Output + ) +where + +import Monky.Modules +import Monky.Outputs.Unicode + +import Control.Monad (unless) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import System.IO (hFlush, stdout) + +-- |Output handle for i3-bar +data I3Output = I3Output + +i3Full :: Text -> Text +i3Full xs = "\"full_text\": \"" `T.append` xs `T.append` "\"" + +getOut :: MonkyOut -> Text +getOut (MonkyPlain t) = i3Full t +getOut (MonkyImage _ c) = i3Full $ T.singleton c -- Images are not supported :( +getOut (MonkyBar p) = i3Full $ T.singleton (barChar p) +getOut (MonkyHBar p) = i3Full $ T.pack (replicate (p `div` 10) '█') `T.append` (T.singleton $ hBarChar (p `mod` 10 * 10)) +getOut (MonkyColor (f, b) o) = T.concat + [ getOut o + , ", \"color\": \"" + , f + , "\", \"background\": \"" + , b + , "\"" + ] + +doSegment :: [MonkyOut] -> IO () +doSegment [] = return () +doSegment [x] = do + putChar '{' + T.putStr $ getOut x + putChar '}' +doSegment (x:xs) = do + putChar '{' + T.putStr $ getOut x + putStr ", \"separator\": false" + putStr ", \"separator_block_width\": 1" + putStr "}," + doSegment xs + +outputLine :: [[MonkyOut]] -> IO () +outputLine [] = error "i3-output outputLIne should never be called with an empty list" +outputLine [x] = doSegment x +outputLine (x:xs) = do + doSegment x + unless (null x) (putChar ',') + outputLine xs + +instance MonkyOutput I3Output where + doLine _ xs = do + putChar '[' + outputLine xs + putStr "]," + putChar '\n' + hFlush stdout + + +-- | Get output handle for i3-bar. This initializes the communication on generation +getI3Output :: IO I3Output +getI3Output = do + putStrLn "{\"version\":1}" -- Static version thingy we have to print + putChar '[' -- Start the output lines array + return I3Output diff --git a/Monky/Outputs/Serialize.hs b/Monky/Outputs/Serialize.hs --- a/Monky/Outputs/Serialize.hs +++ b/Monky/Outputs/Serialize.hs @@ -1,3 +1,21 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-| Module : Monky.Outputs.Serialize Description : Output module for storing diff --git a/Monky/Outputs/Show.hs b/Monky/Outputs/Show.hs --- a/Monky/Outputs/Show.hs +++ b/Monky/Outputs/Show.hs @@ -1,3 +1,21 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-| Module : Monky.Outputs.Show Description : Output module for storing diff --git a/Monky/Outputs/Unicode.hs b/Monky/Outputs/Unicode.hs new file mode 100644 --- /dev/null +++ b/Monky/Outputs/Unicode.hs @@ -0,0 +1,54 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} +{-| +Module : Monky.Outputs.Unicode +Description : Provides helper functions for output generators that use unicode +Maintainer : ongy +Stability : testing +Portability : Linux + +-} +module Monky.Outputs.Unicode +where + +-- |Unicode block char for vertical bar (in %) +barChar :: Integral a => a -> Char +barChar i + | i <= 0 = ' ' + | 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 = '█' + +-- |Horizontalblock char for horizontal bar (in % of char) +hBarChar :: Integral a => a -> 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 = '█' + diff --git a/Monky/Outputs/Utf8.hs b/Monky/Outputs/Utf8.hs --- a/Monky/Outputs/Utf8.hs +++ b/Monky/Outputs/Utf8.hs @@ -1,3 +1,21 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE EmptyDataDecls #-} {-| @@ -17,33 +35,12 @@ import System.IO (hFlush, stdout) import Monky.Modules +import Monky.Outputs.Unicode 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 diff --git a/Monky/Wifi.hs b/Monky/Wifi.hs --- a/Monky/Wifi.hs +++ b/Monky/Wifi.hs @@ -1,3 +1,21 @@ +{- + Copyright 2016 Markus Ongyerth + + This file is part of Monky. + + Monky is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Monky is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with Monky. If not, see . +-} {-# LANGUAGE CPP #-} {-| Module : Monky.Wifi diff --git a/bin/Main.hs b/bin/Main.hs --- a/bin/Main.hs +++ b/bin/Main.hs @@ -1,5 +1,5 @@ {- - Copyright 2015 Markus Ongyerth, Stephan Guenther + Copyright 2015,2016 Markus Ongyerth, Stephan Guenther This file is part of Monky. diff --git a/monky.cabal b/monky.cabal --- a/monky.cabal +++ b/monky.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 2.0.0.0 +version: 2.0.1.0 -- The ABOVE LINE has to stay AS IS (except for version changes) for the -- template to work properly @@ -138,8 +138,11 @@ 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 + exposed-modules: Monky.Outputs.Dzen2 Monky.Outputs.Ascii Monky.Outputs.Utf8 Monky.Outputs.Guess + exposed-modules: Monky.Outputs.Show Monky.Outputs.Fallback Monky.Outputs.Serialize Monky.Outputs.I3 + exposed-modules: Monky.Examples.Modify Monky.IP Monky.IP.Raw + + exposed-modules: Monky.Outputs.Unicode Monky.Examples.Images other-modules: Monky.Template Monky.VersionTH