{-# 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 }