{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Hasura.Prelude
( module M,
alphabet,
alphaNumerics,
catMaybes,
onNothing,
onNothingM,
onJust,
withJust,
mapMaybe,
maybeToEither,
eitherToMaybe,
onLeft,
mapLeft,
whenMaybe,
choice,
afold,
bsToTxt,
lbsToTxt,
txtToBs,
base64Decode,
spanMaybeM,
liftEitherM,
hoistMaybe,
hoistEither,
readJson,
tshow,
hashNub,
ltrace,
ltraceM,
traceToFile,
traceToFileM,
coerce,
findWithIndex,
mapFromL,
oMapFromL,
withElapsedTime,
startTimer,
hasuraJSON,
nonEmptySeqToNonEmptyList,
module Data.Time.Clock.Units,
)
where
import Control.Applicative as M (Alternative (..), liftA2)
import Control.Arrow as M (first, second, (&&&), (***), (<<<), (>>>))
import Control.DeepSeq as M (NFData, deepseq, force)
import Control.Lens as M (ix, (%~))
import Control.Monad.Base as M
import Control.Monad.Except as M
import Control.Monad.Identity as M
import Control.Monad.Reader as M
import Control.Monad.State.Strict as M
import Control.Monad.Trans.Maybe as M (MaybeT (..))
import Control.Monad.Writer.Strict as M
( MonadWriter (..),
WriterT (..),
execWriterT,
runWriterT,
)
import Data.Aeson qualified as J
import Data.Aeson.Casing qualified as J
import Data.Bool as M (bool)
import Data.ByteString qualified as B
import Data.ByteString.Base64.Lazy qualified as Base64
import Data.ByteString.Lazy qualified as BL
import Data.Coerce
import Data.Data as M (Data (..))
import Data.Either as M (lefts, partitionEithers, rights)
import Data.Foldable as M
( asum,
fold,
foldMap',
foldlM,
foldrM,
for_,
toList,
traverse_,
)
import Data.Function as M (on, (&))
import Data.Functor as M (($>), (<&>))
import Data.Functor.Const as M (Const)
import Data.HashMap.Strict as M (HashMap, mapKeys)
import Data.HashMap.Strict qualified as Map
import Data.HashMap.Strict.InsOrd as M (InsOrdHashMap)
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.HashSet as M (HashSet)
import Data.HashSet qualified as HSet
import Data.Hashable as M (Hashable)
import Data.List as M
( find,
findIndex,
foldl',
group,
intercalate,
intersect,
lookup,
sort,
sortBy,
sortOn,
union,
unionBy,
(\\),
)
import Data.List.NonEmpty as M (NonEmpty (..), nonEmpty)
import Data.Maybe as M
( fromMaybe,
isJust,
isNothing,
listToMaybe,
maybeToList,
)
import Data.Monoid as M (getAlt)
import Data.Ord as M (comparing)
import Data.Semigroup as M (Semigroup (..))
import Data.Sequence as M (Seq)
import Data.Sequence.NonEmpty as M (NESeq)
import Data.Sequence.NonEmpty qualified as NESeq
import Data.String as M (IsString)
import Data.Text as M (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Data.Text.Encoding.Error qualified as TE
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.IO qualified as TLIO
import Data.Time.Clock.Units
import Data.Traversable as M (for)
import Data.Void as M (Void, absurd)
import Data.Word as M (Word64)
import Debug.Trace qualified as Debug (trace, traceM)
import GHC.Clock qualified as Clock
import GHC.Generics as M (Generic)
import System.IO.Unsafe (unsafePerformIO)
import Text.Pretty.Simple qualified as PS
import Text.Read as M (readEither, readMaybe)
import Witherable (catMaybes, mapMaybe)
import Prelude as M hiding (fail, init, lookup)
alphabet :: String
alphabet :: String
alphabet = [Char
'a' .. Char
'z'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'A' .. Char
'Z']
alphaNumerics :: String
alphaNumerics :: String
alphaNumerics = String
alphabet String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"0123456789"
onNothing :: Applicative m => Maybe a -> m a -> m a
onNothing :: Maybe a -> m a -> m a
onNothing Maybe a
m m a
act = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
act a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
m
onNothingM :: Monad m => m (Maybe a) -> m a -> m a
onNothingM :: m (Maybe a) -> m a -> m a
onNothingM m (Maybe a)
m m a
act = m (Maybe a)
m m (Maybe a) -> (Maybe a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe a -> m a -> m a
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` m a
act)
onJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
onJust :: Maybe a -> (a -> m ()) -> m ()
onJust Maybe a
m a -> m ()
action = m () -> (a -> m ()) -> Maybe a -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) a -> m ()
action Maybe a
m
withJust :: Applicative m => Maybe a -> (a -> m (Maybe b)) -> m (Maybe b)
withJust :: Maybe a -> (a -> m (Maybe b)) -> m (Maybe b)
withJust Maybe a
m a -> m (Maybe b)
action = m (Maybe b) -> (a -> m (Maybe b)) -> Maybe a -> m (Maybe b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing) a -> m (Maybe b)
action Maybe a
m
maybeToEither :: a -> Maybe b -> Either a b
maybeToEither :: a -> Maybe b -> Either a b
maybeToEither 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
eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe = (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
onLeft :: Applicative m => Either e a -> (e -> m a) -> m a
onLeft :: Either e a -> (e -> m a) -> m a
onLeft Either e a
e e -> m a
f = (e -> m a) -> (a -> m a) -> Either e a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> m a
f a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either e a
e
mapLeft :: (e1 -> e2) -> Either e1 a -> Either e2 a
mapLeft :: (e1 -> e2) -> Either e1 a -> Either e2 a
mapLeft e1 -> e2
f (Left e1
e1) = e2 -> Either e2 a
forall a b. a -> Either a b
Left (e1 -> e2
f e1
e1)
mapLeft e1 -> e2
_ (Right a
a) = a -> Either e2 a
forall a b. b -> Either a b
Right a
a
whenMaybe :: Applicative m => Bool -> m a -> m (Maybe a)
whenMaybe :: Bool -> m a -> m (Maybe a)
whenMaybe Bool
True = (a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just
whenMaybe Bool
False = m (Maybe a) -> m a -> m (Maybe a)
forall a b. a -> b -> a
const (m (Maybe a) -> m a -> m (Maybe a))
-> m (Maybe a) -> m a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
choice :: Alternative f => [f a] -> f a
choice :: [f a] -> f a
choice = [f a] -> f a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
afold :: (Foldable t, Alternative f) => t a -> f a
afold :: t a -> f a
afold = Alt f a -> f a
forall k (f :: k -> *) (a :: k). Alt f a -> f a
getAlt (Alt f a -> f a) -> (t a -> Alt f a) -> t a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Alt f a) -> t a -> Alt f a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Alt f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
bsToTxt :: B.ByteString -> Text
bsToTxt :: ByteString -> Text
bsToTxt = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TE.lenientDecode
lbsToTxt :: BL.ByteString -> Text
lbsToTxt :: ByteString -> Text
lbsToTxt = ByteString -> Text
bsToTxt (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict
txtToBs :: Text -> B.ByteString
txtToBs :: Text -> ByteString
txtToBs = Text -> ByteString
TE.encodeUtf8
base64Decode :: Text -> BL.ByteString
base64Decode :: Text -> ByteString
base64Decode =
ByteString -> ByteString
Base64.decodeLenient (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
txtToBs
liftEitherM :: MonadError e m => m (Either e a) -> m a
liftEitherM :: m (Either e a) -> m a
liftEitherM m (Either e a)
action = m (Either e a)
action m (Either e a) -> (Either e a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either e a -> m a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
spanMaybeM ::
(Foldable f, Monad m) =>
(a -> m (Maybe b)) ->
f a ->
m ([b], [a])
spanMaybeM :: (a -> m (Maybe b)) -> f a -> m ([b], [a])
spanMaybeM a -> m (Maybe b)
f = [a] -> m ([b], [a])
go ([a] -> m ([b], [a])) -> (f a -> [a]) -> f a -> m ([b], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
where
go :: [a] -> m ([b], [a])
go [] = ([b], [a]) -> m ([b], [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
go l :: [a]
l@(a
x : [a]
xs) =
a -> m (Maybe b)
f a
x m (Maybe b) -> (Maybe b -> m ([b], [a])) -> m ([b], [a])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just b
y -> ([b] -> [b]) -> ([b], [a]) -> ([b], [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (b
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
:) (([b], [a]) -> ([b], [a])) -> m ([b], [a]) -> m ([b], [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> m ([b], [a])
go [a]
xs
Maybe b
Nothing -> ([b], [a]) -> m ([b], [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [a]
l)
findWithIndex :: (a -> Bool) -> [a] -> Maybe (a, Int)
findWithIndex :: (a -> Bool) -> [a] -> Maybe (a, Int)
findWithIndex a -> Bool
p [a]
l = do
a
v <- (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find a -> Bool
p [a]
l
Int
i <- (a -> Bool) -> [a] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex a -> Bool
p [a]
l
(a, Int) -> Maybe (a, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
v, Int
i)
mapFromL :: (Eq k, Hashable k) => (a -> k) -> [a] -> Map.HashMap k a
mapFromL :: (a -> k) -> [a] -> HashMap k a
mapFromL a -> k
f = [(k, a)] -> HashMap k a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(k, a)] -> HashMap k a)
-> ([a] -> [(k, a)]) -> [a] -> HashMap k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (k, a)) -> [a] -> [(k, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
v -> (a -> k
f a
v, a
v))
oMapFromL :: (Eq k, Hashable k) => (a -> k) -> [a] -> InsOrdHashMap k a
oMapFromL :: (a -> k) -> [a] -> InsOrdHashMap k a
oMapFromL a -> k
f = [(k, a)] -> InsOrdHashMap k a
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
OMap.fromList ([(k, a)] -> InsOrdHashMap k a)
-> ([a] -> [(k, a)]) -> [a] -> InsOrdHashMap k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (k, a)) -> [a] -> [(k, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
v -> (a -> k
f a
v, a
v))
withElapsedTime :: MonadIO m => m a -> m (DiffTime, a)
withElapsedTime :: m a -> m (DiffTime, a)
withElapsedTime m a
ma = do
Word64
bef <- IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Word64
Clock.getMonotonicTimeNSec
!a
a <- m a
ma
Word64
aft <- IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Word64
Clock.getMonotonicTimeNSec
let !dur :: DiffTime
dur = Nanoseconds -> DiffTime
nanoseconds (Nanoseconds -> DiffTime) -> Nanoseconds -> DiffTime
forall a b. (a -> b) -> a -> b
$ Word64 -> Nanoseconds
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
aft Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
bef)
(DiffTime, a) -> m (DiffTime, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (DiffTime
dur, a
a)
startTimer :: (MonadIO m, MonadIO n) => m (n DiffTime)
startTimer :: m (n DiffTime)
startTimer = do
!Word64
bef <- IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Word64
Clock.getMonotonicTimeNSec
n DiffTime -> m (n DiffTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (n DiffTime -> m (n DiffTime)) -> n DiffTime -> m (n DiffTime)
forall a b. (a -> b) -> a -> b
$ do
Word64
aft <- IO Word64 -> n Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Word64
Clock.getMonotonicTimeNSec
DiffTime -> n DiffTime
forall (m :: * -> *) a. Monad m => a -> m a
return (DiffTime -> n DiffTime) -> DiffTime -> n DiffTime
forall a b. (a -> b) -> a -> b
$ Nanoseconds -> DiffTime
nanoseconds (Nanoseconds -> DiffTime) -> Nanoseconds -> DiffTime
forall a b. (a -> b) -> a -> b
$ Word64 -> Nanoseconds
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
aft Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
bef)
hoistMaybe :: Applicative m => Maybe b -> MaybeT m b
hoistMaybe :: Maybe b -> MaybeT m b
hoistMaybe = m (Maybe b) -> MaybeT m b
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe b) -> MaybeT m b)
-> (Maybe b -> m (Maybe b)) -> Maybe b -> MaybeT m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
hoistEither :: Applicative m => Either e a -> ExceptT e m a
hoistEither :: Either e a -> ExceptT e m a
hoistEither = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> (Either e a -> m (Either e a)) -> Either e a -> ExceptT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either e a -> m (Either e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
tshow :: Show a => a -> Text
tshow :: a -> Text
tshow = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
readJson :: (J.FromJSON a) => String -> Either String a
readJson :: String -> Either String a
readJson = ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecodeStrict (ByteString -> Either String a)
-> (String -> ByteString) -> String -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
txtToBs (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
hasuraJSON :: J.Options
hasuraJSON :: Options
hasuraJSON = (String -> String) -> Options
J.aesonPrefix String -> String
J.snakeCase
ltrace :: Show a => String -> a -> a
ltrace :: String -> a -> a
ltrace String
lbl a
x = String -> a -> a
forall a. String -> a -> a
Debug.trace (String
lbl String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
TL.unpack (a -> Text
forall a. Show a => a -> Text
PS.pShow a
x)) a
x
{-# WARNING ltrace "ltrace left in code" #-}
ltraceM :: Applicative m => Show a => String -> a -> m ()
ltraceM :: String -> a -> m ()
ltraceM String
lbl a
x = String -> m ()
forall (f :: * -> *). Applicative f => String -> f ()
Debug.traceM (String
lbl String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
TL.unpack (a -> Text
forall a. Show a => a -> Text
PS.pShow a
x))
{-# WARNING ltraceM "ltraceM left in code" #-}
traceToFile :: Show a => FilePath -> a -> a
traceToFile :: String -> a -> a
traceToFile String
filepath a
x =
String -> a -> a
forall a. String -> a -> a
Debug.trace
(String
"tracing to " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
filepath)
(IO a -> a
forall a. IO a -> a
unsafePerformIO (String -> Text -> IO ()
TLIO.writeFile String
filepath (a -> Text
forall a. Show a => a -> Text
PS.pShowNoColor a
x) IO () -> a -> IO a
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a
x))
{-# WARNING traceToFile "traceToFile left in code" #-}
traceToFileM :: Applicative m => Show a => FilePath -> a -> m ()
traceToFileM :: String -> a -> m ()
traceToFileM String
filepath a
x =
String -> m ()
forall (f :: * -> *). Applicative f => String -> f ()
Debug.traceM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
[String] -> String
unwords
[ String
"tracing to",
String
filepath,
() -> String
forall a. Show a => a -> String
show (() -> String) -> () -> String
forall a b. (a -> b) -> a -> b
$ IO () -> ()
forall a. IO a -> a
unsafePerformIO (IO () -> ()) -> IO () -> ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
TLIO.writeFile String
filepath (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. Show a => a -> Text
PS.pShowNoColor a
x
]
{-# WARNING traceToFileM "traceToFileM left in code" #-}
hashNub :: (Hashable a, Eq a) => [a] -> [a]
hashNub :: [a] -> [a]
hashNub = HashSet a -> [a]
forall a. HashSet a -> [a]
HSet.toList (HashSet a -> [a]) -> ([a] -> HashSet a) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HSet.fromList
nonEmptySeqToNonEmptyList :: NESeq a -> NonEmpty a
nonEmptySeqToNonEmptyList :: NESeq a -> NonEmpty a
nonEmptySeqToNonEmptyList (a
x NESeq.:<|| Seq a
xs) =
a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
M.:| Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs