FileCache.hs

{-# LANGUAGE Rank2Types #-}

module Descript.Build.Cache.FileCache
  ( FileVersion
  , FileCache (..)
  , FileUpdate (..)
  , newFileCache
  , dateFileCache
  , updateFileCache
  , prepareFileCache
  ) where

import Descript.Build.Cache.PhaseCache
import qualified Descript.Sugar as Sugar
import qualified Descript.BasicInj as BasicInj
import qualified Descript.Free as Free
import qualified Descript.Lex as Lex
import Descript.Misc
import Core.Data.Functor
import Data.Text (Text)

{- -- | Annotation for a cached node.
data CacheAnn
  = CacheAnn
  { cacheAnnUpdated :: Bool
  , cacheAnnSrc :: SrcAnn
  } -}

type FileVersion = Int

-- | Contains cached ASTs for a single file.
--
-- These ASTs are annotated with ranges, not full source info, because
-- they're in sync, so by definition they can't be tainted (maybe in the
-- future, when they need to be updated, the parts which need to be
-- updated will be "tainted", but might just make 'CacheAnn' instead).
data FileCache
  = FileCache
  { fileVersion :: FileVersion
  , srcText :: PhaseCache Text
  , srcLex :: PhaseCache [Lex.Lex Range]
  , srcFree :: PhaseCache [Free.TopLevel Range]
  , srcSugar :: PhaseCache (Sugar.Source Range)
  , srcBasicInj :: PhaseCache (BasicInj.DirtyDepd BasicInj.Source Range)
  } deriving (Eq, Ord, Read, Show)

data FileUpdate
  = UpdateText Text (Maybe Patch)
  | UpdateLex [Lex.Lex SrcAnn]
  | UpdateFree [Free.TopLevel SrcAnn]
  | UpdateSugar (Sugar.Source SrcAnn)
  | UpdateBasicInj (BasicInj.DirtyDepd BasicInj.Source SrcAnn)
  deriving (Eq, Ord, Read, Show)

-- | Creates a cache with no data, which needs to be updated.
newFileCache :: FileVersion -> FileCache
newFileCache ver
  = FileCache
  { fileVersion = ver
  , srcText = newPhaseCache
  , srcLex = newPhaseCache
  , srcFree = newPhaseCache
  , srcSugar = newPhaseCache
  , srcBasicInj = newPhaseCache
  }

-- | Signals that every part of the cache needs to be updated, and gives
-- it the new version.
dateFileCache :: FileVersion -> FileCache -> FileCache
dateFileCache nver x
  = FileCache
  { fileVersion = nver
  , srcText = datePhaseCache $ srcText x
  , srcLex = datePhaseCache $ srcLex x
  , srcFree = datePhaseCache $ srcFree x
  , srcSugar = datePhaseCache $ srcSugar x
  , srcBasicInj = datePhaseCache $ srcBasicInj x
  }

-- | Updates the phase in the cache specified by the update.
updateFileCache :: FileUpdate -> FileCache -> FileCache
updateFileCache (UpdateText new _) x
  = x{ srcText = updatePhaseCache new }
updateFileCache (UpdateLex new) x
  = x{ srcLex = updatePhaseCache $ srcRange <<$>> new }
updateFileCache (UpdateFree new) x
  = x{ srcFree = updatePhaseCache $ srcRange <<$>> new }
updateFileCache (UpdateSugar new) x
  = x{ srcSugar = updatePhaseCache $ srcRange <$> new }
updateFileCache (UpdateBasicInj new) x
  = x{ srcBasicInj = updatePhaseCache $ mapDirtyDepdAnn srcRange new }

-- | Modifies phases after the cache to adjust for the given update,
-- without fully updating them.
prepareFileCache :: FileUpdate -> FileCache -> FileCache
prepareFileCache (UpdateText _ patchOpt)
  = case patchOpt of
         Nothing -> invalidateCacheASTs
         Just patch -> alignCacheASTs patch
prepareFileCache _ = id

invalidateCacheASTs :: FileCache -> FileCache
invalidateCacheASTs cache
  = FileCache
  { fileVersion = fileVersion cache
  , srcText = srcText cache
  , srcLex = newPhaseCache
  , srcFree = newPhaseCache
  , srcSugar = newPhaseCache
  , srcBasicInj = newPhaseCache
  }

alignCacheASTs :: Patch -> FileCache -> FileCache
alignCacheASTs patch cache
  = FileCache
  { fileVersion = fileVersion cache
  , srcText = srcText cache
  , srcLex = alignRange patch <<<$>>> srcLex cache
  , srcFree = alignRange patch <<<$>>> srcFree cache
  , srcSugar = alignRange patch <<$>> srcSugar cache
  , srcBasicInj = mapDirtyDepdAnn (alignRange patch) <$> srcBasicInj cache
  }