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