{-# LANGUAGE CPP #-}

-- |
--  Module      : Auth.Biscuit.Utils
--  Copyright   : © Clément Delafargue, 2021
--  License     : MIT
--  Maintainer  : clement@delafargue.name
module Auth.Biscuit.Utils
  ( maybeToRight,
    rightToMaybe,
    encodeHex,
    encodeHex',
    decodeHex,
    anyM,
    allM,
    setFilterM,
    foldMapM,
    mapMaybeM,
  )
where

#if MIN_VERSION_base16(1,0,0)
import qualified Data.Base16.Types      as Hex
#endif
import           Data.Bool              (bool)
import           Data.ByteString        (ByteString)
import qualified Data.ByteString.Base16 as Hex
import           Data.Maybe             (maybeToList)
import           Data.Monoid            (All (..), Any (..))
import           Data.Set               (Set)
import qualified Data.Set               as Set
import           Data.Text              (Text)

encodeHex :: ByteString -> Text
#if MIN_VERSION_base16(1,0,0)
encodeHex :: ByteString -> Text
encodeHex = Base16 Text -> Text
forall a. Base16 a -> a
Hex.extractBase16 (Base16 Text -> Text)
-> (ByteString -> Base16 Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base16 Text
Hex.encodeBase16
#else
encodeHex = Hex.encodeBase16
#endif

encodeHex' :: ByteString -> ByteString
#if MIN_VERSION_base16(1,0,0)
encodeHex' :: ByteString -> ByteString
encodeHex' = Base16 ByteString -> ByteString
forall a. Base16 a -> a
Hex.extractBase16 (Base16 ByteString -> ByteString)
-> (ByteString -> Base16 ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base16 ByteString
Hex.encodeBase16'
#else
encodeHex' = Hex.encodeBase16'
#endif

decodeHex :: ByteString -> Either Text ByteString
#if MIN_VERSION_base16(1,0,0)
decodeHex :: ByteString -> Either Text ByteString
decodeHex = ByteString -> Either Text ByteString
Hex.decodeBase16Untyped
#else
decodeHex = Hex.decodeBase16
#endif

-- | Exactly like `maybeToRight` from the `either` package,
-- but without the dependency footprint
maybeToRight :: b -> Maybe a -> Either b a
maybeToRight :: forall b a. b -> Maybe a -> Either b a
maybeToRight b
b = Either b a -> (a -> Either b a) -> Maybe a -> Either b a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (b -> Either b a
forall a b. a -> Either a b
Left b
b) a -> Either b a
forall a b. b -> Either a b
Right

-- | Exactly like `rightToMaybe` from the `either` package,
-- but without the dependency footprint
rightToMaybe :: Either b a -> Maybe a
rightToMaybe :: forall b a. Either b a -> Maybe a
rightToMaybe = (b -> Maybe a) -> (a -> Maybe a) -> Either b a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> b -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just

anyM :: (Foldable t, Monad m) => (a -> m Bool) -> t a -> m Bool
anyM :: forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m Bool) -> t a -> m Bool
anyM a -> m Bool
f = (Any -> Bool) -> m Any -> m Bool
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Any -> Bool
getAny (m Any -> m Bool) -> (t a -> m Any) -> t a -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m Any) -> t a -> m Any
forall b (m :: * -> *) (f :: * -> *) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM ((Bool -> Any) -> m Bool -> m Any
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Any
Any (m Bool -> m Any) -> (a -> m Bool) -> a -> m Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m Bool
f)

allM :: (Foldable t, Monad m) => (a -> m Bool) -> t a -> m Bool
allM :: forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m Bool) -> t a -> m Bool
allM a -> m Bool
f = (All -> Bool) -> m All -> m Bool
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap All -> Bool
getAll (m All -> m Bool) -> (t a -> m All) -> t a -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m All) -> t a -> m All
forall b (m :: * -> *) (f :: * -> *) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM ((Bool -> All) -> m Bool -> m All
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> All
All (m Bool -> m All) -> (a -> m Bool) -> a -> m All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m Bool
f)

setFilterM :: (Ord a, Monad m) => (a -> m Bool) -> Set a -> m (Set a)
setFilterM :: forall a (m :: * -> *).
(Ord a, Monad m) =>
(a -> m Bool) -> Set a -> m (Set a)
setFilterM a -> m Bool
p = (a -> m (Set a)) -> Set a -> m (Set a)
forall b (m :: * -> *) (f :: * -> *) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (\a
a -> Set a -> Set a -> Bool -> Set a
forall a. a -> a -> Bool -> a
bool Set a
forall a. Monoid a => a
mempty (a -> Set a
forall a. a -> Set a
Set.singleton a
a) (Bool -> Set a) -> m Bool -> m (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m Bool
p a
a)

-- from Relude
foldMapM :: (Monoid b, Monad m, Foldable f) => (a -> m b) -> f a -> m b
foldMapM :: forall b (m :: * -> *) (f :: * -> *) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM a -> m b
f f a
xs = (a -> (b -> m b) -> b -> m b) -> (b -> m b) -> f a -> b -> m b
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (b -> m b) -> b -> m b
forall {b}. a -> (b -> m b) -> b -> m b
step b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return f a
xs b
forall a. Monoid a => a
mempty
  where
    step :: a -> (b -> m b) -> b -> m b
step a
x b -> m b
r b
z = a -> m b
f a
x m b -> (b -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
y -> b -> m b
r (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$! b
z b -> b -> b
forall a. Monoid a => a -> a -> a
`mappend` b
y
{-# INLINE foldMapM #-}

mapMaybeM :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM a -> m (Maybe b)
f = (a -> m [b]) -> [a] -> m [b]
forall b (m :: * -> *) (f :: * -> *) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM ((Maybe b -> [b]) -> m (Maybe b) -> m [b]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe b -> [b]
forall a. Maybe a -> [a]
maybeToList (m (Maybe b) -> m [b]) -> (a -> m (Maybe b)) -> a -> m [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Maybe b)
f)