{-# LANGUAGE RankNTypes #-}
module Aura.Utils
(
Pattern(..)
, searchLines
, urlContents
, foldMap1
, fold1
, hush
, note
, fmapEither
, traverseEither
, These(..)
, these
, edit
, Traversal'
, maybe'
, groupsOf
, nes
, partNonEmpty
) where
import Network.HTTP.Client
import Network.HTTP.Types.Status (statusCode)
import RIO
import qualified RIO.ByteString.Lazy as BL
import qualified RIO.List as L
import qualified RIO.NonEmpty as NEL
import qualified RIO.Set as S
import qualified RIO.Text as T
import System.Process.Typed (proc, runProcess)
data Pattern = Pattern { Pattern -> Text
_pattern :: !Text, Pattern -> Text
_target :: !Text }
searchLines :: Text -> [Text] -> [Text]
searchLines :: Text -> [Text] -> [Text]
searchLines Text
pat = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
T.isInfixOf Text
pat)
urlContents :: Manager -> String -> IO (Maybe ByteString)
urlContents :: Manager -> String -> IO (Maybe ByteString)
urlContents Manager
m String
url = Response ByteString -> Maybe ByteString
f (Response ByteString -> Maybe ByteString)
-> IO (Response ByteString) -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> Manager -> IO (Response ByteString)
httpLbs (String -> Request
parseRequest_ String
url) Manager
m
where
f :: Response BL.ByteString -> Maybe ByteString
f :: Response ByteString -> Maybe ByteString
f Response ByteString
res | Status -> Int
statusCode (Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
res) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
200 = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (ByteString -> ByteString) -> ByteString -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
res
| Bool
otherwise = Maybe ByteString
forall a. Maybe a
Nothing
edit :: FilePath -> FilePath -> IO ()
edit :: String -> String -> IO ()
edit String
editor String
p = IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ())
-> (ProcessConfig () () () -> IO ExitCode)
-> ProcessConfig () () ()
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig () () () -> IO ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess (ProcessConfig () () () -> IO ())
-> ProcessConfig () () () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> ProcessConfig () () ()
proc String
editor [String
p]
maybe' :: b -> Maybe a -> (a -> b) -> b
maybe' :: b -> Maybe a -> (a -> b) -> b
maybe' b
zero Maybe a
m a -> b
f = b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
zero a -> b
f Maybe a
m
fmapEither :: (a -> Either b c) -> [a] -> ([b], [c])
fmapEither :: (a -> Either b c) -> [a] -> ([b], [c])
fmapEither a -> Either b c
f = (([b], [c]) -> a -> ([b], [c])) -> ([b], [c]) -> [a] -> ([b], [c])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> Either b c) -> ([b], [c]) -> a -> ([b], [c])
forall a b c. (a -> Either b c) -> ([b], [c]) -> a -> ([b], [c])
deal a -> Either b c
f) ([],[])
where
deal :: (a -> Either b c) -> ([b], [c]) -> a -> ([b], [c])
deal :: (a -> Either b c) -> ([b], [c]) -> a -> ([b], [c])
deal a -> Either b c
g ~([b]
bs, [c]
cs) a
a = case a -> Either b c
g a
a of
Left b
b -> (b
bb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
bs, [c]
cs)
Right c
c -> ([b]
bs, c
cc -> [c] -> [c]
forall a. a -> [a] -> [a]
:[c]
cs)
traverseEither :: Applicative f => (a -> f (Either b c)) -> [a] -> f ([b], [c])
traverseEither :: (a -> f (Either b c)) -> [a] -> f ([b], [c])
traverseEither a -> f (Either b c)
f = ([Either b c] -> ([b], [c])) -> f [Either b c] -> f ([b], [c])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either b c] -> ([b], [c])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (f [Either b c] -> f ([b], [c]))
-> ([a] -> f [Either b c]) -> [a] -> f ([b], [c])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f (Either b c)) -> [a] -> f [Either b c]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f (Either b c)
f
groupsOf :: Int -> [a] -> [[a]]
groupsOf :: Int -> [a] -> [[a]]
groupsOf Int
n [a]
as
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = []
| Bool
otherwise = [a] -> [[a]]
forall a. [a] -> [[a]]
go [a]
as
where
go :: [a] -> [[a]]
go [] = []
go [a]
bs = [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
go [a]
rest
where
([a]
xs, [a]
rest) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
L.splitAt Int
n [a]
bs
nes :: Set a -> Maybe (NonEmpty a)
nes :: Set a -> Maybe (NonEmpty a)
nes = [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty ([a] -> Maybe (NonEmpty a))
-> (Set a -> [a]) -> Set a -> Maybe (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
S.toList
hush :: Either a b -> Maybe b
hush :: Either a b -> Maybe b
hush = (a -> Maybe b) -> (b -> Maybe b) -> Either a b -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe b -> a -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing) b -> Maybe b
forall a. a -> Maybe a
Just
note :: a -> Maybe b -> Either a b
note :: a -> Maybe b -> Either a b
note a
a = Either a b -> (b -> Either a b) -> Maybe b -> Either a b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> Either a b
forall a b. a -> Either a b
Left a
a) b -> Either a b
forall a b. b -> Either a b
Right
foldMap1 :: Semigroup m => (a -> m) -> NonEmpty a -> m
foldMap1 :: (a -> m) -> NonEmpty a -> m
foldMap1 a -> m
f (a
a :| []) = a -> m
f a
a
foldMap1 a -> m
f (a
a :| a
b : [a]
bs) = a -> m
f a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> NonEmpty a -> m
forall m a. Semigroup m => (a -> m) -> NonEmpty a -> m
foldMap1 a -> m
f (a
b a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
bs)
fold1 :: Semigroup m => NonEmpty m -> m
fold1 :: NonEmpty m -> m
fold1 = (m -> m) -> NonEmpty m -> m
forall m a. Semigroup m => (a -> m) -> NonEmpty a -> m
foldMap1 m -> m
forall a. a -> a
id
partNonEmpty :: (a -> These b c) -> NonEmpty a -> These (NonEmpty b) (NonEmpty c)
partNonEmpty :: (a -> These b c) -> NonEmpty a -> These (NonEmpty b) (NonEmpty c)
partNonEmpty a -> These b c
f = (a -> These (NonEmpty b) (NonEmpty c))
-> NonEmpty a -> These (NonEmpty b) (NonEmpty c)
forall m a. Semigroup m => (a -> m) -> NonEmpty a -> m
foldMap1 ((b -> NonEmpty b)
-> (c -> NonEmpty c)
-> These b c
-> These (NonEmpty b) (NonEmpty c)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap b -> NonEmpty b
forall (f :: * -> *) a. Applicative f => a -> f a
pure c -> NonEmpty c
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These b c -> These (NonEmpty b) (NonEmpty c))
-> (a -> These b c) -> a -> These (NonEmpty b) (NonEmpty c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> These b c
f)
type Traversal' s a = forall f. Applicative f => (a -> f a) -> s -> f s
data These a b = This a | That b | These a b
instance (Semigroup a, Semigroup b) => Semigroup (These a b) where
This a
x <> :: These a b -> These a b -> These a b
<> This a
y = a -> These a b
forall a b. a -> These a b
This (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y)
This a
x <> These a
z b
y = a -> b -> These a b
forall a b. a -> b -> These a b
These (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
z) b
y
This a
x <> That b
y = a -> b -> These a b
forall a b. a -> b -> These a b
These a
x b
y
That b
x <> That b
y = b -> These a b
forall a b. b -> These a b
That (b
x b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
y)
That b
x <> This a
y = a -> b -> These a b
forall a b. a -> b -> These a b
These a
y b
x
That b
x <> These a
y b
z = a -> b -> These a b
forall a b. a -> b -> These a b
These a
y (b
x b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
z)
These a
w b
x <> This a
y = a -> b -> These a b
forall a b. a -> b -> These a b
These (a
w a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y) b
x
These a
w b
x <> That b
y = a -> b -> These a b
forall a b. a -> b -> These a b
These a
w (b
x b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
y)
These a
w b
x <> These a
y b
z = a -> b -> These a b
forall a b. a -> b -> These a b
These (a
w a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y) (b
x b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
z)
instance Bifunctor These where
bimap :: (a -> b) -> (c -> d) -> These a c -> These b d
bimap a -> b
f c -> d
_ (This a
x) = b -> These b d
forall a b. a -> These a b
This (a -> b
f a
x)
bimap a -> b
_ c -> d
g (That c
y) = d -> These b d
forall a b. b -> These a b
That (c -> d
g c
y)
bimap a -> b
f c -> d
g (These a
x c
y) = b -> d -> These b d
forall a b. a -> b -> These a b
These (a -> b
f a
x) (c -> d
g c
y)
these :: (a -> t) -> (b -> t) -> (a -> b -> t) -> These a b -> t
these :: (a -> t) -> (b -> t) -> (a -> b -> t) -> These a b -> t
these a -> t
f b -> t
_ a -> b -> t
_ (This a
a) = a -> t
f a
a
these a -> t
_ b -> t
g a -> b -> t
_ (That b
b) = b -> t
g b
b
these a -> t
_ b -> t
_ a -> b -> t
h (These a
a b
b) = a -> b -> t
h a
a b
b