{-# LANGUAGE RecordWildCards, TupleSections #-}moduleDevelopment.Shake.Internal.History.Shared(Shared ,newShared ,addShared ,lookupShared ,removeShared ,listShared )whereimportDevelopment.Shake.Internal.Value importDevelopment.Shake.Internal.History.Types importDevelopment.Shake.Internal.History.Symlink importDevelopment.Shake.Internal.Core.Database importDevelopment.Shake.Classes importGeneral.Binary importGeneral.Extra importGeneral.Chunks importControl.Monad.ExtraimportSystem.Directory.ExtraimportSystem.FilePathimportSystem.IOimportNumericimportDevelopment.Shake.Internal.FileInfo importGeneral.Wait importDevelopment.Shake.Internal.FileName importData.MonoidimportControl.Monad.IO.ClassimportData.MaybeimportqualifiedData.ByteStringasBSimportPreludedataShared =Shared {globalVersion ::!Ver ,keyOp ::BinaryOp Key ,sharedRoot ::FilePath}newShared::BinaryOp Key ->Ver ->FilePath->IOShared newShared keyOp globalVersion sharedRoot =returnShared {..}dataEntry =Entry {entryKey ::Key ,entryGlobalVersion ::!Ver ,entryBuiltinVersion ::!Ver ,entryUserVersion ::!Ver ,entryDepends ::[[(Key ,BS_Identity )]],entryResult ::BS_Store ,entryFiles ::[(FilePath,FileHash )]}deriving(Show,Eq)putEntry::BinaryOp Key ->Entry ->Builder putEntry binop Entry {..}=putExStorable entryGlobalVersion <>putExStorable entryBuiltinVersion <>putExStorable entryUserVersion <>putExN (putOpbinop entryKey )<>putExN (putExList $map(putExList .mapputDepend )entryDepends )<>putExN (putExList $mapputFile entryFiles )<>putEx entryResult whereputDepend (a ,b )=putExN (putOpbinop a )<>putEx b putFile (a ,b )=putExStorable b <>putEx a getEntry::BinaryOp Key ->BS.ByteString->Entry getEntry binop x |(x1 ,x2 ,x3 ,x )<-binarySplit3 x ,(x4 ,x )<-getExN x ,(x5 ,x )<-getExN x ,(x6 ,x7 )<-getExN x =Entry {entryGlobalVersion=x1 ,entryBuiltinVersion=x2 ,entryUserVersion=x3 ,entryKey=getOpbinop x4 ,entryDepends=map(mapgetDepend .getExList )$getExList x5 ,entryFiles=mapgetFile $getExList x6 ,entryResult=getEx x7 }wheregetDepend x |(a ,b )<-getExN x =(getOpbinop a ,getEx b )getFile x |(b ,a )<-binarySplit x =(getEx a ,b )sharedFileDir::Shared ->Key ->FilePathsharedFileDir shared key =sharedRootshared </>".shake.cache"</>showHex(abs$hashkey )""loadSharedEntry::Shared ->Key ->Ver ->Ver ->IO[Entry ]loadSharedEntry shared @Shared {..}key builtinVersion userVersion =doletfile =sharedFileDir shared key </>"_key"b <-doesFileExist_ file ifnotb thenreturn[]elsedo(items ,slop )<-withFilefile ReadMode$\h ->readChunksDirect h maxBoundunless(BS.nullslop )$error$"Corrupted key file, "++showfile leteq Entry {..}=entryKey ==key &&entryGlobalVersion ==globalVersion &&entryBuiltinVersion ==builtinVersion &&entryUserVersion ==userVersion return$filtereq $map(getEntry keyOp )items -- | Given a way to get the identity, see if you can a stored cloud versionlookupShared::Shared ->(Key ->Wait Locked (MaybeBS_Identity ))->Key ->Ver ->Ver ->Wait Locked (Maybe(BS_Store ,[[Key ]],IO()))lookupShared shared ask key builtinVersion userVersion =doents <-liftIO$loadSharedEntry shared key builtinVersion userVersion flipfirstJustWaitUnordered ents $\Entry {..}->do-- use Nothing to indicate success, Just () to bail out early on mismatchletresult x =ifisJustx thenNothingelseJust$(entryResult ,map(mapfst)entryDepends ,)$doletdir =sharedFileDir shared entryKey forM_entryFiles $\(file ,hash )->copyFileLink (dir </>showhash )file result <$>firstJustMid[firstJustWaitUnordered id[test <$>ask k |(k ,i1 )<-kis ,lettest =maybe(Just())(\i2 ->ifi1 ==i2 thenNothingelseJust())]|kis <-entryDepends ]saveSharedEntry::Shared ->Entry ->IO()saveSharedEntry shared entry =doletdir =sharedFileDir shared (entryKeyentry )createDirectoryRecursive dir withFile(dir </>"_key")AppendMode$\h ->writeChunkDirect h $putEntry (keyOpshared )entry forM_(entryFilesentry )$\(file ,hash )->unlessM(doesFileExist_ $dir </>showhash )$copyFileLink file (dir </>showhash )addShared::Shared ->Key ->Ver ->Ver ->[[(Key ,BS_Identity )]]->BS_Store ->[FilePath]->IO()addShared shared entryKey entryBuiltinVersion entryUserVersion entryDepends entryResult files =dofiles <-mapM(\x ->(x ,)<$>getFileHash (fileNameFromString x ))files saveSharedEntry shared Entry {entryFiles=files ,entryGlobalVersion=globalVersionshared ,..}removeShared::Shared ->(Key ->Bool)->IO()removeShared Shared {..}test =dodirs <-listDirectories$sharedRoot </>".shake.cache"deleted <-forMdirs $\dir ->do(items ,_slop )<-withFile(dir </>"_key")ReadMode$\h ->readChunksDirect h maxBound-- if any key matches, clean them all outletb =any(test .entryKey.getEntry keyOp )items whenb $removeDirectoryRecursivedir returnb liftIO$putStrLn$"Deleted "++show(length(filteriddeleted ))++" entries"listShared::Shared ->IO()listShared Shared {..}=dodirs <-listDirectories$sharedRoot </>".shake.cache"forM_dirs $\dir ->doputStrLn$"Directory: "++dir (items ,_slop )<-withFile(dir </>"_key")ReadMode$\h ->readChunksDirect h maxBoundforM_items $\item ->doletEntry {..}=getEntry keyOp item putStrLn$" Key: "++showentryKey forM_entryFiles $\(file ,_)->putStrLn$" File: "++file