summaryrefslogtreecommitdiffstats
path: root/src/Flameshot/Internal.hs
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)