module ContentStore.Resolver
  ( ObjectResolver(..)
  , filesystemResolver
  , cachedFilesystemResolver
  , resolveObjectByHash
  , resolveManifest
  , resolveTree
  ) where

import ContentStore.Alias
import ContentStore.Arboricx
import ContentStore.Filesystem
import ContentStore.Object
import Module.Manifest
import Research (Node(..), T, deserializeNode)
import qualified Research

import Data.ByteString (ByteString)
import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef')
import qualified Data.Map as Map
import qualified Data.Text as T

-- | Object and alias resolution capability. Module/import code should depend on
-- this boundary rather than on a concrete filesystem store. Future resolvers can
-- add trusted remotes, registries, or caches while preserving the same verified
-- content-addressed interface.
data ObjectResolver = ObjectResolver
  { resolverAlias    :: AliasKind -> T.Text -> IO (Maybe ObjectRef)
  , resolverObject   :: ObjectRef -> IO (Maybe ByteString)
  , resolverManifest :: ObjectHash -> IO (Maybe ModuleManifest)
  , resolverTree     :: ObjectHash -> IO (Maybe T)
  }

filesystemResolver :: StorePath -> ObjectResolver
filesystemResolver store = resolver
  where
    resolver = ObjectResolver
      { resolverAlias = readAlias store
      , resolverObject = \ref -> getObject store (objectRefHash ref)
      , resolverManifest = resolveManifestFromObjects resolver
      , resolverTree = resolveTreeFromObjects resolver
      }

cachedFilesystemResolver :: StorePath -> IO ObjectResolver
cachedFilesystemResolver store = do
  objectCache <- newIORef Map.empty
  manifestCache <- newIORef Map.empty
  treeCache <- newIORef Map.empty
  let resolver = ObjectResolver
        { resolverAlias = readAlias store
        , resolverObject = cachedLookup objectCache (\ref -> getObject store (objectRefHash ref))
        , resolverManifest = cachedLookup manifestCache (resolveManifestFromObjects resolver)
        , resolverTree = cachedLookup treeCache (resolveTreeFromObjects resolver)
        }
  return resolver
  where
    cachedLookup :: Ord k => IORef (Map.Map k v) -> (k -> IO v) -> k -> IO v
    cachedLookup ref load key = do
      cache <- readIORef ref
      case Map.lookup key cache of
        Just value -> return value
        Nothing -> do
          value <- load key
          atomicModifyIORef' ref (\m -> (Map.insert key value m, ()))
          return value

resolveObjectByHash :: ObjectResolver -> T.Text -> ObjectHash -> IO (Maybe ByteString)
resolveObjectByHash resolver kind h =
  resolverObject resolver (ObjectRef kind h)

resolveManifest :: ObjectResolver -> ObjectHash -> IO (Maybe ModuleManifest)
resolveManifest = resolverManifest

resolveManifestFromObjects :: ObjectResolver -> ObjectHash -> IO (Maybe ModuleManifest)
resolveManifestFromObjects resolver h = do
  mBytes <- resolveObjectByHash resolver (unDomain manifestDomain) h
  case mBytes of
    Nothing -> return Nothing
    Just bytes -> case decodeManifest bytes of
      Left err -> fail $ "invalid module manifest " ++ T.unpack h ++ ": " ++ err
      Right manifest -> return (Just manifest)

resolveTree :: ObjectResolver -> ObjectHash -> IO (Maybe T)
resolveTree = resolverTree

resolveTreeFromObjects :: ObjectResolver -> ObjectHash -> IO (Maybe T)
resolveTreeFromObjects resolver h = do
  mNode <- resolveNode resolver h
  case mNode of
    Nothing -> return Nothing
    Just node -> hydrate node
  where
    resolveNode r nodeHash = do
      mBytes <- resolveObjectByHash r (unDomain merkleNodeDomain) nodeHash
      case mBytes of
        Nothing -> return Nothing
        Just bytes -> return (Just (deserializeNode bytes))

    hydrate NLeaf = return (Just Research.Leaf)
    hydrate (NStem child) = fmap Research.Stem <$> hydrateHash child
    hydrate (NFork left right) = do
      l <- hydrateHash left
      r <- hydrateHash right
      return $ Research.Fork <$> l <*> r

    hydrateHash nodeHash = do
      mChild <- resolveNode resolver nodeHash
      case mChild of
        Nothing -> return Nothing
        Just child -> hydrate child