{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      : ZuulWeeder.Prelude
-- Description : The project Prelude
-- Copyright   : (c) Red Hat, 2022
-- License     : Apache-2.0
--
-- Maintainer  : tdecacqu@redhat.com, fboucher@redhat.com
-- Stability   : provisional
-- Portability : portable
--
-- This module exports common functions and helpers.
module ZuulWeeder.Prelude
  ( -- * clock
    getSec,
    intervalMilliSec,

    -- * th-env
    gitVersion,

    -- * fast-logger
    Logger,
    info,
    withLogger,

    -- * pretty-simple
    Text.Pretty.Simple.pPrint,
    Text.Pretty.Simple.pShowNoColor,

    -- * exceptions
    Control.Exception.SomeException,
    Control.Exception.try,
    Control.Monad.Catch.catchAll,

    -- * filepath text
    FilePathT (..),
    (</>),
    getPath,
    listDirectory,
    doesDirectoryExist,
    readFileBS,
    readFileText,
    writeFileText,

    -- * text, bytestring
    Data.Text.Text,
    Data.ByteString.ByteString,

    -- * containers
    Data.Map.Map,
    Data.Set.Set,
    Data.Tree.Forest,
    Data.Tree.Tree (..),

    -- * witch
    Witch.From,
    Witch.from,
    Witch.via,
    Witch.into,
    Witch.unsafeFrom,
    Witch.unsafeInto,

    -- * mtl
    Control.Monad.Trans.lift,
    Control.Monad.Reader.Reader,
    Control.Monad.Reader.ReaderT,
    Control.Monad.Reader.runReaderT,
    Control.Monad.State.State,
    Control.Monad.State.StateT,
    Control.Monad.State.execStateT,
    Control.Monad.Except.ExceptT,
    Control.Monad.Except.runExceptT,
    Control.Monad.Except.throwError,
    Control.Monad.Trans.Except.except,
    Data.Functor.Identity.runIdentity,

    -- * lens
    Control.Lens.set,
    Control.Lens.over,
    Control.Lens.use,
    (%=),

    -- * aeson
    Data.Aeson.FromJSON (..),
    Data.Aeson.FromJSONKey (..),
    Data.Aeson.ToJSON (..),
    Data.Aeson.ToJSONKey (..),
    Data.Aeson.Value (Object),
    Data.Aeson.genericParseJSON,
    Data.Aeson.genericToJSON,
    Data.Aeson.defaultOptions,
    Data.Aeson.omitNothingFields,
    encodeJSON,
    decodeJSON,

    -- * aeson helpers
    Decoder (..),
    decodeFail,
    decodeObject,
    decodeObjectAttribute,
    decodeAsList,
    decodeString,
    decodeList,

    -- * qq
    Data.String.QQ.s,

    -- * with-utf8
    Main.Utf8.withUtf8,

    -- * utilities
    whenM,
    orDie,
    fromEither,

    -- * base concurrent
    Control.Concurrent.forkIO,
    Control.Concurrent.threadDelay,
    Data.IORef.IORef,
    Data.IORef.newIORef,
    Data.IORef.readIORef,
    Data.IORef.writeIORef,
    Control.Concurrent.MVar.MVar,
    Control.Concurrent.MVar.newMVar,
    Control.Concurrent.MVar.modifyMVar,

    -- * base list
    Data.List.sort,
    Data.List.nub,
    Data.List.NonEmpty.NonEmpty,
    Data.List.NonEmpty.nonEmpty,

    -- * base data
    Int64,
    (&),
    Data.Proxy.Proxy (..),
    Data.Bifunctor.first,
    Data.Bool.bool,
    Data.Foldable.traverse_,
    Data.Foldable.foldl',
    Data.Maybe.catMaybes,
    Data.Maybe.mapMaybe,
    Data.Maybe.isJust,
    Data.Maybe.isNothing,
    Data.Maybe.fromMaybe,
    Data.Either.fromRight,

    -- * base control
    Control.Monad.forM_,
    Control.Monad.foldM,
    Control.Monad.unless,
    Control.Monad.when,
    Control.Monad.void,
    Control.Monad.IO.Class.liftIO,
    (<=<),
    (>=>),
    (<|>),

    -- * base debug
    Debug.Trace.trace,
    System.IO.hPutStrLn,
    System.IO.stderr,
    Text.Printf.printf,
    GHC.Stack.HasCallStack,

    -- * base system
    Data.Version.showVersion,
    System.Environment.lookupEnv,
    System.Environment.getArgs,
    System.Timeout.timeout,

    -- * hashable
    Data.Hashable.hash,
    Data.Hashable.Hashable,

    -- * base
    module Prelude,
    Generic,
  )
where

import Control.Applicative ((<|>))
import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.MVar qualified
import Control.Exception qualified
import Control.Lens ((%=))
import Control.Lens qualified
import Control.Monad ((<=<), (>=>))
import Control.Monad qualified
import Control.Monad.Catch qualified
import Control.Monad.Except qualified
import Control.Monad.IO.Class qualified
import Control.Monad.Reader qualified
import Control.Monad.State qualified
import Control.Monad.Trans qualified
import Control.Monad.Trans.Except qualified
import Data.Aeson (Object, Value (Array, Object, String))
import Data.Aeson qualified
import Data.Aeson.Key qualified
import Data.Aeson.KeyMap qualified as HM
import Data.Bifunctor qualified
import Data.Bool qualified
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.Either qualified
import Data.Foldable qualified
import Data.Function ((&))
import Data.Functor.Identity qualified
import Data.Generics.Labels ()
import Data.Hashable qualified
import Data.IORef qualified
import Data.Int
import Data.List qualified
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Data.Map (Map)
import Data.Maybe qualified
import Data.Proxy qualified
import Data.Set (Set)
import Data.String (IsString)
import Data.String.QQ qualified (s)
import Data.Text (Text, pack, unpack)
import Data.Text.IO qualified as Text (readFile, writeFile)
import Data.Tree qualified
import Data.Vector qualified as V
import Data.Version qualified
import Debug.Trace qualified
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Language.Haskell.TH.Env qualified
import Main.Utf8 qualified (withUtf8)
import System.Clock qualified
import System.Directory qualified
import System.Environment qualified
import System.FilePath qualified
import System.IO qualified
import System.Log.FastLogger qualified
import System.Timeout qualified (timeout)
import Text.Pretty.Simple qualified
import Text.Printf qualified
import Witch qualified

encodeJSON :: Data.Aeson.ToJSON a => a -> ByteString
encodeJSON :: forall a. ToJSON a => a -> FormattedTime
encodeJSON = ByteString -> FormattedTime
forall source target. From source target => source -> target
Witch.from (ByteString -> FormattedTime)
-> (a -> ByteString) -> a -> FormattedTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
Data.Aeson.encode

decodeJSON :: Data.Aeson.FromJSON a => ByteString -> Either String a
decodeJSON :: forall a. FromJSON a => FormattedTime -> Either String a
decodeJSON = FormattedTime -> Either String a
forall a. FromJSON a => FormattedTime -> Either String a
Data.Aeson.eitherDecodeStrict

-- | The content of the GIT_COMMIT environment variable, default to HEAD.
gitVersion :: Text
gitVersion :: Text
gitVersion = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe Text
"HEAD" $$(Language.Haskell.TH.Env.envQ "GIT_COMMIT")

-- | The fast-logger.
newtype Logger = Logger System.Log.FastLogger.TimedFastLogger

-- | Create the logger.
withLogger :: (Logger -> IO a) -> IO a
withLogger :: forall a. (Logger -> IO a) -> IO a
withLogger Logger -> IO a
cb = do
  IO FormattedTime
tc <- FormattedTime -> IO (IO FormattedTime)
System.Log.FastLogger.newTimeCache FormattedTime
"%F %T "
  IO FormattedTime -> LogType -> (TimedFastLogger -> IO a) -> IO a
forall a.
IO FormattedTime -> LogType -> (TimedFastLogger -> IO a) -> IO a
System.Log.FastLogger.withTimedFastLogger IO FormattedTime
tc LogType
l (Logger -> IO a
cb (Logger -> IO a)
-> (TimedFastLogger -> Logger) -> TimedFastLogger -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimedFastLogger -> Logger
Logger)
  where
    l :: LogType
l = BufSize -> LogType
System.Log.FastLogger.LogStderr BufSize
1024

-- | Log a message.
info :: Logger -> ByteString -> IO ()
info :: Logger -> FormattedTime -> IO ()
info (Logger TimedFastLogger
logger) FormattedTime
msg = TimedFastLogger
logger (\FormattedTime
time -> FormattedTime -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
System.Log.FastLogger.toLogStr (FormattedTime -> LogStr) -> FormattedTime -> LogStr
forall a b. (a -> b) -> a -> b
$ FormattedTime
time FormattedTime -> FormattedTime -> FormattedTime
forall a. Semigroup a => a -> a -> a
<> FormattedTime
msg FormattedTime -> FormattedTime -> FormattedTime
forall a. Semigroup a => a -> a -> a
<> FormattedTime
"\n")

-- | lifted 'Control.Monad.when'
whenM :: Monad m => m Bool -> m () -> m ()
whenM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM m Bool
test m ()
action = do
  Bool
res <- m Bool
test
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.when Bool
res m ()
action

-- | A FilePath encoded with UTF-8.
newtype FilePathT = FilePathT Text
  deriving ((forall x. FilePathT -> Rep FilePathT x)
-> (forall x. Rep FilePathT x -> FilePathT) -> Generic FilePathT
forall x. Rep FilePathT x -> FilePathT
forall x. FilePathT -> Rep FilePathT x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FilePathT x -> FilePathT
$cfrom :: forall x. FilePathT -> Rep FilePathT x
Generic)
  deriving newtype (BufSize -> FilePathT -> ShowS
[FilePathT] -> ShowS
FilePathT -> String
(BufSize -> FilePathT -> ShowS)
-> (FilePathT -> String)
-> ([FilePathT] -> ShowS)
-> Show FilePathT
forall a.
(BufSize -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilePathT] -> ShowS
$cshowList :: [FilePathT] -> ShowS
show :: FilePathT -> String
$cshow :: FilePathT -> String
showsPrec :: BufSize -> FilePathT -> ShowS
$cshowsPrec :: BufSize -> FilePathT -> ShowS
Show, FilePathT -> FilePathT -> Bool
(FilePathT -> FilePathT -> Bool)
-> (FilePathT -> FilePathT -> Bool) -> Eq FilePathT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilePathT -> FilePathT -> Bool
$c/= :: FilePathT -> FilePathT -> Bool
== :: FilePathT -> FilePathT -> Bool
$c== :: FilePathT -> FilePathT -> Bool
Eq, Eq FilePathT
Eq FilePathT
-> (FilePathT -> FilePathT -> Ordering)
-> (FilePathT -> FilePathT -> Bool)
-> (FilePathT -> FilePathT -> Bool)
-> (FilePathT -> FilePathT -> Bool)
-> (FilePathT -> FilePathT -> Bool)
-> (FilePathT -> FilePathT -> FilePathT)
-> (FilePathT -> FilePathT -> FilePathT)
-> Ord FilePathT
FilePathT -> FilePathT -> Bool
FilePathT -> FilePathT -> Ordering
FilePathT -> FilePathT -> FilePathT
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FilePathT -> FilePathT -> FilePathT
$cmin :: FilePathT -> FilePathT -> FilePathT
max :: FilePathT -> FilePathT -> FilePathT
$cmax :: FilePathT -> FilePathT -> FilePathT
>= :: FilePathT -> FilePathT -> Bool
$c>= :: FilePathT -> FilePathT -> Bool
> :: FilePathT -> FilePathT -> Bool
$c> :: FilePathT -> FilePathT -> Bool
<= :: FilePathT -> FilePathT -> Bool
$c<= :: FilePathT -> FilePathT -> Bool
< :: FilePathT -> FilePathT -> Bool
$c< :: FilePathT -> FilePathT -> Bool
compare :: FilePathT -> FilePathT -> Ordering
$ccompare :: FilePathT -> FilePathT -> Ordering
Ord, String -> FilePathT
(String -> FilePathT) -> IsString FilePathT
forall a. (String -> a) -> IsString a
fromString :: String -> FilePathT
$cfromString :: String -> FilePathT
IsString, NonEmpty FilePathT -> FilePathT
FilePathT -> FilePathT -> FilePathT
(FilePathT -> FilePathT -> FilePathT)
-> (NonEmpty FilePathT -> FilePathT)
-> (forall b. Integral b => b -> FilePathT -> FilePathT)
-> Semigroup FilePathT
forall b. Integral b => b -> FilePathT -> FilePathT
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> FilePathT -> FilePathT
$cstimes :: forall b. Integral b => b -> FilePathT -> FilePathT
sconcat :: NonEmpty FilePathT -> FilePathT
$csconcat :: NonEmpty FilePathT -> FilePathT
<> :: FilePathT -> FilePathT -> FilePathT
$c<> :: FilePathT -> FilePathT -> FilePathT
Semigroup, Semigroup FilePathT
FilePathT
Semigroup FilePathT
-> FilePathT
-> (FilePathT -> FilePathT -> FilePathT)
-> ([FilePathT] -> FilePathT)
-> Monoid FilePathT
[FilePathT] -> FilePathT
FilePathT -> FilePathT -> FilePathT
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [FilePathT] -> FilePathT
$cmconcat :: [FilePathT] -> FilePathT
mappend :: FilePathT -> FilePathT -> FilePathT
$cmappend :: FilePathT -> FilePathT -> FilePathT
mempty :: FilePathT
$cmempty :: FilePathT
Monoid, Eq FilePathT
Eq FilePathT
-> (BufSize -> FilePathT -> BufSize)
-> (FilePathT -> BufSize)
-> Hashable FilePathT
BufSize -> FilePathT -> BufSize
FilePathT -> BufSize
forall a.
Eq a -> (BufSize -> a -> BufSize) -> (a -> BufSize) -> Hashable a
hash :: FilePathT -> BufSize
$chash :: FilePathT -> BufSize
hashWithSalt :: BufSize -> FilePathT -> BufSize
$chashWithSalt :: BufSize -> FilePathT -> BufSize
Data.Hashable.Hashable, Value -> Parser [FilePathT]
Value -> Parser FilePathT
(Value -> Parser FilePathT)
-> (Value -> Parser [FilePathT]) -> FromJSON FilePathT
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FilePathT]
$cparseJSONList :: Value -> Parser [FilePathT]
parseJSON :: Value -> Parser FilePathT
$cparseJSON :: Value -> Parser FilePathT
Data.Aeson.FromJSON, [FilePathT] -> Encoding
[FilePathT] -> Value
FilePathT -> Encoding
FilePathT -> Value
(FilePathT -> Value)
-> (FilePathT -> Encoding)
-> ([FilePathT] -> Value)
-> ([FilePathT] -> Encoding)
-> ToJSON FilePathT
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FilePathT] -> Encoding
$ctoEncodingList :: [FilePathT] -> Encoding
toJSONList :: [FilePathT] -> Value
$ctoJSONList :: [FilePathT] -> Value
toEncoding :: FilePathT -> Encoding
$ctoEncoding :: FilePathT -> Encoding
toJSON :: FilePathT -> Value
$ctoJSON :: FilePathT -> Value
Data.Aeson.ToJSON)

instance Witch.From FilePathT Text where
  from :: FilePathT -> Text
from (FilePathT Text
fp) = Text
fp

-- | Get the string FilePath for external libraries.
getPath :: FilePathT -> FilePath
getPath :: FilePathT -> String
getPath = Text -> String
unpack (Text -> String) -> (FilePathT -> Text) -> FilePathT -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePathT -> Text
forall source target. From source target => source -> target
Witch.from

-- | Combine two files path with 'System.FilePath.combine'
(</>) :: FilePathT -> FilePathT -> FilePathT
FilePathT
a </> :: FilePathT -> FilePathT -> FilePathT
</> FilePathT
b = Text -> FilePathT
FilePathT (Text -> FilePathT) -> (String -> Text) -> String -> FilePathT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> FilePathT) -> String -> FilePathT
forall a b. (a -> b) -> a -> b
$ FilePathT -> String
getPath FilePathT
a String -> ShowS
`System.FilePath.combine` FilePathT -> String
getPath FilePathT
b

-- | Wrapper for 'System.Directory.listDirectory'.
listDirectory :: FilePathT -> IO [FilePathT]
listDirectory :: FilePathT -> IO [FilePathT]
listDirectory FilePathT
fp = (String -> FilePathT) -> [String] -> [FilePathT]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> FilePathT
FilePathT (Text -> FilePathT) -> (String -> Text) -> String -> FilePathT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) ([String] -> [FilePathT]) -> IO [String] -> IO [FilePathT]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
System.Directory.listDirectory (FilePathT -> String
getPath FilePathT
fp)

