blob: 28b33cf654bacd6d33e7e273f4b297745decd69e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
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)
|
