mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-26 13:14:52 +09:00
fix: prevent panic on parse error in repo page
This commit is contained in:
parent
8c7ed627b6
commit
284b4a8d81
1 changed files with 20 additions and 1 deletions
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue