17008e8 · obelisk · git.iko.soy

git.iko.soy/obelisk

on master help sign in

Fix readThunk to ignore other checks when a thunk is checked out

17008e83noch6 years ago

lib/command/src/Obelisk/Command/Thunk.hs+33−40

compare with master

unifiedsplit

@@ -26,9 +26,8 @@ import qualified Data.ByteString.Lazy as LBS

26import Data.Containers.ListUtils (nubOrd)

27import Data.Default

28import Data.Either.Combinators (fromRight', rightToMaybe)

29−import Data.Foldable (toList)

29+import Data.Foldable (for_, toList)

30import Data.Function ((&))

31−import Data.Functor ((<&>))

32import Data.Git.Ref (Ref)

31import Data.Git.Ref (Ref)

33import qualified Data.Git.Ref as Ref

32import qualified Data.Git.Ref as Ref

34import qualified Data.List as L

33import qualified Data.List as L

@@ -238,35 +237,38 @@ matchThunkSpecToDir

238 -> Set FilePath -- ^ Set of file paths relative to the given directory

237 -> Set FilePath -- ^ Set of file paths relative to the given directory

239 -> m ThunkData

238 -> m ThunkData

240matchThunkSpecToDir thunkSpec dir dirFiles = do

239matchThunkSpecToDir thunkSpec dir dirFiles = do

240+ isCheckout <- fmap or $ flip Map.traverseWithKey (_thunkSpec_files thunkSpec) $ \expectedPath -> \case

241+ ThunkFileSpec_CheckoutIndicator -> liftIO (doesDirectoryExist (dir </> expectedPath))

242+ _ -> pure False

243+ case isCheckout of

244+ True -> pure ThunkData_Checkout

245+ False -> do

241− case nonEmpty (toList $ dirFiles `Set.difference` expectedPaths) of

246+ for_ (nonEmpty (toList $ dirFiles `Set.difference` expectedPaths)) $ \fs ->

242− Just fs -> throwError $ ReadThunkError_UnrecognizedPaths $ (dir </>) <$> fs

247+ throwError $ ReadThunkError_UnrecognizedPaths $ (dir </>) <$> fs

243− Nothing -> pure ()

244− case nonEmpty (toList $ requiredPaths `Set.difference` dirFiles) of

248+ for_ (nonEmpty (toList $ requiredPaths `Set.difference` dirFiles)) $ \fs ->

245− Just fs -> throwError $ ReadThunkError_MissingPaths $ (dir </>) <$> fs

249+ throwError $ ReadThunkError_MissingPaths $ (dir </>) <$> fs

246− Nothing -> pure ()

247− datas <- fmap toList $ flip Map.traverseMaybeWithKey (_thunkSpec_files thunkSpec) $ \expectedPath -> \case

250+ datas <- fmap toList $ flip Map.traverseMaybeWithKey (_thunkSpec_files thunkSpec) $ \expectedPath -> \case

248− ThunkFileSpec_AttrCache -> Nothing <$ dirMayExist expectedPath

251+ ThunkFileSpec_AttrCache -> Nothing <$ dirMayExist expectedPath

249− ThunkFileSpec_CheckoutIndicator -> liftIO (doesDirectoryExist (dir </> expectedPath)) <&> \case

252+ ThunkFileSpec_CheckoutIndicator -> pure Nothing -- Handled above

250− False -> Nothing

251− True -> Just ThunkData_Checkout

252− ThunkFileSpec_FileMatches expectedContents -> handle (\(e :: IOError) -> throwError $ ReadThunkError_FileError e) $ do

253+ ThunkFileSpec_FileMatches expectedContents -> handle (\(e :: IOError) -> throwError $ ReadThunkError_FileError e) $ do

253− actualContents <- liftIO (T.readFile $ dir </> expectedPath)

254+ actualContents <- liftIO (T.readFile $ dir </> expectedPath)

254− case T.strip expectedContents == T.strip actualContents of

255+ case T.strip expectedContents == T.strip actualContents of

255− True -> pure Nothing

256+ True -> pure Nothing

256− False -> throwError $ ReadThunkError_FileDoesNotMatch (dir </> expectedPath) expectedContents

257+ False -> throwError $ ReadThunkError_FileDoesNotMatch (dir </> expectedPath) expectedContents

257− ThunkFileSpec_Ptr parser -> handle (\(e :: IOError) -> throwError $ ReadThunkError_FileError e) $ do

258+ ThunkFileSpec_Ptr parser -> handle (\(e :: IOError) -> throwError $ ReadThunkError_FileError e) $ do

258− let path = dir </> expectedPath

259+ let path = dir </> expectedPath

259− liftIO (doesFileExist path) >>= \case

260+ liftIO (doesFileExist path) >>= \case

260− False -> pure Nothing

261+ False -> pure Nothing

261− True -> do

262+ True -> do

262− actualContents <- liftIO $ LBS.readFile path

263+ actualContents <- liftIO $ LBS.readFile path

263− case parser actualContents of

264+ case parser actualContents of

264− Right v -> pure $ Just (ThunkData_Packed thunkSpec v)

265+ Right v -> pure $ Just (thunkSpec, v)

265− Left e -> throwError $ ReadThunkError_UnparseablePtr (dir </> expectedPath) e

266+ Left e -> throwError $ ReadThunkError_UnparseablePtr (dir </> expectedPath) e

266−

267+

267− case nonEmpty datas of

268+ uncurry ThunkData_Packed <$> case nonEmpty datas of

268− Nothing -> throwError ReadThunkError_UnrecognizedThunk

269+ Nothing -> throwError ReadThunkError_UnrecognizedThunk

269− Just xs -> fold1WithM xs $ \a b -> either throwError pure (mergeThunkData a b)

270+ Just xs -> fold1WithM xs $ \a@(_, ptrA) (_, ptrB) ->

271+ if ptrA == ptrB then pure a else throwError $ ReadThunkError_AmbiguousPackedState ptrA ptrB

270 where

272 where

271 rootPathsOnly = Set.fromList . mapMaybe takeRootDir . Map.keys

273 rootPathsOnly = Set.fromList . mapMaybe takeRootDir . Map.keys

272 takeRootDir = fmap NonEmpty.head . nonEmpty . splitPath

274 takeRootDir = fmap NonEmpty.head . nonEmpty . splitPath

@@ -282,15 +284,6 @@ matchThunkSpecToDir thunkSpec dir dirFiles = do

282 True -> throwError $ ReadThunkError_UnrecognizedPaths $ expectedPath :| []

284 True -> throwError $ ReadThunkError_UnrecognizedPaths $ expectedPath :| []

283 False -> pure ()

285 False -> pure ()

284

286

285− -- Combine 'ThunkData' from different files, preferring "Checkout" over "Packed"

286− mergeThunkData ThunkData_Checkout ThunkData_Checkout = Right ThunkData_Checkout

287− mergeThunkData ThunkData_Checkout ThunkData_Packed{} = Left bothPackedAndUnpacked

288− mergeThunkData ThunkData_Packed{} ThunkData_Checkout = Left bothPackedAndUnpacked

289− mergeThunkData a@(ThunkData_Packed _ ptrA) (ThunkData_Packed _ ptrB) =

290− if ptrA == ptrB then Right a else Left $ ReadThunkError_AmbiguousPackedState ptrA ptrB

291−

292− bothPackedAndUnpacked = ReadThunkError_UnrecognizedState "Both packed data and checkout present"

293−

294 fold1WithM (x :| xs) f = foldM f x xs

287 fold1WithM (x :| xs) f = foldM f x xs

295

288

296readThunkWith

289readThunkWith