-- | Wrapper for 'System.Directory.doesDirectoryExist'
doesDirectoryExist :: FilePathT -> IO Bool
doesDirectoryExist :: FilePathT -> IO Bool
doesDirectoryExist = String -> IO Bool
System.Directory.doesDirectoryExist (String -> IO Bool)
-> (FilePathT -> String) -> FilePathT -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePathT -> String
getPath

-- | Wrapper for 'Data.ByteString.readFile'
readFileBS :: FilePathT -> IO BS.ByteString
readFileBS :: FilePathT -> IO FormattedTime
readFileBS = String -> IO FormattedTime
BS.readFile (String -> IO FormattedTime)
-> (FilePathT -> String) -> FilePathT -> IO FormattedTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePathT -> String
getPath

-- | Wrapper for 'Data.Text.IO.readFile'
readFileText :: FilePathT -> IO Text
readFileText :: FilePathT -> IO Text
readFileText = String -> IO Text
Text.readFile (String -> IO Text)
-> (FilePathT -> String) -> FilePathT -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePathT -> String
getPath

writeFileText :: FilePathT -> Text -> IO ()
writeFileText :: FilePathT -> Text -> IO ()
writeFileText (FilePathT -> String
getPath -> String
fp) = String -> Text -> IO ()
Text.writeFile String
fp

