module Network.IPFS.SparseTree
  ( SparseTree (..)
  , Error.Linearization (..)
  , linearize
  , cIDs
  ) where

import           Network.IPFS.Prelude
import qualified Network.IPFS.Internal.UTF8 as UTF8
import qualified Network.IPFS.Error    as Error

import           Network.IPFS.CID.Types
import           Network.IPFS.Name.Types
import           Network.IPFS.Path.Types
import           Network.IPFS.SparseTree.Types

linearize :: SparseTree -> Either Error.Linearization Path
linearize :: SparseTree -> Either Linearization Path
linearize = (Text -> Path)
-> Either Linearization Text -> Either Linearization Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Path
Path (Either Linearization Text -> Either Linearization Path)
-> (SparseTree -> Either Linearization Text)
-> SparseTree
-> Either Linearization Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SparseTree -> Either Linearization Text
go
  where
  go :: SparseTree -> Either Error.Linearization Text
  go :: SparseTree -> Either Linearization Text
go = \case
    Stub      (Name String
name)    -> Text -> Either Linearization Text
forall a b. b -> Either a b
Right (Text -> Either Linearization Text)
-> Text -> Either Linearization Text
forall a b. (a -> b) -> a -> b
<| String -> Text
forall a. Show a => a -> Text
UTF8.textShow String
name
    Content   (CID Text
_)        -> Text -> Either Linearization Text
forall a b. b -> Either a b
Right Text
""
    Directory [(tag, value)] -> Tag -> Text -> Text
fromPath Tag
tag (Text -> Text)
-> Either Linearization Text -> Either Linearization Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SparseTree -> Either Linearization Text
go SparseTree
value
    SparseTree
badDir                   -> Linearization -> Either Linearization Text
forall a b. a -> Either a b
Left (Linearization -> Either Linearization Text)
-> Linearization -> Either Linearization Text
forall a b. (a -> b) -> a -> b
<| SparseTree -> Linearization
Error.NonLinear SparseTree
badDir
    where
      fromPath :: Tag -> Text -> Text
fromPath Tag
tag Text
""   = Tag -> Text
fromKey Tag
tag
      fromPath Tag
tag Text
text = Tag -> Text
fromKey Tag
tag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text

      fromKey :: Tag -> Text
      fromKey :: Tag -> Text
fromKey = Natural -> Text -> Text
UTF8.stripN Natural
1 (Text -> Text) -> (Tag -> Text) -> Tag -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        Hash (CID Text
cid)   -> Text
cid
        Key  (Name String
name) -> String -> Text
forall a. Show a => a -> Text
UTF8.textShow String
name

-- | Get all CIDs from a 'SparseTree' (all levels)
cIDs :: (Monoid (f CID), Applicative f) => SparseTree -> f CID
cIDs :: SparseTree -> f CID
cIDs (Stub Name
_)       = f CID
forall a. Monoid a => a
mempty
cIDs (Content CID
cid)  = CID -> f CID
forall (f :: * -> *) a. Applicative f => a -> f a
pure CID
cid
cIDs (Directory Map Tag SparseTree
kv) = (SparseTree -> f CID) -> Map Tag SparseTree -> f CID
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SparseTree -> f CID
forall (f :: * -> *).
(Monoid (f CID), Applicative f) =>
SparseTree -> f CID
cIDs Map Tag SparseTree
kv