diff --git a/src/Data/Git/Local.hs b/src/Data/Git/Local.hs index 8c809db..c5ef8da 100644 --- a/src/Data/Git/Local.hs +++ b/src/Data/Git/Local.hs @@ -50,6 +50,9 @@ import qualified Data.Text.IO as TIO import Data.EventTime.Local import Data.Hourglass.Local () +import Data.Traversable (for) +import Data.Git.Storage (getObjectType) + instance SpecToEventTime GitTime where specToEventTime = specToEventTime . gitTimeUTC specsToEventTimes = specsToEventTimes . fmap gitTimeUTC @@ -129,6 +132,22 @@ data PathView | TreeView Text ObjId TreeRows | BlobView Text ObjId BL.ByteString +-- | FIXME: lib/hit-harder/src/Data/Git/Harder.hs with error handling +viewTree' :: Git SHA1 -> Tree SHA1 -> IO [(ModePerm, ObjId, EntName, Bool)] +viewTree' git tree = for (treeGetEnts tree) $ \ (perm, name, ref) -> do + -- Handle error when evaluating the returned "Either" value + -- The Left value contains an (error "...") call + let invalidEntryHandler :: ErrorCall -> IO Bool + -- Assume invalid entry as Blob + invalidEntryHandler = \_ -> return False + isTree <- handle invalidEntryHandler $ do + mtype <- getObjectType git ref + case mtype of + Just TypeTree -> return True + _ -> return False + -- Return entry + return (perm, ObjId ref, name, isTree) + viewPath :: Git SHA1 -> Tree SHA1 -> EntPath -> IO PathView viewPath git root path = do let toEnt False = EntObjBlob @@ -136,7 +155,7 @@ viewPath git root path = do toText = decodeUtf8With lenientDecode . getEntNameBytes adapt (perm, oid, name, isTree) = (perm, oid, toText name, toEnt isTree) - mkRows t = map adapt <$> viewTree git t + mkRows t = map adapt <$> viewTree' git t -- FIXME mno <- resolveTreePath git root path case mno of Nothing -> RootView <$> mkRows root