blob: 56a35b47530dbd95440295a809f3daacc332b0cc (
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
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
{-# 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 Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.Char as C
import Data.Function (on)
import Data.Maybe (fromMaybe)
import Data.Time.Clock
import Data.Time.Clock.System
import Data.Time.Format
import Data.Time.ISO8601
import DBus
import DBus.Internal.Message
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
blessMethodError :: MethodError -> Blessings Text
blessMethodError err@MethodError{..} =
red . Plain $ fromMaybe (T.show err) msg
where
msg = if length methodErrorBody > 0
then fromVariant (methodErrorBody !! 0)
else Nothing
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)
saveImage :: FilePath -> ByteString -> IO ()
saveImage cGuiPath rawImage = do
t <- formatISO8601Seconds . systemToUTCTime <$> getSystemTime
let path = cGuiPath <> "/" <> baseName
baseName = t <> "_flameshot.png"
BS.writeFile path rawImage
formatISO8601Seconds :: UTCTime -> String
formatISO8601Seconds =
formatTime defaultTimeLocale (iso8601DateFormat $ Just "%H:%M:%SZ")
|
