{-# LANGUAGE RankNTypes #-}
module Aura.Utils
(
Pattern(..)
, searchLines
, urlContents
, foldMap1
, fold1
, hush
, note
, fmapEither
, traverseEither
, These(..)
, these
, edit
, Traversal'
, maybe'
, groupsOf
, nes
, partNonEmpty
) where
import Data.Bifunctor
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, _target :: Text }
searchLines :: Text -> [Text] -> [Text]
searchLines pat = filter (T.isInfixOf pat)
urlContents :: Manager -> String -> IO (Maybe ByteString)
urlContents m url = f <$> httpLbs (parseRequest_ url) m
where
f :: Response BL.ByteString -> Maybe ByteString
f res | statusCode (responseStatus res) == 200 = Just . BL.toStrict $ responseBody res
| otherwise = Nothing
edit :: FilePath -> FilePath -> IO ()
edit editor p = void . runProcess $ proc editor [p]
maybe' :: b -> Maybe a -> (a -> b) -> b
maybe' zero m f = maybe zero f m
fmapEither :: (a -> Either b c) -> [a] -> ([b], [c])
fmapEither f = foldl' (deal f) ([],[])
where
deal :: (a -> Either b c) -> ([b], [c]) -> a -> ([b], [c])
deal g ~(bs, cs) a = case g a of
Left b -> (b:bs, cs)
Right c -> (bs, c:cs)
traverseEither :: Applicative f => (a -> f (Either b c)) -> [a] -> f ([b], [c])
traverseEither f = fmap partitionEithers . traverse f
groupsOf :: Int -> [a] -> [[a]]
groupsOf n as
| n <= 0 = []
| otherwise = go as
where
go [] = []
go bs = xs : go rest
where
(xs, rest) = L.splitAt n bs
nes :: Set a -> Maybe (NonEmpty a)
nes = NEL.nonEmpty . S.toList
hush :: Either a b -> Maybe b
hush = either (const Nothing) Just
note :: a -> Maybe b -> Either a b
note a = maybe (Left a) Right
foldMap1 :: Semigroup m => (a -> m) -> NonEmpty a -> m
foldMap1 f (a :| []) = f a
foldMap1 f (a :| b : bs) = f a <> foldMap1 f (b :| bs)
fold1 :: Semigroup m => NonEmpty m -> m
fold1 = foldMap1 id
partNonEmpty :: (a -> These b c) -> NonEmpty a -> These (NonEmpty b) (NonEmpty c)
partNonEmpty f = foldMap1 (bimap pure pure . 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 x <> This y = This (x <> y)
This x <> These z y = These (x <> z) y
This x <> That y = These x y
That x <> That y = That (x <> y)
That x <> This y = These y x
That x <> These y z = These y (x <> z)
These w x <> This y = These (w <> y) x
These w x <> That y = These w (x <> y)
These w x <> These y z = These (w <> y) (x <> z)
instance Bifunctor These where
bimap f _ (This x) = This (f x)
bimap _ g (That y) = That (g y)
bimap f g (These x y) = These (f x) (g y)
these :: (a -> t) -> (b -> t) -> (a -> b -> t) -> These a b -> t
these f _ _ (This a) = f a
these _ g _ (That b) = g b
these _ _ h (These a b) = h a b