{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

#if !defined(mingw32_HOST_OS)
#define UNIX
#endif

-- | Internal utils for the other Api modules
module Cardano.Api.Utils
  ( (?!)
  , (?!.)
  , formatParsecError
  , failEither
  , failEitherWith
  , noInlineMaybeToStrictMaybe
  , note
  , readFileBlocking
  , runParsecParser
  , textShow

    -- ** CLI option parsing
  , unsafeBoundedRational
  )
where

import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Shelley ()
import Control.Exception (bracket)
import qualified Data.Aeson.Types as Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Lazy as LBS
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Typeable
import GHC.IO.Handle.FD (openFileBlocking)
import GHC.Stack
import System.IO (IOMode (ReadMode), hClose)
import qualified Text.Parsec as Parsec
import qualified Text.Parsec.String as Parsec
import qualified Text.ParserCombinators.Parsec.Error as Parsec

(?!) :: Maybe a -> e -> Either e a
Maybe a
Nothing ?! :: forall a e. Maybe a -> e -> Either e a
?! e
e = e -> Either e a
forall a b. a -> Either a b
Left e
e
Just a
x ?! e
_ = a -> Either e a
forall a b. b -> Either a b
Right a
x

(?!.) :: Either e a -> (e -> e') -> Either e' a
Left e
e ?!. :: forall e a e'. Either e a -> (e -> e') -> Either e' a
?!. e -> e'
f = e' -> Either e' a
forall a b. a -> Either a b
Left (e -> e'
f e
e)
Right a
x ?!. e -> e'
_ = a -> Either e' a
forall a b. b -> Either a b
Right a
x

{-# NOINLINE noInlineMaybeToStrictMaybe #-}
noInlineMaybeToStrictMaybe :: Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe :: forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe a
Nothing = StrictMaybe a
forall a. StrictMaybe a
SNothing
noInlineMaybeToStrictMaybe (Just a
x) = a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust a
x

formatParsecError :: Parsec.ParseError -> String
formatParsecError :: ParseError -> String
formatParsecError ParseError
err =
  String
-> String -> String -> String -> String -> [Message] -> String
Parsec.showErrorMessages
    String
"or"
    String
"unknown parse error"
    String
"expecting"
    String
"unexpected"
    String
"end of input"
    ([Message] -> String) -> [Message] -> String
forall a b. (a -> b) -> a -> b
$ ParseError -> [Message]
Parsec.errorMessages ParseError
err

runParsecParser :: Parsec.Parser a -> Text -> Aeson.Parser a
runParsecParser :: forall a. Parser a -> Text -> Parser a
runParsecParser Parser a
parser Text
input =
  case Parser a -> String -> String -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
Parsec.parse (Parser a
parser Parser a -> ParsecT String () Identity () -> Parser a
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
Parsec.eof) String
"" (Text -> String
Text.unpack Text
input) of
    Right a
txin -> a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
txin
    Left ParseError
parseError -> String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ ParseError -> String
formatParsecError ParseError
parseError

failEither :: MonadFail m => Either String a -> m a
failEither :: forall (m :: * -> *) a. MonadFail m => Either String a -> m a
failEither = (String -> m a) -> (a -> m a) -> Either String a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

failEitherWith :: MonadFail m => (e -> String) -> Either e a -> m a
failEitherWith :: forall (m :: * -> *) e a.
MonadFail m =>
(e -> String) -> Either e a -> m a
failEitherWith e -> String
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 (String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> (e -> String) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> String
f) a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

note :: MonadFail m => String -> Maybe a -> m a
note :: forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
note String
msg = \case
  Maybe a
Nothing -> String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
  Just a
a -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

readFileBlocking :: FilePath -> IO BS.ByteString
readFileBlocking :: String -> IO ByteString
readFileBlocking String
path =
  IO Handle
-> (Handle -> IO ()) -> (Handle -> IO ByteString) -> IO ByteString
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    (String -> IOMode -> IO Handle
openFileBlocking String
path IOMode
ReadMode)
    Handle -> IO ()
hClose
    ( \Handle
fp -> do
        -- An arbitrary block size.
        let blockSize :: Int
blockSize = Int
4096
        let go :: Builder -> IO Builder
go Builder
acc = do
              ByteString
next <- Handle -> Int -> IO ByteString
BS.hGet Handle
fp Int
blockSize
              if ByteString -> Bool
BS.null ByteString
next
                then Builder -> IO Builder
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
acc
                else Builder -> IO Builder
go (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString ByteString
next)
        Builder
contents <- Builder -> IO Builder
go Builder
forall a. Monoid a => a
mempty
        ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ LazyByteString -> ByteString
LBS.toStrict (LazyByteString -> ByteString) -> LazyByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> LazyByteString
Builder.toLazyByteString Builder
contents
    )

textShow :: Show a => a -> Text
textShow :: forall a. Show a => a -> Text
textShow = String -> Text
Text.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

-- | Convert Rational to a bounded rational. Throw an exception when the rational is out of bounds.
unsafeBoundedRational
  :: forall r
   . (HasCallStack, Typeable r, BoundedRational r)
  => Rational
  -> r
unsafeBoundedRational :: forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundedRational Rational
x = r -> Maybe r -> r
forall a. a -> Maybe a -> a
fromMaybe (String -> r
forall a. HasCallStack => String -> a
error String
errMessage) (Maybe r -> r) -> Maybe r -> r
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe r
forall r. BoundedRational r => Rational -> Maybe r
boundRational Rational
x
 where
  errMessage :: String
errMessage = TypeRep -> String
forall a. Show a => a -> String
show (Proxy r -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @r)) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is out of bounds: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Rational -> String
forall a. Show a => a -> String
show Rational
x