-- | Epoch

module Blockfrost.Types.Shared.Epoch
  where

import Data.Aeson (FromJSON, ToJSON)
import GHC.Generics
import Servant.API (Capture, FromHttpApiData (..), ToHttpApiData (..))
import Servant.Docs (DocCapture (..), ToCapture (..), ToSample (..), samples)

newtype Epoch = Epoch Integer
  deriving stock (Epoch -> Epoch -> Bool
(Epoch -> Epoch -> Bool) -> (Epoch -> Epoch -> Bool) -> Eq Epoch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Epoch -> Epoch -> Bool
$c/= :: Epoch -> Epoch -> Bool
== :: Epoch -> Epoch -> Bool
$c== :: Epoch -> Epoch -> Bool
Eq, Int -> Epoch -> ShowS
[Epoch] -> ShowS
Epoch -> String
(Int -> Epoch -> ShowS)
-> (Epoch -> String) -> ([Epoch] -> ShowS) -> Show Epoch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Epoch] -> ShowS
$cshowList :: [Epoch] -> ShowS
show :: Epoch -> String
$cshow :: Epoch -> String
showsPrec :: Int -> Epoch -> ShowS
$cshowsPrec :: Int -> Epoch -> ShowS
Show, (forall x. Epoch -> Rep Epoch x)
-> (forall x. Rep Epoch x -> Epoch) -> Generic Epoch
forall x. Rep Epoch x -> Epoch
forall x. Epoch -> Rep Epoch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Epoch x -> Epoch
$cfrom :: forall x. Epoch -> Rep Epoch x
Generic)
  deriving newtype (Integer -> Epoch
Epoch -> Epoch
Epoch -> Epoch -> Epoch
(Epoch -> Epoch -> Epoch)
-> (Epoch -> Epoch -> Epoch)
-> (Epoch -> Epoch -> Epoch)
-> (Epoch -> Epoch)
-> (Epoch -> Epoch)
-> (Epoch -> Epoch)
-> (Integer -> Epoch)
-> Num Epoch
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Epoch
$cfromInteger :: Integer -> Epoch
signum :: Epoch -> Epoch
$csignum :: Epoch -> Epoch
abs :: Epoch -> Epoch
$cabs :: Epoch -> Epoch
negate :: Epoch -> Epoch
$cnegate :: Epoch -> Epoch
* :: Epoch -> Epoch -> Epoch
$c* :: Epoch -> Epoch -> Epoch
- :: Epoch -> Epoch -> Epoch
$c- :: Epoch -> Epoch -> Epoch
+ :: Epoch -> Epoch -> Epoch
$c+ :: Epoch -> Epoch -> Epoch
Num, ByteString -> Either Text Epoch
Text -> Either Text Epoch
(Text -> Either Text Epoch)
-> (ByteString -> Either Text Epoch)
-> (Text -> Either Text Epoch)
-> FromHttpApiData Epoch
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
parseQueryParam :: Text -> Either Text Epoch
$cparseQueryParam :: Text -> Either Text Epoch
parseHeader :: ByteString -> Either Text Epoch
$cparseHeader :: ByteString -> Either Text Epoch
parseUrlPiece :: Text -> Either Text Epoch
$cparseUrlPiece :: Text -> Either Text Epoch
FromHttpApiData, Epoch -> ByteString
Epoch -> Builder
Epoch -> Text
(Epoch -> Text)
-> (Epoch -> Builder)
-> (Epoch -> ByteString)
-> (Epoch -> Text)
-> ToHttpApiData Epoch
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: Epoch -> Text
$ctoQueryParam :: Epoch -> Text
toHeader :: Epoch -> ByteString
$ctoHeader :: Epoch -> ByteString
toEncodedUrlPiece :: Epoch -> Builder
$ctoEncodedUrlPiece :: Epoch -> Builder
toUrlPiece :: Epoch -> Text
$ctoUrlPiece :: Epoch -> Text
ToHttpApiData, Value -> Parser [Epoch]
Value -> Parser Epoch
(Value -> Parser Epoch)
-> (Value -> Parser [Epoch]) -> FromJSON Epoch
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Epoch]
$cparseJSONList :: Value -> Parser [Epoch]
parseJSON :: Value -> Parser Epoch
$cparseJSON :: Value -> Parser Epoch
FromJSON, [Epoch] -> Encoding
[Epoch] -> Value
Epoch -> Encoding
Epoch -> Value
(Epoch -> Value)
-> (Epoch -> Encoding)
-> ([Epoch] -> Value)
-> ([Epoch] -> Encoding)
-> ToJSON Epoch
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Epoch] -> Encoding
$ctoEncodingList :: [Epoch] -> Encoding
toJSONList :: [Epoch] -> Value
$ctoJSONList :: [Epoch] -> Value
toEncoding :: Epoch -> Encoding
$ctoEncoding :: Epoch -> Encoding
toJSON :: Epoch -> Value
$ctoJSON :: Epoch -> Value
ToJSON)

unEpoch :: Epoch -> Integer
unEpoch :: Epoch -> Integer
unEpoch (Epoch Integer
i) = Integer
i

instance ToCapture (Capture "epoch_number" Epoch) where
  toCapture :: Proxy (Capture "epoch_number" Epoch) -> DocCapture
toCapture Proxy (Capture "epoch_number" Epoch)
_ = String -> String -> DocCapture
DocCapture String
"epoch_number" String
"Epoch for specific epoch slot."

instance ToSample Epoch where
    toSamples :: Proxy Epoch -> [(Text, Epoch)]
toSamples = [(Text, Epoch)] -> Proxy Epoch -> [(Text, Epoch)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, Epoch)] -> Proxy Epoch -> [(Text, Epoch)])
-> [(Text, Epoch)] -> Proxy Epoch -> [(Text, Epoch)]
forall a b. (a -> b) -> a -> b
$ [Epoch] -> [(Text, Epoch)]
forall a. [a] -> [(Text, a)]
samples [Epoch
425, Epoch
500, Epoch
1200]