{-# language NoImplicitPrelude #-}
{-# options_haddock prune, hide #-}
module Helic.Prelude (
module Control.Lens,
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.Map.Strict,
module Exon,
module GHC.Err,
module GHC.TypeLits,
module Helic.Prelude,
module Helic.Prelude.Debug,
module Polysemy,
module Polysemy.Async,
module Polysemy.AtomicState,
module Polysemy.Conc,
module Polysemy.Error,
module Polysemy.Internal.Tactics,
module Polysemy.Reader,
module Polysemy.Resource,
module Polysemy.Resume,
module Polysemy.State,
module Relude,
) where
import Control.Exception (catch, try)
import Control.Lens (at, makeClassy, over, (%~), (.~), (<>~), (?~), (^.))
import qualified Data.Aeson as Aeson
import Data.Aeson (FromJSON (parseJSON), SumEncoding (UntaggedValue), ToJSON (toJSON), Value, camelTo2)
import Data.Aeson.TH (deriveFromJSON, deriveJSON)
import Data.Composition ((.:), (.:.), (.::))
import Data.Default (Default (def))
import Data.Either.Combinators (mapLeft)
import Data.Foldable (foldl, traverse_)
import Data.Kind (Type)
import Data.Map.Strict (Map, lookup)
import Exon (exon)
import GHC.Err (undefined)
import GHC.TypeLits (Symbol)
import qualified Language.Haskell.TH.Syntax as TH
import Polysemy (
Effect,
EffectRow,
Embed,
Final,
InterpreterFor,
InterpretersFor,
Member,
Members,
Sem,
WithTactics,
bindT,
embed,
embedToFinal,
interpret,
interpretH,
makeSem,
pureT,
raise,
raise2Under,
raise3Under,
raiseUnder,
raiseUnder2,
raiseUnder3,
reinterpret,
runFinal,
runT,
)
import Polysemy.Async (Async, async, asyncToIOFinal, await, sequenceConcurrently)
import Polysemy.AtomicState (AtomicState, atomicGet, atomicGets, atomicModify', atomicPut, runAtomicStateTVar)
import Polysemy.Conc (Race)
import Polysemy.Error (Error, fromEither, fromExceptionVia, mapError, note, runError, throw)
import Polysemy.Internal.CustomErrors (FirstOrder)
import Polysemy.Internal.Kind (Append)
import Polysemy.Internal.Tactics (liftT)
import Polysemy.Reader (Reader, ask, asks)
import Polysemy.Resource (Resource, resourceToIOFinal, runResource)
import Polysemy.Resume
import Polysemy.State (State, evalState, get, gets, modify, modify', put, runState)
import Relude hiding (
Reader,
State,
Type,
ask,
asks,
evalState,
filterM,
get,
gets,
hoistEither,
modify,
modify',
put,
readFile,
runReader,
runState,
state,
trace,
traceShow,
undefined,
)
import Helic.Prelude.Debug (dbg, dbgs, dbgsWith, dbgs_, tr, trs, trs')
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 #-}
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 :: EffectRow) 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 #-}
tryAny_ ::
Member (Embed IO) r =>
IO a ->
Sem r ()
tryAny_ :: IO a -> Sem r ()
tryAny_ =
Sem r (Either Text a) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r (Either Text a) -> Sem r ())
-> (IO a -> Sem r (Either Text a)) -> IO a -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Sem r (Either Text a)
forall (r :: EffectRow) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny
{-# inline tryAny_ #-}
stopException ::
Members [Stop e, Embed IO] r =>
(Text -> e) ->
IO a ->
Sem r a
stopException :: (Text -> e) -> IO a -> Sem r a
stopException Text -> e
f =
(Text -> e) -> Either Text a -> Sem r a
forall err' (r :: EffectRow) err a.
Member (Stop err') r =>
(err -> err') -> Either err a -> Sem r a
stopEitherWith Text -> e
f (Either Text a -> Sem r a)
-> (IO a -> Sem r (Either Text a)) -> IO a -> Sem r a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IO a -> Sem r (Either Text a)
forall (r :: EffectRow) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny
errorException ::
Members [Error e, Embed IO] r =>
(Text -> e) ->
IO a ->
Sem r a
errorException :: (Text -> e) -> IO a -> Sem r a
errorException Text -> e
f =
(SomeException -> e) -> IO a -> Sem r a
forall exc err (r :: EffectRow) a.
(Exception exc, Member (Error err) r, Member (Embed IO) r) =>
(exc -> err) -> IO a -> Sem r a
fromExceptionVia @SomeException (Text -> e
f (Text -> e) -> (SomeException -> Text) -> SomeException -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Text
forall b a. (Show a, IsString b) => a -> b
show)
catchIOAs ::
a ->
IO a ->
IO a
catchIOAs :: a -> IO a -> IO a
catchIOAs a
fallback IO a
thunk =
IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO a
thunk \ (SomeException e
_) -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
fallback
{-# inline catchIOAs #-}
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
}
untaggedOptions :: Aeson.Options
untaggedOptions :: Options
untaggedOptions =
Options
jsonOptions {
sumEncoding :: SumEncoding
Aeson.sumEncoding = SumEncoding
UntaggedValue
}
defaultJson :: TH.Name -> TH.Q [TH.Dec]
defaultJson :: Name -> Q [Dec]
defaultJson =
Options -> Name -> Q [Dec]
deriveJSON Options
jsonOptions
lowerMinusJson :: TH.Name -> TH.Q [TH.Dec]
lowerMinusJson :: Name -> Q [Dec]
lowerMinusJson =
Options -> Name -> Q [Dec]
deriveJSON Options
jsonOptions {
constructorTagModifier :: String -> String
Aeson.constructorTagModifier = Char -> String -> String
camelTo2 Char
'-'
}
unaryRecordJson :: TH.Name -> TH.Q [TH.Dec]
unaryRecordJson :: Name -> Q [Dec]
unaryRecordJson =
Options -> Name -> Q [Dec]
deriveJSON Options
basicOptions
type a ++ b =
Append a b
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 #-}
unify :: Either a a -> a
unify :: Either a a -> a
unify =
(a -> a) -> (a -> a) -> Either a a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> a
forall a. a -> a
id a -> a
forall a. a -> a
id
{-# inline unify #-}
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 #-}
jsonEncode ::
ToJSON a =>
a ->
ByteString
jsonEncode :: a -> ByteString
jsonEncode =
ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode
{-# inline jsonEncode #-}
aesonToEither :: Aeson.Result a -> Either Text a
aesonToEither :: Result a -> Either Text a
aesonToEither = \case
Aeson.Success a
a -> a -> Either Text a
forall a b. b -> Either a b
Right a
a
Aeson.Error String
s -> Text -> Either Text a
forall a b. a -> Either a b
Left (String -> Text
forall a. ToText a => a -> Text
toText String
s)
jsonDecodeValue ::
FromJSON a =>
Value ->
Either Text a
jsonDecodeValue :: Value -> Either Text a
jsonDecodeValue =
(Text -> Text) -> Either Text a -> Either Text a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft Text -> Text
forall a. ToText a => a -> Text
toText (Either Text a -> Either Text a)
-> (Value -> Either Text a) -> Value -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result a -> Either Text a
forall a. Result a -> Either Text a
aesonToEither (Result a -> Either Text a)
-> (Value -> Result a) -> Value -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Result a
forall a. FromJSON a => Value -> Result a
Aeson.fromJSON
{-# inline jsonDecodeValue #-}
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 #-}
safeDiv ::
Eq a =>
Fractional 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. Fractional a => a -> a -> a
/ a
d)
{-# inline safeDiv #-}
divOr0 ::
Eq a =>
Fractional 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. (Eq a, Fractional a) => a -> a -> Maybe a
safeDiv
{-# inline divOr0 #-}
interpreting ::
∀ e r a .
FirstOrder e "interpret" =>
Sem (e : r) a ->
(∀ r0 x . e (Sem r0) x -> Sem r x) ->
Sem r a
interpreting :: Sem (e : r) a
-> (forall (r0 :: EffectRow) x. e (Sem r0) x -> Sem r x) -> Sem r a
interpreting Sem (e : r) a
s forall (r0 :: EffectRow) x. e (Sem r0) x -> Sem r x
h =
(forall (r0 :: EffectRow) x. e (Sem r0) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret forall (r0 :: EffectRow) x. e (Sem r0) x -> Sem r x
h Sem (e : r) a
s
{-# inline interpreting #-}