haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-29 04:10:24 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Use MonadThrow instead of MonadPlus to preserve error information

Browse Source
This commit is contained in:
Dan Burton 2015-05-05 16:03:28 -07:00
parent 12083fea65
commit 31b66e6fae
1 changed files with 11 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
Types.hs
View File

@ -126,18 +126,24 @@ instance PathPiece StackageExecutable where
data GhcMajorVersion = GhcMajorVersion !Int !Int data GhcMajorVersion = GhcMajorVersion !Int !Int
deriving (Eq) deriving (Eq)
data GhcMajorVersionFailedParse = GhcMajorVersionFailedParse Text
deriving (Show, Typeable)
instance Exception GhcMajorVersionFailedParse
ghcMajorVersionToText :: GhcMajorVersion -> Text ghcMajorVersionToText :: GhcMajorVersion -> Text
ghcMajorVersionToText (GhcMajorVersion a b) ghcMajorVersionToText (GhcMajorVersion a b)
= LText.toStrict = LText.toStrict
$ Builder.toLazyText $ Builder.toLazyText
$ Builder.decimal a <> "." <> Builder.decimal b $ Builder.decimal a <> "." <> Builder.decimal b
ghcMajorVersionFromText :: MonadPlus m => Text -> m GhcMajorVersion ghcMajorVersionFromText :: MonadThrow m => Text -> m GhcMajorVersion
ghcMajorVersionFromText t = case Reader.decimal t of ghcMajorVersionFromText t = case Reader.decimal t of
Right (a, T.uncons -> Just ('.', t')) -> case Reader.decimal t' of Right (a, T.uncons -> Just ('.', t')) -> case Reader.decimal t' of
Right (b, t'') | T.null t'' -> return $ GhcMajorVersion a b Right (b, t'') | T.null t'' -> return $ GhcMajorVersion a b
_ -> mzero _ -> failedParse
_ -> mzero _ -> failedParse
where
failedParse = throwM $ GhcMajorVersionFailedParse t
instance PersistFieldSql GhcMajorVersion where instance PersistFieldSql GhcMajorVersion where
sqlType = sqlType . liftM ghcMajorVersionToText sqlType = sqlType . liftM ghcMajorVersionToText
@ -154,7 +160,8 @@ instance Hashable GhcMajorVersion where
hashWithSalt = hashUsing ghcMajorVersionToText hashWithSalt = hashUsing ghcMajorVersionToText
instance FromJSON GhcMajorVersion where instance FromJSON GhcMajorVersion where
parseJSON = withText "GhcMajorVersion" ghcMajorVersionFromText parseJSON = withText "GhcMajorVersion" $
either (fail . show) return . ghcMajorVersionFromText
instance ToJSON GhcMajorVersion where instance ToJSON GhcMajorVersion where
toJSON = toJSON . ghcMajorVersionToText toJSON = toJSON . ghcMajorVersionToText