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

-- | Directory structure for CIDs and other identifiers
--
-- Examples:
--
-- > Content "abcdef"
--
-- > show $ Directory [(Key "abcdef", Stub "myfile.txt")])]
-- "abcdef/myfile.txt"
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