{-# LANGUAGE CPP #-}{-# LANGUAGE GeneralizedNewtypeDeriving, RecordWildCards #-}moduleDevelopment.Shake.Internal.Core.Database(Locked ,runLocked ,DatabasePoly ,createDatabase ,mkId ,getValueFromKey ,getIdFromKey ,getKeyValues ,getKeyValueFromId ,getKeyValuesFromId ,setMem ,setDisk ,modifyAllMem )whereimportData.Tuple.ExtraimportData.IORef.ExtraimportGeneral.Intern (Id ,Intern )importDevelopment.Shake.Classes importqualifiedData.HashMap.StrictasMapimportqualifiedGeneral.Intern asInternimportControl.Concurrent.ExtraimportControl.Monad.IO.ClassimportqualifiedGeneral.Ids asIds#if __GLASGOW_HASKELL__ >= 800 && __GLASGOW_HASKELL__ < 808
importControl.Monad.Fail#endif
newtypeLocked a =Locked (IOa )deriving(Functor,Applicative,Monad,MonadIO#if __GLASGOW_HASKELL__ >= 800
,MonadFail#endif
)runLocked::DatabasePoly k v ->Locked b ->IOb runLocked db (Locked act )=withLock(lockdb )act -- | Invariant: The database does not have any cycles where a Key depends on itself.-- Everything is mutable. intern and status must form a bijecttion.-- There may be dangling Id's as a result of version changes.-- Lock is used to prevent any torn updatesdataDatabasePoly k v =Database {lock ::Lock,intern ::IORef(Intern k )-- ^ Key |-> Id mapping,status ::Ids.Ids (k ,v )-- ^ Id |-> (Key, Status) mapping,journal ::Id ->k ->v ->IO()-- ^ Record all changes to status,vDefault ::v }createDatabase::(Eqk ,Hashablek )=>Ids.Ids (k ,v )->(Id ->k ->v ->IO())->v ->IO(DatabasePoly k v )createDatabase status journal vDefault =doxs <-Ids.toList status intern <-newIORef$Intern.fromList [(k ,i )|(i ,(k ,_))<-xs ]lock <-newLockreturnDatabase {..}----------------------------------------------------------------------- SAFE READ-ONLYgetValueFromKey::(Eqk ,Hashablek )=>DatabasePoly k v ->k ->IO(Maybev )getValueFromKey Database {..}k =dois <-readIORefintern caseIntern.lookup k is ofNothing->returnNothingJusti ->fmapsnd<$>Ids.lookup status i -- Returns Nothing only if the Id was serialised previously but then the Id disappearedgetKeyValueFromId::DatabasePoly k v ->Id ->IO(Maybe(k ,v ))getKeyValueFromId Database {..}=Ids.lookup status getKeyValues::DatabasePoly k v ->IO[(k ,v )]getKeyValues Database {..}=Ids.elems status getKeyValuesFromId::DatabasePoly k v ->IO(Map.HashMapId (k ,v ))getKeyValuesFromId Database {..}=Ids.toMap status getIdFromKey::(Eqk ,Hashablek )=>DatabasePoly k v ->IO(k ->MaybeId )getIdFromKey Database {..}=dois <-readIORefintern return$flipIntern.lookup is ----------------------------------------------------------------------- MUTATING-- | Ensure that a Key has a given Id, creating an Id if there is not one alreadymkId::(Eqk ,Hashablek )=>DatabasePoly k v ->k ->Locked Id mkId Database {..}k =liftIO$dois <-readIORefintern caseIntern.lookup k is ofJusti ->returni Nothing->do(is ,i )<-return$Intern.add k is -- make sure to write it into Status first to maintain Database invariantsIds.insert status i (k ,vDefault )writeIORef'intern is returni setMem::DatabasePoly k v ->Id ->k ->v ->Locked ()setMem Database {..}i k v =liftIO$Ids.insert status i (k ,v )modifyAllMem::DatabasePoly k v ->(v ->v )->Locked ()modifyAllMem Database {..}f =liftIO$Ids.forMutate status $secondf setDisk::DatabasePoly k v ->Id ->k ->v ->IO()setDisk =journal