{-# LANGUAGE NoImplicitPrelude #-}

module Polysemy.Time.Prelude (
  module Polysemy.Time.Prelude,
  module Data.Aeson,
  module Data.Aeson.TH,
  module Data.Composition,
  module Data.Default,
  module Data.Either.Combinators,
  module Data.Foldable,
  module Data.Kind,
  module Data.List.NonEmpty,
  module Data.Map.Strict,
  module GHC.Err,
  module GHC.TypeLits,
  module Polysemy,
  module Polysemy.AtomicState,
  module Polysemy.Time.Debug,
  module Polysemy.Error,
  module Polysemy.Reader,
  module Polysemy.State,
  module Relude,
) where

import Control.Exception (throwIO, try)
import qualified Data.Aeson as Aeson
import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON))
import Data.Aeson.TH (deriveFromJSON, deriveJSON)
import Data.Composition ((.:), (.:.), (.::))
import Data.Default (Default (def))
import Data.Either.Combinators (mapLeft)
import Data.Fixed (div')
import Data.Foldable (foldl, traverse_)
import Data.Kind (Type)
import Data.List.NonEmpty ((<|))
import qualified Data.Map.Strict as Map
import Data.Map.Strict (Map, lookup)
import qualified Data.Text as Text
import GHC.Err (undefined)
import GHC.TypeLits (Symbol)
import qualified Language.Haskell.TH.Syntax as TH
import Polysemy (
  Effect,
  EffectRow,
  Embed,
  Final,
  InterpreterFor,
  Member,
  Members,
  Sem,
  WithTactics,
  embed,
  embedToFinal,
  interpret,
  makeSem,
  pureT,
  raise,
  raiseUnder,
  raiseUnder2,
  raiseUnder3,
  reinterpret,
  runFinal,
  )
import Polysemy.AtomicState (AtomicState, atomicGet, atomicGets, atomicModify', atomicPut, runAtomicStateTVar)
import Polysemy.Error (Error, fromEither, mapError, note, runError, throw)
import Polysemy.Reader (Reader)
import Polysemy.State (State, evalState, get, gets, modify, modify', put, runState)
import Relude hiding (
  Reader,
  State,
  Sum,
  Type,
  ask,
  asks,
  evalState,
  filterM,
  get,
  gets,
  hoistEither,
  modify,
  modify',
  put,
  readFile,
  runReader,
  runState,
  state,
  trace,
  traceShow,
  undefined,
  )
import System.IO.Error (userError)

import Polysemy.Time.Debug (dbg, dbgs, dbgs_)

unit ::
  Applicative f =>
  f ()
unit :: f ()
unit =
  () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# inline unit #-}

tuple ::
  Applicative f =>
  f a ->
  f b ->
  f (a, b)
tuple :: f a -> f b -> f (a, b)
tuple f a
fa f b
fb =
  (,) (a -> b -> (a, b)) -> f a -> f (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa f (b -> (a, b)) -> f b -> f (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f b
fb
{-# inline tuple #-}

liftT ::
  forall m f r e a .
  Functor f =>
  Sem r a ->
  Sem (WithTactics e f m r) (f a)
liftT :: Sem r a -> Sem (WithTactics e f m r) (f a)
liftT =
  a -> Sem (WithTactics e f m r) (f a)
forall (f :: * -> *) a (e :: Effect) (m :: * -> *) (r :: [Effect]).
Functor f =>
a -> Sem (WithTactics e f m r) (f a)
pureT (a -> Sem (WithTactics e f m r) (f a))
-> (Sem r a -> Sem (WithTactics e f m r) a)
-> Sem r a
-> Sem (WithTactics e f m r) (f a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Sem r a -> Sem (WithTactics e f m r) a
forall (e :: Effect) (r :: [Effect]) a. Sem r a -> Sem (e : r) a
raise
{-# inline liftT #-}

hoistEither ::
  Member (Error e2) r =>
  (e1 -> e2) ->
  Either e1 a ->
  Sem r a
hoistEither :: (e1 -> e2) -> Either e1 a -> Sem r a
hoistEither e1 -> e2
f =
  Either e2 a -> Sem r a
forall e (r :: [Effect]) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either e2 a -> Sem r a)
-> (Either e1 a -> Either e2 a) -> Either e1 a -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e1 -> e2) -> Either e1 a -> Either e2 a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft e1 -> e2
f
{-# inline hoistEither #-}

hoistEitherWith ::
  (e -> Sem r a) ->
  Either e a ->
  Sem r a
hoistEitherWith :: (e -> Sem r a) -> Either e a -> Sem r a
hoistEitherWith e -> Sem r a
f =
  (e -> Sem r a) -> (a -> Sem r a) -> Either e a -> Sem r a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Sem r a
f a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# inline hoistEitherWith #-}

hoistEitherShow ::
  Show e1 =>
  Member (Error e2) r =>
  (Text -> e2) ->
  Either e1 a ->
  Sem r a
hoistEitherShow :: (Text -> e2) -> Either e1 a -> Sem r a
hoistEitherShow Text -> e2
f =
  Either e2 a -> Sem r a
forall e (r :: [Effect]) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either e2 a -> Sem r a)
-> (Either e1 a -> Either e2 a) -> Either e1 a -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e1 -> e2) -> Either e1 a -> Either e2 a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (Text -> e2
f (Text -> e2) -> (e1 -> Text) -> e1 -> e2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
Text.replace Text
"\\" Text
"" (Text -> Text) -> (e1 -> Text) -> e1 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e1 -> Text
forall b a. (Show a, IsString b) => a -> b
show)
{-# inline hoistEitherShow #-}

hoistErrorWith ::
  (e -> Sem r a) ->
  Sem (Error e : r) a ->
  Sem r a
hoistErrorWith :: (e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
hoistErrorWith e -> Sem r a
f =
  (e -> Sem r a) -> Either e a -> Sem r a
forall e (r :: [Effect]) a. (e -> Sem r a) -> Either e a -> Sem r a
hoistEitherWith e -> Sem r a
f (Either e a -> Sem r a)
-> (Sem (Error e : r) a -> Sem r (Either e a))
-> Sem (Error e : r) a
-> Sem r a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Sem (Error e : r) a -> Sem r (Either e a)
forall e (r :: [Effect]) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError
{-# inline hoistErrorWith #-}

tryAny ::
  Member (Embed IO) r =>
  IO a ->
  Sem r (Either Text a)
tryAny :: IO a -> Sem r (Either Text a)
tryAny =
  IO (Either Text a) -> Sem r (Either Text a)
forall (m :: * -> *) (r :: [Effect]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either Text a) -> Sem r (Either Text a))
-> (IO a -> IO (Either Text a)) -> IO a -> Sem r (Either Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either SomeException a -> Either Text a)
-> IO (Either SomeException a) -> IO (Either Text a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SomeException -> Text) -> Either SomeException a -> Either Text a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft SomeException -> Text
forall b a. (Show a, IsString b) => a -> b
show) (IO (Either SomeException a) -> IO (Either Text a))
-> (IO a -> IO (Either SomeException a))
-> IO a
-> IO (Either Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Exception SomeException =>
IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try @SomeException
{-# inline tryAny #-}

tryHoist ::
  Member (Embed IO) r =>
  (Text -> e) ->
  IO a ->
  Sem r (Either e a)
tryHoist :: (Text -> e) -> IO a -> Sem r (Either e a)
tryHoist Text -> e
f =
  (Either Text a -> Either e a)
-> Sem r (Either Text a) -> Sem r (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> e) -> Either Text a -> Either e a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft Text -> e
f) (Sem r (Either Text a) -> Sem r (Either e a))
-> (IO a -> Sem r (Either Text a)) -> IO a -> Sem r (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Sem r (Either Text a)
forall (r :: [Effect]) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny
{-# inline tryHoist #-}

tryThrow ::
  Members [Embed IO, Error e] r =>
  (Text -> e) ->
  IO a ->
  Sem r a
tryThrow :: (Text -> e) -> IO a -> Sem r a
tryThrow Text -> e
f =
  Either e a -> Sem r a
forall e (r :: [Effect]) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either e a -> Sem r a)
-> (IO a -> Sem r (Either e a)) -> IO a -> Sem r a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Text -> e) -> IO a -> Sem r (Either e a)
forall (r :: [Effect]) e a.
Member (Embed IO) r =>
(Text -> e) -> IO a -> Sem r (Either e a)
tryHoist Text -> e
f
{-# inline tryThrow #-}

throwTextIO :: Text -> IO a
throwTextIO :: Text -> IO a
throwTextIO =
  IOError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO a) -> (Text -> IOError) -> Text -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError (String -> IOError) -> (Text -> String) -> Text -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString
{-# inline throwTextIO #-}

throwEitherIO :: Either Text a -> IO a
throwEitherIO :: Either Text a -> IO a
throwEitherIO =
  (Text -> IO a) -> Either Text a -> IO a
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
traverseLeft Text -> IO a
forall a. Text -> IO a
throwTextIO
{-# inline throwEitherIO #-}

basicOptions :: Aeson.Options
basicOptions :: Options
basicOptions =
  Options
Aeson.defaultOptions {
    fieldLabelModifier :: String -> String
Aeson.fieldLabelModifier = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
'_' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==)
  }

jsonOptions :: Aeson.Options
jsonOptions :: Options
jsonOptions =
  Options
basicOptions {
    unwrapUnaryRecords :: Bool
Aeson.unwrapUnaryRecords = Bool
True
  }

defaultJson :: TH.Name -> TH.Q [TH.Dec]
defaultJson :: Name -> Q [Dec]
defaultJson =
  Options -> Name -> Q [Dec]
deriveJSON Options
jsonOptions
{-# inline defaultJson #-}

unaryRecordJson :: TH.Name -> TH.Q [TH.Dec]
unaryRecordJson :: Name -> Q [Dec]
unaryRecordJson =
  Options -> Name -> Q [Dec]
deriveJSON Options
basicOptions
{-# inline unaryRecordJson #-}

type Basic a =
  (Eq a, Show a)

type family Basics (as :: [Type]) :: Constraint where
  Basics '[] = ()
  Basics (a : as) = (Basic a, Basics as)

type Eso a =
  (Basic a, Ord a)

type family Esos (as :: [Type]) :: Constraint where
  Esos '[] = ()
  Esos (a : as) = (Eso a, Esos as)

type Json a =
  (FromJSON a, ToJSON a, Basic a)

type family Jsons (r :: [Type]) :: Constraint where
  Jsons '[] = ()
  Jsons (a ': r) = (Json a, Jsons r)

rightOr :: (a -> b) -> Either a b -> b
rightOr :: (a -> b) -> Either a b -> b
rightOr a -> b
f =
  (a -> b) -> (b -> b) -> Either a b -> b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> b
f b -> b
forall a. a -> a
id
{-# inline rightOr #-}

traverseLeft ::
  Applicative m =>
  (a -> m b) ->
  Either a b ->
  m b
traverseLeft :: (a -> m b) -> Either a b -> m b
traverseLeft a -> m b
f =
  (a -> m b) -> (b -> m b) -> Either a b -> m b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> m b
f b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# inline traverseLeft #-}

jsonDecode ::
  FromJSON a =>
  ByteString ->
  Either Text a
jsonDecode :: ByteString -> Either Text a
jsonDecode =
  (String -> Text) -> Either String a -> Either Text a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft String -> Text
forall a. ToText a => a -> Text
toText (Either String a -> Either Text a)
-> (ByteString -> Either String a) -> ByteString -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict'
{-# inline jsonDecode #-}

jsonDecodeL ::
  FromJSON a =>
  LByteString ->
  Either Text a
jsonDecodeL :: LByteString -> Either Text a
jsonDecodeL =
  (String -> Text) -> Either String a -> Either Text a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft String -> Text
forall a. ToText a => a -> Text
toText (Either String a -> Either Text a)
-> (LByteString -> Either String a) -> LByteString -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LByteString -> Either String a
forall a. FromJSON a => LByteString -> Either String a
Aeson.eitherDecode'
{-# inline jsonDecodeL #-}

jsonDecodeText ::
  FromJSON a =>
  Text ->
  Either Text a
jsonDecodeText :: Text -> Either Text a
jsonDecodeText =
  (String -> Text) -> Either String a -> Either Text a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft String -> Text
forall a. ToText a => a -> Text
toText (Either String a -> Either Text a)
-> (Text -> Either String a) -> Text -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' (ByteString -> Either String a)
-> (Text -> ByteString) -> Text -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8
{-# inline jsonDecodeText #-}

jsonEncode ::
  ToJSON a =>
  a ->
  ByteString
jsonEncode :: a -> ByteString
jsonEncode =
  LByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (LByteString -> ByteString)
-> (a -> LByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> LByteString
forall a. ToJSON a => a -> LByteString
Aeson.encode
{-# inline jsonEncode #-}

jsonEncodeText ::
  ToJSON a =>
  a ->
  Text
jsonEncodeText :: a -> Text
jsonEncodeText =
  ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
jsonEncode
{-# inline jsonEncodeText #-}

as ::
  Functor m =>
  a ->
  m b ->
  m a
as :: a -> m b -> m a
as =
  a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$)
{-# inline as #-}

mneToList :: Maybe (NonEmpty a) -> [a]
mneToList :: Maybe (NonEmpty a) -> [a]
mneToList =
  [a] -> (NonEmpty a -> [a]) -> Maybe (NonEmpty a) -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
{-# inline mneToList #-}

safeDiv ::
  Real a =>
  Integral a =>
  a ->
  a ->
  Maybe a
safeDiv :: a -> a -> Maybe a
safeDiv a
_ a
0 =
  Maybe a
forall a. Maybe a
Nothing
safeDiv a
n a
d =
  a -> Maybe a
forall a. a -> Maybe a
Just (a
n a -> a -> a
forall a b. (Real a, Integral b) => a -> a -> b
`div'` a
d)
{-# inline safeDiv #-}

divOr0 ::
  Real a =>
  Integral a =>
  a ->
  a ->
  a
divOr0 :: a -> a -> a
divOr0 =
  a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
0 (Maybe a -> a) -> (a -> a -> Maybe a) -> a -> a -> a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: a -> a -> Maybe a
forall a. (Real a, Integral a) => a -> a -> Maybe a
safeDiv
{-# inline divOr0 #-}

mapBy ::
  Ord k =>
  (a -> k) ->
  [a] ->
  Map k a
mapBy :: (a -> k) -> [a] -> Map k a
mapBy a -> k
f =
  [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, a)] -> Map k a) -> ([a] -> [(k, a)]) -> [a] -> Map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (k, a)) -> [a] -> [(k, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \ a
a -> (a -> k
f a
a, a
a)