-- | Get the clock seconds.
getSec :: IO Int64
getSec :: IO Int64
getSec = do
  System.Clock.TimeSpec Int64
sec Int64
_ <- Clock -> IO TimeSpec
System.Clock.getTime Clock
System.Clock.Monotonic
  Int64 -> IO Int64
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
sec

-- | Compute the time interval in milli-seconds ellapsed between now and the provided action.
intervalMilliSec :: IO (IO Int64)
intervalMilliSec :: IO (IO Int64)
intervalMilliSec = do
  TimeSpec
start <- Clock -> IO TimeSpec
System.Clock.getTime Clock
System.Clock.Monotonic
  IO Int64 -> IO (IO Int64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO Int64 -> IO (IO Int64)) -> IO Int64 -> IO (IO Int64)
forall a b. (a -> b) -> a -> b
$ do
    TimeSpec
end <- Clock -> IO TimeSpec
System.Clock.getTime Clock
System.Clock.Monotonic
    let ns :: Integer
ns = TimeSpec -> Integer
System.Clock.toNanoSecs (TimeSpec -> Integer) -> TimeSpec -> Integer
forall a b. (a -> b) -> a -> b
$ TimeSpec -> TimeSpec -> TimeSpec
System.Clock.diffTimeSpec TimeSpec
end TimeSpec
start
    Int64 -> IO Int64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> IO Int64) -> Int64 -> IO Int64
