{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE MagicHash #-}
module Navi.Prelude
(
headMaybe,
(<<$>>),
maybeToEither,
monoBimap,
todo,
displayExceptiont,
showt,
packText,
unpackText,
module X,
)
where
import Control.Applicative as X
( Alternative ((<|>)),
Applicative
( liftA2,
pure,
(*>),
(<*>)
),
(<**>),
)
import Control.Category as X (Category ((.)), (<<<), (>>>))
import Control.DeepSeq as X (NFData)
import Control.Exception.Utils as X (catchSync, throwText)
import Control.Monad as X
( Monad ((>>=)),
forever,
join,
unless,
void,
when,
(<=<),
(=<<),
(>=>),
)
import Control.Monad.Catch as X
( Exception (displayException),
MonadCatch,
MonadMask,
MonadThrow,
SomeException,
bracket,
catch,
finally,
mask,
throwM,
try,
)
import Control.Monad.Fail as X (MonadFail (fail))
import Control.Monad.IO.Class as X (MonadIO (liftIO))
import Control.Monad.Reader as X
( MonadReader (ask, local),
ReaderT (runReaderT),
asks,
)
import Control.Monad.Trans as X (MonadTrans (lift))
import Data.Bifunctor as X (Bifunctor (bimap, first, second))
import Data.Bool as X (Bool (False, True), not, otherwise, (&&), (||))
import Data.ByteString as X (ByteString)
import Data.Bytes as X (Bytes (MkBytes), Size (B))
import Data.Char as X (Char)
import Data.Either as X (Either (Left, Right), either)
import Data.Eq as X (Eq ((==)), (/=))
import Data.Foldable as X (Foldable (elem, foldl'), for_, length, traverse_)
import Data.Function as X (const, flip, id, ($))
import Data.Functor as X (Functor (fmap), ($>), (<$>), (<&>))
import Data.Int as X (Int32)
import Data.Kind as X (Constraint, Type)
import Data.List as X (all, filter, replicate, zipWith, (++))
import Data.List.NonEmpty as X (NonEmpty ((:|)))
import Data.Maybe as X (Maybe (Just, Nothing), fromMaybe, maybe, maybeToList)
import Data.Monoid as X (Monoid (mconcat, mempty))
import Data.Ord as X (Ord ((<), (<=), (>), (>=)))
import Data.Proxy as X (Proxy (Proxy))
import Data.Semigroup as X (Semigroup ((<>)))
import Data.Sequence as X (Seq ((:<|), (:|>)))
import Data.String as X (IsString (fromString), String)
import Data.Text as X (Text)
import Data.Text qualified as T
import Data.Text.Display as X (display)
import Data.Traversable as X (Traversable (traverse))
import Data.Tuple as X (fst, snd, uncurry)
import Data.Type.Equality as X (type (~))
import Data.Void as X (Void, absurd)
import Data.Word as X (Word16, Word8)
import Effects.Concurrent.Async as X (MonadAsync)
import Effects.Concurrent.STM as X
( MonadSTM,
TBQueue,
newTBQueueA,
readTBQueueA,
tryReadTBQueueA,
writeTBQueueA,
)
import Effects.Concurrent.Thread as X (MonadThread)
import Effects.FileSystem.FileReader as X
( MonadFileReader,
readFileUtf8ThrowM,
)
import Effects.FileSystem.FileWriter as X (MonadFileWriter, writeFileUtf8)
import Effects.FileSystem.HandleWriter as X
( Handle,
IOMode (..),
MonadHandleWriter (hClose, hFlush, hPut, openBinaryFile),
)
import Effects.FileSystem.PathReader as X (MonadPathReader)
import Effects.IORef as X
( IORef,
MonadIORef (modifyIORef', newIORef, readIORef, writeIORef),
)
import Effects.Logger as X
( LogLevel (LevelDebug, LevelError, LevelInfo, LevelWarn),
LogStr,
MonadLogger (monadLoggerLog),
logDebug,
logError,
logInfo,
logOther,
logWarn,
)
import Effects.Logger.Namespace as X (MonadLoggerNS, Namespace, addNamespace)
import Effects.Optparse as X (MonadOptparse)
import Effects.Process.Typed as X (MonadTypedProcess, Process)
import Effects.System.Terminal as X (MonadTerminal, putStrLn, putTextLn)
import FileSystem.OsPath as X (OsPath, osp, ospPathSep, (</>))
import GHC.Enum as X (Bounded (maxBound, minBound), Enum)
import GHC.Err as X (error, undefined)
import GHC.Exception (errorCallWithCallStackException)
import GHC.Exts (RuntimeRep, TYPE, raise#)
import GHC.Float as X (Double)
import GHC.Generics as X (Generic)
import GHC.Int as X (Int)
import GHC.Natural as X (Natural)
import GHC.Num as X (Num (..))
import GHC.Real as X (Integral (..), fromIntegral)
import GHC.Show as X (Show (show))
import GHC.Stack as X (HasCallStack)
import Optics.Core as X
( A_Getter,
A_Lens,
A_Setter,
AffineTraversal',
Is,
Iso',
LabelOptic',
Lens',
Traversal',
lens,
lensVL,
over',
preview,
review,
set',
view,
(%),
(%?),
(.~),
(^.),
(^?),
_1,
_2,
_Just,
)
import Optics.Label as X (LabelOptic (labelOptic))
import Optics.TH as X (makeFieldLabelsNoPrefix, makePrisms)
import System.IO as X (IO)
import TOML as X
( DecodeTOML (..),
TOMLError (..),
Value (Integer, String),
decode,
getArrayOf,
getField,
getFieldOpt,
getFieldOptWith,
getFieldWith,
invalidValue,
makeDecoder,
renderTOMLError,
typeMismatch,
)
import TOML.Decode as X (Decoder)
import Prelude as X (Integer, seq)
import Prelude qualified as P
showt :: (P.Show a) => a -> Text
showt :: forall a. Show a => a -> Text
showt = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> String
forall a. Show a => a -> String
P.show
displayExceptiont :: (Exception e) => e -> Text
displayExceptiont :: forall e. Exception e => e -> Text
displayExceptiont = String -> Text
T.pack (String -> Text) -> (e -> String) -> e -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> String
forall e. Exception e => e -> String
displayException
unpackText :: Text -> String
unpackText :: Text -> String
unpackText = Text -> String
T.unpack
packText :: String -> Text
packText :: String -> Text
packText = String -> Text
T.pack
headMaybe :: [a] -> Maybe a
headMaybe :: forall a. [a] -> Maybe a
headMaybe [] = Maybe a
forall a. Maybe a
Nothing
headMaybe (a
x : [a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
maybeToEither :: e -> Maybe a -> Either e a
maybeToEither :: forall e a. e -> Maybe a -> Either e a
maybeToEither e
e Maybe a
Nothing = e -> Either e a
forall a b. a -> Either a b
Left e
e
maybeToEither e
_ (Just a
x) = a -> Either e a
forall a b. b -> Either a b
Right a
x
monoBimap :: (Bifunctor p) => (a -> b) -> p a a -> p b b
monoBimap :: forall (p :: Type -> Type -> Type) a b.
Bifunctor p =>
(a -> b) -> p a a -> p b b
monoBimap a -> b
f = (a -> b) -> (a -> b) -> p a a -> p b b
forall a b c d. (a -> b) -> (c -> d) -> p a c -> p b d
forall (p :: Type -> Type -> Type) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f a -> b
f
(<<$>>) :: (Functor f, Functor g) => (a -> b) -> g (f a) -> g (f b)
<<$>> :: forall (f :: Type -> Type) (g :: Type -> Type) a b.
(Functor f, Functor g) =>
(a -> b) -> g (f a) -> g (f b)
(<<$>>) = (f a -> f b) -> g (f a) -> g (f b)
forall a b. (a -> b) -> g a -> g b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f a -> f b) -> g (f a) -> g (f b))
-> ((a -> b) -> f a -> f b) -> (a -> b) -> g (f a) -> g (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
infixl 4 <<$>>
todo :: forall {r :: RuntimeRep} (a :: TYPE r). (HasCallStack) => a
todo :: forall a. HasCallStack => a
todo = SomeException -> a
forall a b. a -> b
raise# (String -> CallStack -> SomeException
errorCallWithCallStackException String
"Prelude.todo: not yet implemented" HasCallStack
CallStack
?callStack)
{-# WARNING todo "todo remains in code" #-}