haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Some minor cleanups

Browse Source
This commit is contained in:
Michael Snoyman 2010-04-20 16:45:02 -07:00
parent e8812472c0
commit dcf9208cf5
4 changed files with 9 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
Yesod/Dispatch.hs
View File

@ -58,13 +58,13 @@ explodeHandler a b c d e f _ _ = runHandler a b (Just c) d e f
mkYesodGeneral :: String -> [Name] -> Bool -> [Resource] -> Q [Dec] mkYesodGeneral :: String -> [Name] -> Bool -> [Resource] -> Q [Dec]
mkYesodGeneral name clazzes isSub res = do mkYesodGeneral name clazzes isSub res = do
let name' = mkName name let name' = mkName name
let tySyn = TySynInstD ''Routes [ConT $ name'] (ConT $ mkName $ name ++ "Routes") let tySyn = TySynInstD ''Routes [ConT name'] (ConT $ mkName $ name ++ "Routes")
let site = mkName $ "site" ++ name let site = mkName $ "site" ++ name
let gsbod = NormalB $ VarE site let gsbod = NormalB $ VarE site
let yes' = FunD (mkName "getSite") [Clause [] gsbod []] let yes' = FunD (mkName "getSite") [Clause [] gsbod []]
let yes = InstanceD [] (ConT ''YesodSite `AppT` ConT name') [yes'] let yes = InstanceD [] (ConT ''YesodSite `AppT` ConT name') [yes']
explode <- [|explodeHandler|] explode <- [|explodeHandler|]
CreateRoutesResult x _ z <- createRoutes $ CreateRoutesSettings CreateRoutesResult x _ z <- createRoutes CreateRoutesSettings
{ crRoutes = mkName $ name ++ "Routes" { crRoutes = mkName $ name ++ "Routes"
, crApplication = ConT ''YesodApp , crApplication = ConT ''YesodApp
, crArgument = ConT $ mkName name , crArgument = ConT $ mkName name
@ -85,11 +85,11 @@ mkYesodGeneral name clazzes isSub res = do
`AppT` murl `AppT` murl
`AppT` master `AppT` master
let ctx = if isSub let ctx = if isSub
then map (\c -> ClassP c [master]) clazzes then map (flip ClassP [master]) clazzes
else [] else []
tvs = if isSub then [PlainTV $ mkName "master"] else [] tvs = [PlainTV $ mkName "master" | isSub]
let y' = SigD site $ ForallT tvs ctx yType let y' = SigD site $ ForallT tvs ctx yType
return $ (if isSub then id else (:) yes) $ [y', z, tySyn, x] return $ (if isSub then id else (:) yes) [y', z, tySyn, x]
toWaiApp :: Yesod y => y -> IO W.Application toWaiApp :: Yesod y => y -> IO W.Application
toWaiApp a = do toWaiApp a = do

4
Yesod/Form.hs
View File

@ -45,7 +45,7 @@ instance Functor Form where
instance Applicative Form where instance Applicative Form where
pure x = Form $ \_ -> Right (Nothing, x) pure x = Form $ \_ -> Right (Nothing, x)
(Form f') <*> (Form x') = Form $ \l -> case (f' l, x' l) of (Form f') <*> (Form x') = Form $ \l -> case (f' l, x' l) of
(Right (_, f), Right (_, x)) -> Right $ (Nothing, f x) (Right (_, f), Right (_, x)) -> Right (Nothing, f x)
(Left e1, Left e2) -> Left $ e1 ++ e2 (Left e1, Left e2) -> Left $ e1 ++ e2
(Left e, _) -> Left e (Left e, _) -> Left e
(_, Left e) -> Left e (_, Left e) -> Left e
@ -75,7 +75,7 @@ runFormGet f = do
runFormGeneric (getParams rr) f runFormGeneric (getParams rr) f
input :: ParamName -> Form [ParamValue] input :: ParamName -> Form [ParamValue]
input pn = Form $ \l -> Right $ (Just pn, l pn) input pn = Form $ \l -> Right (Just pn, l pn)
applyForm :: (x -> Either FormError y) -> Form x -> Form y applyForm :: (x -> Either FormError y) -> Form x -> Form y
applyForm f (Form x') = applyForm f (Form x') =

2
Yesod/Handler.hs
View File

@ -155,7 +155,7 @@ runHandler handler mrender sroute tomr ma tosa = YesodApp $ \eh rr cts -> do
InternalError InternalError
. (show :: Control.Exception.SomeException -> String) . (show :: Control.Exception.SomeException -> String)
(headers, contents) <- Control.Exception.catch (headers, contents) <- Control.Exception.catch
(unHandler handler $ HandlerData (unHandler handler HandlerData
{ handlerRequest = rr { handlerRequest = rr
, handlerSub = tosa ma , handlerSub = tosa ma
, handlerMaster = ma , handlerMaster = ma

4
Yesod/Helpers/Auth.hs
View File

@ -160,9 +160,7 @@ getDisplayName :: Rpxnow.Identifier -> String
getDisplayName (Rpxnow.Identifier ident extra) = helper choices where getDisplayName (Rpxnow.Identifier ident extra) = helper choices where
choices = ["verifiedEmail", "email", "displayName", "preferredUsername"] choices = ["verifiedEmail", "email", "displayName", "preferredUsername"]
helper [] = ident helper [] = ident
helper (x:xs) = case lookup x extra of helper (x:xs) = fromMaybe (helper xs) $ lookup x extra
Nothing -> helper xs
Just y -> y
getCheck :: Yesod master => GHandler Auth master RepHtmlJson getCheck :: Yesod master => GHandler Auth master RepHtmlJson
getCheck = do getCheck = do