forall a b. (a -> b) -> a -> b
$ Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
ns Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1_000_000)

-- | From https://www.haskellforall.com/2021/05/the-trick-to-avoid-deeply-nested-error.html
orDie :: Maybe a -> b -> Either b a
Just a
a orDie :: forall a b. Maybe a -> b -> Either b a
`orDie` b
_ = a -> Either b a
forall a b. b -> Either a b
Right a
a
Maybe a
Nothing `orDie` b
err = b -> Either b a
forall a b. a -> Either a b
Left b
err

-- | Die with on the Left case
fromEither :: Show a => Either a b -> b
fromEither :: forall a b. Show a => Either a b -> b
fromEither Either a b
e = case Either a b
e of
  Left a
x -> String -> b
forall a. HasCallStack => String -> a
error (a -> String
forall a. Show a => a -> String
show a
x)
  Right b
x -> b
x

-- | A convenient wrapper to decode json value with custom error message.
newtype Decoder a = Decoder (Either (Text, Value) a)
  deriving (Functor Decoder
Foldable Decoder
Functor Decoder
-> Foldable Decoder
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Decoder a -> f (Decoder b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Decoder (f a) -> f (Decoder a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Decoder a -> m (Decoder b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Decoder (m a) -> m (Decoder a))
-> Traversable Decoder
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Decoder (m a) -> m (Decoder a)
forall (f :: * -> *) a.
Applicative f =>
Decoder (f a) -> f (Decoder a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Decoder a -> m (Decoder b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Decoder a -> f (Decoder b)
sequence :: forall (m :: * -> *) a. Monad m => Decoder (m a) -> m (Decoder a)
$csequence :: forall (m :: * -> *) a. Monad m => Decoder (m a) -> m (Decoder a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Decoder a -> m (Decoder b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Decoder a -> m (Decoder b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Decoder (f a) -> f (Decoder a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Decoder (f a) -> f (Decoder a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Decoder a -> f (Decoder b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Decoder a -> f (Decoder b)
Traversable)
  deriving newtype ((forall a b. (a -> b) -> Decoder a -> Decoder b)
-> (forall a b. a -> Decoder b -> Decoder a) -> Functor Decoder
forall a b. a -> Decoder b -> Decoder a
forall a b. (a -> b) -> Decoder a -> Decoder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Decoder b -> Decoder a
$c<$ :: forall a b. a -> Decoder b -> Decoder a
fmap :: forall a b. (a -> b) -> Decoder a -> Decoder b
$cfmap :: forall a b. (a -> b) -> Decoder a -> Decoder b
Functor, Functor Decoder
Functor Decoder
-> (forall a. a -> Decoder a)
-> (forall a b. Decoder (a -> b) -> Decoder a -> Decoder b)
-> (forall a b c.
    (a -> b -> c) -> Decoder a -> Decoder b -> Decoder c)
-> (forall a b. Decoder a -> Decoder b -> Decoder b)
-> (forall a b. Decoder a -> Decoder b -> Decoder a)
-> Applicative Decoder
forall a. a -> Decoder a
forall a b. Decoder a -> Decoder b -> Decoder a
forall a b. Decoder a -> Decoder b -> Decoder b
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall a b c. (a -> b -> c) -> Decoder a -> Decoder b -> Decoder c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Decoder a -> Decoder b -> Decoder a
$c<* :: forall a b. Decoder a -> Decoder b -> Decoder a
*> :: forall a b. Decoder a -> Decoder b -> Decoder b
$c*> :: forall a b. Decoder a -> Decoder b -> Decoder b
liftA2 :: forall a b c. (a -> b -> c) -> Decoder a -> Decoder b -> Decoder c
$cliftA2 :: forall a b c. (a -> b -> c) -> Decoder a -> Decoder b -> Decoder c
<*> :: forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
$c<*> :: forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
pure :: forall a. a -> Decoder a
$cpure :: forall a. a -> Decoder a
Applicative, Applicative Decoder
Applicative Decoder
-> (forall a b. Decoder a -> (a -> Decoder b) -> Decoder b)
-> (forall a b. Decoder a -> Decoder b -> Decoder b)
-> (forall a. a -> Decoder a)
-> Monad Decoder
forall a. a -> Decoder a
forall a b. Decoder a -> Decoder b -> Decoder b
forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Decoder a
$creturn :: forall a. a -> Decoder a
>> :: forall a b. Decoder a -> Decoder b -> Decoder b
$c>> :: forall a b. Decoder a -> Decoder b -> Decoder b
>>= :: forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
$c>>= :: forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
Monad, BufSize -> Decoder a -> ShowS
[Decoder a] -> ShowS
Decoder a -> String
(BufSize -> Decoder a -> ShowS)
-> (Decoder a -> String)
-> ([Decoder a] -> ShowS)
-> Show (Decoder a)
forall a. Show a => BufSize -> Decoder a -> ShowS
forall a. Show a => [Decoder a] -> ShowS
forall a. Show a => Decoder a -> String
forall a.
(BufSize -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Decoder a] -> ShowS
$cshowList :: forall a. Show a => [Decoder a] -> ShowS
show :: Decoder a -> String
$cshow :: forall a. Show a => Decoder a -> String
showsPrec :: BufSize -> Decoder a -> ShowS
$cshowsPrec :: forall a. Show a => BufSize -> Decoder a -> ShowS
Show, (forall m. Monoid m => Decoder m -> m)
-> (forall m a. Monoid m => (a -> m) -> Decoder a -> m)
-> (forall m a. Monoid m => (a -> m) -> Decoder a -> m)
-> (forall a b. (a -> b -> b) -> b -> Decoder a -> b)
-> (forall a b. (a -> b -> b) -> b -> Decoder a -> b)
-> (forall b a. (b -> a -> b) -> b -> Decoder a -> b)
-> (forall b a. (b -> a -> b) -> b -> Decoder a -> b)
-> (forall a. (a -> a -> a) -> Decoder a -> a)
-> (forall a. (a -> a -> a) -> Decoder a -> a)
-> (forall a. Decoder a -> [a])
-> (forall a. Decoder a -> Bool)
-> (forall a. Decoder a -> BufSize)
-> (forall a. Eq a => a -> Decoder a -> Bool)
-> (forall a. Ord a => Decoder a -> a)
-> (forall a. Ord a => Decoder a -> a)
-> (forall a. Num a => Decoder a -> a)
-> (forall a. Num a => Decoder a -> a)
-> Foldable Decoder
forall a. Eq a => a -> Decoder a -> Bool
forall a. Num a => Decoder a -> a
forall a. Ord a => Decoder a -> a
forall m. Monoid m => Decoder m -> m
forall a. Decoder a -> Bool
forall a. Decoder a -> BufSize
forall a. Decoder a -> [a]
forall a. (a -> a -> a) -> Decoder a -> a
forall m a. Monoid m => (a -> m) -> Decoder a -> m
forall b a. (b -> a -> b) -> b -> Decoder a -> b
forall a b. (a -> b -> b) -> b -> Decoder a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> BufSize)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Decoder a -> a
$cproduct :: forall a. Num a => Decoder a -> a
sum :: forall a. Num a => Decoder a -> a
$csum :: forall a. Num a => Decoder a -> a
minimum :: forall a. Ord a => Decoder a -> a
$cminimum :: forall a. Ord a => Decoder a -> a
maximum :: forall a. Ord a => Decoder a -> a
$cmaximum :: forall a. Ord a => Decoder a -> a
elem :: forall a. Eq a => a -> Decoder a -> Bool
$celem :: forall a. Eq a => a -> Decoder a -> Bool
length :: forall a. Decoder a -> BufSize
$clength :: forall a. Decoder a -> BufSize
null :: forall a. Decoder a -> Bool
$cnull :: forall a. Decoder a -> Bool
toList :: forall a. Decoder a -> [a]
$ctoList :: forall a. Decoder a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Decoder a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Decoder a -> a
foldr1 :: forall a. (a -> a -> a) -> Decoder a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Decoder a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Decoder a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Decoder a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Decoder a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Decoder a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Decoder a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Decoder a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Decoder a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Decoder a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Decoder a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Decoder a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Decoder a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Decoder a -> m
fold :: forall m. Monoid m => Decoder m -> m
$cfold :: forall m. Monoid m => Decoder m -> m
Foldable)

-- | Decode a json object.
decodeObject :: Value -> Decoder Object
decodeObject :: Value -> Decoder Object
decodeObject = \case
  (Object Object
o) -> Object -> Decoder Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure Object
o
  Value
x -> Text -> Value -> Decoder Object
forall a. Text -> Value -> Decoder a
decodeFail Text
"expecting an object" Value
x

-- | Decode a json object attribute value.
decodeObjectAttribute :: Data.Aeson.Key.Key -> Object -> Decoder Value
decodeObjectAttribute :: Key -> Object -> Decoder Value
decodeObjectAttribute Key
k Object
o = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
k Object
o of
  Just Value
v -> Value -> Decoder Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
  Maybe Value
Nothing -> Text -> Value -> Decoder Value
forall a. Text -> Value -> Decoder a
decodeFail (Text
"can't find key:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
Data.Aeson.Key.toText Key
k) (Object -> Value
Object Object
o)

-- | Decode a json list.
decodeList :: Value -> Decoder [Value]
decodeList :: Value -> Decoder [Value]
decodeList = \case
  (Array Array
v) -> [Value] -> Decoder [Value]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
v)
  Value
v -> Text -> Value -> Decoder [Value]
forall a. Text -> Value -> Decoder a
decodeFail Text
"expected a list" Value
v

-- | Decode a json string.
decodeString :: Value -> Decoder Text
decodeString :: Value -> Decoder Text
decodeString = \case
  (String Text
v) -> Text -> Decoder Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
v
  Value
v -> Text -> Value -> Decoder Text
forall a. Text -> Value -> Decoder a
decodeFail Text
"Expected a string" Value
v

-- | Decode a json object attribute value as a list.
decodeAsList :: Data.Aeson.Key.Key -> (Text -> a) -> Object -> Decoder [a]
decodeAsList :: forall a. Key -> (Text -> a) -> Object -> Decoder [a]
decodeAsList Key
k Text -> a
build Object
va = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
k Object
va of
  Just (String Text
x) -> [a] -> Decoder [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> a
build Text
x]
  Just (Array Array
xs) -> (Text -> a) -> [Text] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> a
build ([Text] -> [a]) -> Decoder [Text] -> Decoder [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Decoder Text) -> [Value] -> Decoder [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Decoder Text
decodeString (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
xs)
  Just Value
_va -> Text -> Value -> Decoder [a]
forall a. Text -> Value -> Decoder a
decodeFail (Text
"Unexpected " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
Data.Aeson.Key.toText Key
k) (Object -> Value
Object Object
va)
  Maybe Value
Nothing -> [a] -> Decoder [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Abort a decoder.
decodeFail :: Text -> Value -> Decoder a
decodeFail :: forall a. Text -> Value -> Decoder a
decodeFail Text
t Value
v = Either (Text, Value) a -> Decoder a
forall a. Either (Text, Value) a -> Decoder a
Decoder ((Text, Value) -> Either (Text, Value) a
forall a b. a -> Either a b
Left (Text
t, Value
v))