module Network.IPFS.SparseTree.Types
( SparseTree (..)
, Tag (..)
) where
import qualified Data.Aeson.KeyMap as Aeson.KeyMap
import qualified Data.Aeson.Key as Aeson.Key
import qualified RIO.Map as Map
import qualified RIO.Text as Text
import Data.Swagger hiding (Tag, name)
import Servant.API
import Network.IPFS.CID.Types
import qualified Network.IPFS.Internal.UTF8 as UTF8
import Network.IPFS.Name.Types
import Network.IPFS.Prelude
data SparseTree
= Stub Name
| Content CID
| Directory (Map Tag SparseTree)
deriving ( SparseTree -> SparseTree -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SparseTree -> SparseTree -> Bool
$c/= :: SparseTree -> SparseTree -> Bool
== :: SparseTree -> SparseTree -> Bool
$c== :: SparseTree -> SparseTree -> Bool
Eq
, forall x. Rep SparseTree x -> SparseTree
forall x. SparseTree -> Rep SparseTree x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SparseTree x -> SparseTree
$cfrom :: forall x. SparseTree -> Rep SparseTree x
Generic
, Int -> SparseTree -> ShowS
[SparseTree] -> ShowS
SparseTree -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SparseTree] -> ShowS
$cshowList :: [SparseTree] -> ShowS
show :: SparseTree -> String
$cshow :: SparseTree -> String
showsPrec :: Int -> SparseTree -> ShowS
$cshowsPrec :: Int -> SparseTree -> ShowS
Show
)
instance ToSchema SparseTree where
declareNamedSchema :: Proxy SparseTree -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy SparseTree
_ =
forall a. Monoid a => a
mempty
forall a b. a -> (a -> b) -> b
|> forall s a. HasType s a => Lens' s a
type_ forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall (t :: SwaggerKind (*)). SwaggerType t
SwaggerString
forall a b. a -> (a -> b) -> b
|> forall s a. HasDescription s a => Lens' s a
description forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"A tree of IPFS paths"
forall a b. a -> (a -> b) -> b
|> forall s a. HasExample s a => Lens' s a
example forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. ToJSON a => a -> Value
toJSON (Map Tag SparseTree -> SparseTree
Directory [(Name -> Tag
Key Name
"abcdef", Name -> SparseTree
Stub Name
"myfile.txt")])
forall a b. a -> (a -> b) -> b
|> Maybe Text -> Schema -> NamedSchema
NamedSchema (forall a. a -> Maybe a
Just Text
"IPFSTree")
forall a b. a -> (a -> b) -> b
|> forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance Display (Map Tag SparseTree) where
display :: Map Tag SparseTree -> Utf8Builder
display Map Tag SparseTree
sparseMap =
Utf8Builder
"{" forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Utf8Builder
e Utf8Builder
acc -> Utf8Builder
e forall a. Semigroup a => a -> a -> a
<> Utf8Builder
", " forall a. Semigroup a => a -> a -> a
<> Utf8Builder
acc) Utf8Builder
"}" (forall {a} {a}. (Display a, Display a) => (a, a) -> Utf8Builder
prettyKV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
Map.toList Map Tag SparseTree
sparseMap)
where
prettyKV :: (a, a) -> Utf8Builder
prettyKV (a
k, a
v) = forall a. Display a => a -> Utf8Builder
display a
k forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" => " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display a
v
instance Display SparseTree where
display :: SparseTree -> Utf8Builder
display = \case
Stub Name
name -> forall a. Display a => a -> Utf8Builder
display Name
name
Content CID
cid -> forall a. Display a => a -> Utf8Builder
display CID
cid
Directory Map Tag SparseTree
dir -> forall a. Display a => a -> Utf8Builder
display Map Tag SparseTree
dir
instance ToJSON SparseTree where
toJSON :: SparseTree -> Value
toJSON = \case
Stub (Name String
name) -> Text -> Value
String forall a b. (a -> b) -> a -> b
<| String -> Text
Text.pack String
name
Content (CID Text
cid) -> Text -> Value
String forall a b. (a -> b) -> a -> b
<| Natural -> Text -> Text
UTF8.stripN Natural
1 Text
cid
Directory Map Tag SparseTree
dirMap -> Object -> Value
Object forall a b. (a -> b) -> a -> b
<| forall v. [(Key, v)] -> KeyMap v
Aeson.KeyMap.fromList ((Tag, SparseTree) -> (Key, Value)
jsonKV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
Map.toList Map Tag SparseTree
dirMap)
where
jsonKV :: (Tag, SparseTree) -> (Aeson.Key.Key, Value)
jsonKV :: (Tag, SparseTree) -> (Key, Value)
jsonKV (Tag
tag, SparseTree
subtree) = (Tag -> Key
jsonTag Tag
tag, forall a. ToJSON a => a -> Value
toJSON SparseTree
subtree)
jsonTag :: Tag -> Key
jsonTag (Key (Name String
n)) = Text -> Key
Aeson.Key.fromText (String -> Text
Text.pack String
n)
jsonTag (Hash (CID Text
cid)) = Text -> Key
Aeson.Key.fromText (Natural -> Text -> Text
UTF8.stripN Natural
1 Text
cid)
data Tag
= Key Name
| Hash CID
deriving ( Tag -> Tag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c== :: Tag -> Tag -> Bool
Eq
, forall x. Rep Tag x -> Tag
forall x. Tag -> Rep Tag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tag x -> Tag
$cfrom :: forall x. Tag -> Rep Tag x
Generic
, Eq Tag
Tag -> Tag -> Bool
Tag -> Tag -> Ordering
Tag -> Tag -> Tag
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 :: Tag -> Tag -> Tag
$cmin :: Tag -> Tag -> Tag
max :: Tag -> Tag -> Tag
$cmax :: Tag -> Tag -> Tag
>= :: Tag -> Tag -> Bool
$c>= :: Tag -> Tag -> Bool
> :: Tag -> Tag -> Bool
$c> :: Tag -> Tag -> Bool
<= :: Tag -> Tag -> Bool
$c<= :: Tag -> Tag -> Bool
< :: Tag -> Tag -> Bool
$c< :: Tag -> Tag -> Bool
compare :: Tag -> Tag -> Ordering
$ccompare :: Tag -> Tag -> Ordering
Ord
, Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tag] -> ShowS
$cshowList :: [Tag] -> ShowS
show :: Tag -> String
$cshow :: Tag -> String
showsPrec :: Int -> Tag -> ShowS
$cshowsPrec :: Int -> Tag -> ShowS
Show
)
instance Display Tag where
display :: Tag -> Utf8Builder
display (Key Name
name) = forall a. Display a => a -> Utf8Builder
display Name
name
display (Hash CID
cid) = forall a. Display a => a -> Utf8Builder
display CID
cid
instance FromJSON Tag
instance ToJSON Tag where
toJSON :: Tag -> Value
toJSON (Key Name
k) = forall a. ToJSON a => a -> Value
toJSON Name
k
toJSON (Hash CID
h) = forall a. ToJSON a => a -> Value
toJSON CID
h
instance FromJSONKey Tag
instance ToJSONKey Tag
instance ToSchema Tag
instance FromHttpApiData Tag where
parseUrlPiece :: Text -> Either Text Tag
parseUrlPiece Text
txt = Name -> Tag
Key forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromHttpApiData a => Text -> Either Text a
parseUrlPiece Text
txt