summaryrefslogtreecommitdiffstats
path: root/src/Flameshot/Internal.hs
diff options
context:
space:
mode:
authortv <tv@krebsco.de>2019-02-07 18:42:36 +0100
committertv <tv@krebsco.de>2019-02-07 18:54:59 +0100
commitfb5636483871fbafe9b286b377c339c8ddf8b4f8 (patch)
tree5016d6b38bff4b13856828ee385aaf7498d8e344 /src/Flameshot/Internal.hs
initial commitv1.0.0-rc1
Diffstat (limited to 'src/Flameshot/Internal.hs')
-rw-r--r--src/Flameshot/Internal.hs96
1 files changed, 96 insertions, 0 deletions
diff --git a/src/Flameshot/Internal.hs b/src/Flameshot/Internal.hs
new file mode 100644
index 0000000..28b33cf
--- /dev/null
+++ b/src/Flameshot/Internal.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Flameshot.Internal where
+
+import Blessings.Text
+import Control.Concurrent.Async (race)
+import Control.Concurrent.Extended
+import Control.Exception
+import qualified Data.Char as C
+import Data.Function (on)
+import Data.Time.Clock.System
+import Data.Time.ISO8601
+import DBus
+import DBus.Socket
+import Data.Text (Text)
+import qualified Data.Text.Extended as T
+
+
+blessBusName :: BusName -> Blessings Text
+blessBusName = Plain . T.pack . formatBusName
+
+blessMemberName :: MemberName -> Blessings Text
+blessMemberName = Plain . T.pack . formatMemberName
+
+blessShow :: Show a => a -> Blessings Text
+blessShow = Plain . T.show
+
+blessTime :: Int -> Blessings Text
+blessTime = Plain . (<>"μs") . T.show
+
+red :: Blessings Text -> Blessings Text
+red = SGR [31]
+
+
+
+withThread :: IO () -> (ThreadId -> IO a) -> IO a
+withThread tf wtf =
+ bracket (forkIO tf) killThread wtf
+
+withThread_ :: IO () -> IO a -> IO a
+withThread_ tf wtf =
+ bracket (forkIO tf) killThread (const wtf)
+
+
+timeout :: Int -> IO a -> IO (Either Int a)
+timeout time io =
+ race (threadDelay time) io >>= \case
+ Right x -> return (Right x)
+ Left () -> return (Left time)
+
+
+dbusInterface :: InterfaceName
+dbusInterface = "org.freedesktop.DBus"
+
+withSocket :: Address -> (Socket -> IO a) -> IO a
+withSocket addr = bracket (open addr) close
+
+
+getTimestamp :: IO String
+getTimestamp =
+ formatISO8601Micros . systemToUTCTime <$> getSystemTime
+
+prefixTimestamp :: Blessings Text -> IO (Blessings Text)
+prefixTimestamp s =
+ (<> s) . (<>" ") . SGR [38,5,239] . Plain . T.pack <$> getTimestamp
+
+showUnprintable :: Blessings Text -> Blessings Text
+showUnprintable =
+ fmap' showU
+ where
+ showU :: Text -> Blessings Text
+ showU =
+ mconcat
+ . map (either Plain (hi . Plain . showLitChars))
+ . toEither (not . C.isPrint)
+
+ -- like Blessings' fmap, but don't wrap the Plain case in another Plain
+ fmap' :: (Text -> Blessings Text) -> Blessings Text -> Blessings Text
+ fmap' f = \case
+ Append t1 t2 -> Append (fmap' f t1) (fmap' f t2)
+ Plain s -> f s
+ SGR pm t -> SGR pm (fmap' f t)
+ Empty -> Empty
+
+ hi = SGR [38,5,79]
+
+ showLitChars :: Text -> Text
+ showLitChars = T.concatMap (T.pack . flip C.showLitChar "")
+
+ toEither :: (Char -> Bool) -> Text -> [Either Text Text]
+ toEither p =
+ map (\s -> if p (T.head s) then Right s else Left s)
+ . T.groupBy ((==) `on` p)