{-# LANGUAGE RankNTypes #-}

-- |
-- Module    : Aura.Utils
-- Copyright : (c) Colin Woodbury, 2012 - 2020
-- License   : GPL3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- Utility functions specific to Aura.

module Aura.Utils
  ( -- * Strings
    Pattern(..)
  , searchLines
    -- * Network
  , urlContents
    -- * Semigroupoids
  , foldMap1
  , fold1
    -- * Errors
  , hush
  , note
    -- * Compactable
  , fmapEither
  , traverseEither
    -- * These
  , These(..)
  , these
    -- * Directory
  , edit
    -- * Lens
  , Traversal'
    -- * Misc.
  , 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)

---

---------
-- STRING
---------
-- | For regex-like find-and-replace in some `Text`.
data Pattern = Pattern { Pattern -> Text
_pattern :: !Text, Pattern -> Text
_target :: !Text }

-- | Find lines which contain some given `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)

----------
-- NETWORK
----------
-- | Assumes the given URL is correctly formatted.
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

--------------
-- DIRECTORIES
--------------
-- | Edit some file in-place with the user's specified editor.
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]

-------
-- MISC
-------
-- | `maybe` with the function at the end.
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

-- | Borrowed from Compactable.
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)

-- | Borrowed from Compactable.
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

-- | Break a list into groups of @n@ elements. The last item in the result is
-- not guaranteed to have the same length as the others.
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

-- | Borrowed from semigroupoids.
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)

-- | Borrowed from semigroupoids.
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

-- | Partition a `NonEmpty` based on some function.
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)

--------------------------------------------------------------------------------
-- Lens

-- | Simple Traversals compatible with both lens and microlens.
type Traversal' s a = forall f. Applicative f => (a -> f a) -> s -> f s

--------------------------------------------------------------------------------
-- These

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