{-# LANGUAGE RecordWildCards, TupleSections #-}moduleDevelopment.Shake.Internal.History.Shared(Shared ,newShared ,addShared ,lookupShared )whereimportDevelopment.Shake.Internal.Value importDevelopment.Shake.Internal.History.Types importDevelopment.Shake.Classes importGeneral.Binary importGeneral.Extra importGeneral.Chunks importControl.Monad.ExtraimportSystem.FilePathimportSystem.DirectoryimportSystem.IOimportNumericimportDevelopment.Shake.Internal.FileInfo importGeneral.Wait importDevelopment.Shake.Internal.FileName importData.MonoidimportData.FunctorimportControl.Monad.IO.ClassimportData.MaybeimportqualifiedData.ByteStringasBSimportPrelude{-
#ifndef mingw32_HOST_OS
import System.Posix.Files(createLink)
#else
import Foreign.Ptr
import Foreign.C.Types
import Foreign.C.String
#ifdef x86_64_HOST_ARCH
#define CALLCONV ccall
#else
#define CALLCONV stdcall
#endif
foreign import CALLCONV unsafe "Windows.h CreateHardLinkW" c_CreateHardLinkW :: Ptr CWchar -> Ptr CWchar -> Ptr () -> IO Bool
createLink :: FilePath -> FilePath -> IO ()
createLink from to = withCWString from $ \cfrom -> withCWString to $ \cto -> do
 res <- c_CreateHardLinkW cfrom cto nullPtr
 unless res $ error $ show ("Failed to createLink", from, to)
#endif
-}dataShared =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 )->docreateDirectoryRecursive $takeDirectoryfile copyFile(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 )->-- FIXME: should use a combination of symlinks and making files read-onlyunlessM(doesFileExist_ $dir </>showhash )$copyFilefile (dir </>showhash )addShared::Shared ->Key ->Ver ->Ver ->[[(Key ,BS_Identity )]]->BS_Store ->[FilePath]->IO()addShared shared entryKey entryBuiltinVersion entryUserVersion entryDepends entryResult files =dohashes <-mapM(getFileHash .fileNameFromString )files saveSharedEntry shared Entry {entryFiles=zipfiles hashes ,entryGlobalVersion=globalVersionshared ,..}