module Network.IPFS.DAG.Link.Types (Link (..)) where

import Network.IPFS.Prelude
import Network.IPFS.Types as IPFS
import Data.Text as T


data Link = Link
  { Link -> CID
cid  :: IPFS.CID
  , Link -> Name
name :: IPFS.Name
  , Link -> Integer
size :: Integer
  } deriving (Int -> Link -> ShowS
[Link] -> ShowS
Link -> String
(Int -> Link -> ShowS)
-> (Link -> String) -> ([Link] -> ShowS) -> Show Link
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Link] -> ShowS
$cshowList :: [Link] -> ShowS
show :: Link -> String
$cshow :: Link -> String
showsPrec :: Int -> Link -> ShowS
$cshowsPrec :: Int -> Link -> ShowS
Show, Link -> Link -> Bool
(Link -> Link -> Bool) -> (Link -> Link -> Bool) -> Eq Link
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Link -> Link -> Bool
$c/= :: Link -> Link -> Bool
== :: Link -> Link -> Bool
$c== :: Link -> Link -> Bool
Eq, (forall x. Link -> Rep Link x)
-> (forall x. Rep Link x -> Link) -> Generic Link
forall x. Rep Link x -> Link
forall x. Link -> Rep Link x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Link x -> Link
$cfrom :: forall x. Link -> Rep Link x
Generic)


instance ToJSON Link where
  toJSON :: Link -> Value
toJSON (Link CID
cid Name
name Integer
size) =
    Object -> Value
Object [ (Text
"Name", Text -> Value
String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
<| Name -> String
unName Name
name)
           , (Text
"Size", Scientific -> Value
Number  (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
<| Integer -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size)
           , (Text
"Cid", Object -> Value
Object [(Text
"/", Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
<| CID -> Text
unaddress CID
cid)])
           ]