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

Cleaned up a good bit of Yesod.Resource

Browse Source
This commit is contained in:
Michael Snoyman 2009-12-17 18:33:00 +02:00
parent f5cb44bff1
commit ac450c9513
2 changed files with 163 additions and 116 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

276
Yesod/Resource.hs
View File

@ -43,7 +43,7 @@ import Data.Typeable (Typeable)
import Control.Exception (Exception) import Control.Exception (Exception)
import Data.Attempt -- for failure stuff import Data.Attempt -- for failure stuff
import Data.Object.Text import Data.Object.Text
import Control.Monad ((<=<)) import Control.Monad ((<=<), unless)
import Data.Object.Yaml import Data.Object.Yaml
import Yesod.Handler import Yesod.Handler
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
@ -52,6 +52,7 @@ import Yesod.Rep hiding (testSuite)
#else #else
import Yesod.Rep import Yesod.Rep
#endif #endif
import Control.Arrow
#if TEST #if TEST
import Control.Monad (replicateM) import Control.Monad (replicateM)
@ -63,10 +64,16 @@ import Test.QuickCheck
import Control.Monad (when) import Control.Monad (when)
#endif #endif
resources :: QuasiQuoter
resources = QuasiQuoter (strToExp True) undefined
resourcesNoCheck :: QuasiQuoter
resourcesNoCheck = QuasiQuoter (strToExp False) undefined
-- | Resource Pattern Piece -- | Resource Pattern Piece
data RPP = data RPP =
Static String Static String
| Dynamic String | DynStr String
| DynInt String | DynInt String
| Slurp String -- ^ take up the rest of the pieces. must be last | Slurp String -- ^ take up the rest of the pieces. must be last
deriving (Eq, Show) deriving (Eq, Show)
@ -79,76 +86,96 @@ isSlurp :: RPP -> Bool
isSlurp (Slurp _) = True isSlurp (Slurp _) = True
isSlurp _ = False isSlurp _ = False
instance ConvertSuccess String RP where data InvalidResourcePattern =
convertSuccess = RP . map helper . filter (not . null) .splitOn "/" SlurpNotLast String
where | EmptyResourcePatternPiece String
helper :: String -> RPP deriving (Show, Typeable)
helper ('$':rest) = Dynamic rest instance Exception InvalidResourcePattern
helper ('*':rest) = Slurp rest readRP :: MonadFailure InvalidResourcePattern m
helper ('#':rest) = DynInt rest => ResourcePattern
helper x = Static x -> m RP
readRP "" = return $ RP []
readRP "/" = return $ RP []
readRP rps = fmap RP $ helper $ splitOn "/" $ correct rps where
correct = correct1 . correct2 where
correct1 ('/':rest) = rest
correct1 x = x
correct2 x
| null x = x
| last x == '/' = init x
| otherwise = x
helper [] = return []
helper (('$':name):rest) = do
rest' <- helper rest
return $ DynStr name : rest'
helper (('#':name):rest) = do
rest' <- helper rest
return $ DynInt name : rest'
helper (('*':name):rest) = do
rest' <- helper rest
unless (null rest') $ failure $ SlurpNotLast rps
return $ Slurp name : rest'
helper ("":_) = failure $ EmptyResourcePatternPiece rps
helper (name:rest) = do
rest' <- helper rest
return $ Static name : rest'
instance ConvertSuccess RP String where instance ConvertSuccess RP String where
convertSuccess = concatMap helper . unRP where convertSuccess = concatMap helper . unRP where
helper (Static s) = '/' : s helper (Static s) = '/' : s
helper (Dynamic s) = '/' : '$' : s helper (DynStr s) = '/' : '$' : s
helper (Slurp s) = '/' : '*' : s helper (Slurp s) = '/' : '*' : s
helper (DynInt s) = '/' : '#' : s helper (DynInt s) = '/' : '#' : s
type ResourcePattern = String type ResourcePattern = String
data CheckPatternReturn = -- | Determing whether the given resource fits the resource pattern.
StaticMatch doesPatternMatch :: RP -> Resource -> Bool
| DynamicMatch (String, String) doesPatternMatch rp r = case doPatternPiecesMatch (unRP rp) r of
| DynIntMatch (String, Int)
| NoMatch
checkPatternBool :: RP -> Resource -> Bool
checkPatternBool rp r = case checkPattern rp r of
Nothing -> False Nothing -> False
_ -> True _ -> True
checkPatternUP :: RP -> Resource -> [UrlParam] -- | Extra the 'UrlParam's from a resource known to match the given 'RP'. This
checkPatternUP rp r = map snd $ fromJust (checkPattern rp r) -- is a partial function.
paramsFromMatchingPattern :: RP -> Resource -> [UrlParam]
paramsFromMatchingPattern rp =
map snd . fromJust . doPatternPiecesMatch (unRP rp)
checkPattern :: RP -> Resource -> Maybe [(String, UrlParam)] doPatternPiecesMatch :: MonadFailure NoMatch m
checkPattern = checkPatternPieces . unRP => [RPP]
-> Resource
checkPatternPieces :: [RPP] -> Resource -> Maybe [(String, UrlParam)] -> m [(String, UrlParam)]
checkPatternPieces rp r doPatternPiecesMatch rp r
| not (null rp) && isSlurp (last rp) = do | not (null rp) && isSlurp (last rp) = do
let rp' = init rp let rp' = init rp
(r1, r2) = splitAt (length rp') r (r1, r2) = splitAt (length rp') r
smap <- checkPatternPieces rp' r1 smap <- doPatternPiecesMatch rp' r1
let Slurp slurpKey = last rp let Slurp slurpKey = last rp
return $ (slurpKey, SlurpParam r2) : smap return $ (slurpKey, SlurpParam r2) : smap
| length rp /= length r = Nothing | length rp /= length r = failure NoMatch
| otherwise = combine [] $ zipWith checkPattern' rp r | otherwise = concat `fmap` sequence (zipWith doesPatternPieceMatch rp r)
checkPattern' :: RPP -> String -> CheckPatternReturn data NoMatch = NoMatch
checkPattern' (Static x) y = if x == y then StaticMatch else NoMatch doesPatternPieceMatch :: MonadFailure NoMatch m
checkPattern' (Dynamic x) y = DynamicMatch (x, y) => RPP
checkPattern' (Slurp x) _ = error $ "Slurp pattern " ++ x ++ " must be last" -> String
checkPattern' (DynInt x) y -> m [(String, UrlParam)]
| all isDigit y = DynIntMatch (x, read y) doesPatternPieceMatch (Static x) y = if x == y then return [] else failure NoMatch
| otherwise = NoMatch doesPatternPieceMatch (DynStr x) y = return [(x, StringParam y)]
doesPatternPieceMatch (Slurp x) _ = error $ "Slurp pattern " ++ x ++ " must be last"
combine :: [(String, UrlParam)] doesPatternPieceMatch (DynInt x) y
-> [CheckPatternReturn] | all isDigit y = return [(x, IntParam $ read y)]
-> Maybe [(String, UrlParam)] | otherwise = failure NoMatch
combine s [] = Just $ reverse s
combine _ (NoMatch:_) = Nothing
combine s (StaticMatch:rest) = combine s rest
combine s (DynamicMatch (x, y):rest) = combine ((x, StringParam y):s) rest
combine s (DynIntMatch (x, y):rest) = combine ((x, IntParam y):s) rest
-- | Determine if two resource patterns can lead to an overlap (ie, they can
-- both match a single resource).
overlaps :: [RPP] -> [RPP] -> Bool overlaps :: [RPP] -> [RPP] -> Bool
overlaps [] [] = True overlaps [] [] = True
overlaps [] _ = False overlaps [] _ = False
overlaps _ [] = False overlaps _ [] = False
overlaps (Slurp _:_) _ = True overlaps (Slurp _:_) _ = True
overlaps _ (Slurp _:_) = True overlaps _ (Slurp _:_) = True
overlaps (Dynamic _:x) (_:y) = overlaps x y overlaps (DynStr _:x) (_:y) = overlaps x y
overlaps (_:x) (Dynamic _:y) = overlaps x y overlaps (_:x) (DynStr _:y) = overlaps x y
overlaps (DynInt _:x) (DynInt _:y) = overlaps x y overlaps (DynInt _:x) (DynInt _:y) = overlaps x y
overlaps (DynInt _:x) (Static s:y) overlaps (DynInt _:x) (Static s:y)
| all isDigit s = overlaps x y | all isDigit s = overlaps x y
@ -163,26 +190,27 @@ data OverlappingPatterns =
deriving (Show, Typeable) deriving (Show, Typeable)
instance Exception OverlappingPatterns instance Exception OverlappingPatterns
checkPatterns :: MonadFailure OverlappingPatterns f getAllPairs :: [x] -> [(x, x)]
=> [ResourcePattern] getAllPairs [] = []
-> f () getAllPairs [_] = []
checkPatterns patterns = getAllPairs (x:xs) = map ((,) x) xs ++ getAllPairs xs
case validatePatterns patterns of
[] -> return ()
x -> failure $ OverlappingPatterns x
validatePatterns :: [ResourcePattern] -- | Ensures that we have a consistent set of resource patterns.
-> [(ResourcePattern, ResourcePattern)] checkPatterns :: (MonadFailure OverlappingPatterns m,
validatePatterns [] = [] MonadFailure InvalidResourcePattern m)
validatePatterns (x:xs) = => [ResourcePattern]
concatMap (validatePatterns' x) xs ++ validatePatterns xs where -> m [RP] -- FIXME
validatePatterns' :: ResourcePattern checkPatterns rpss = do
-> ResourcePattern rps <- mapM (runKleisli $ Kleisli return &&& Kleisli readRP) rpss
-> [(ResourcePattern, ResourcePattern)] let overlaps' = concatMap helper $ getAllPairs rps
validatePatterns' a b = unless (null overlaps') $ failure $ OverlappingPatterns overlaps'
let a' = unRP $ cs a return $ map snd rps
b' = unRP $ cs b where
in [(a, b) | overlaps a' b'] helper :: ((ResourcePattern, RP), (ResourcePattern, RP))
-> [(ResourcePattern, ResourcePattern)]
helper ((a, RP x), (b, RP y))
| overlaps x y = [(a, b)]
| otherwise = []
data RPNode = RPNode RP VerbMap data RPNode = RPNode RP VerbMap
deriving (Show, Eq) deriving (Show, Eq)
@ -195,7 +223,7 @@ instance ConvertAttempt TextObject [RPNode] where
helper :: (Text, TextObject) -> Attempt RPNode helper :: (Text, TextObject) -> Attempt RPNode
helper (rp, rest) = do helper (rp, rest) = do
verbMap <- fromTextObject rest verbMap <- fromTextObject rest
let rp' = cs (cs rp :: String) rp' <- readRP $ cs rp
return $ RPNode rp' verbMap return $ RPNode rp' verbMap
instance ConvertAttempt TextObject VerbMap where instance ConvertAttempt TextObject VerbMap where
convertAttempt (Scalar s) = return $ AllVerbs $ cs s convertAttempt (Scalar s) = return $ AllVerbs $ cs s
@ -212,7 +240,8 @@ data RPNodeException = VerbMapNonScalar TextObject
instance Exception RPNodeException instance Exception RPNodeException
checkRPNodes :: (MonadFailure OverlappingPatterns m, checkRPNodes :: (MonadFailure OverlappingPatterns m,
MonadFailure RepeatedVerb m MonadFailure RepeatedVerb m,
MonadFailure InvalidResourcePattern m
) )
=> [RPNode] => [RPNode]
-> m [RPNode] -> m [RPNode]
@ -225,7 +254,7 @@ checkRPNodes nodes = do
checkVerbMap (Verbs vs) = checkVerbMap (Verbs vs) =
let vs' = map fst vs let vs' = map fst vs
res = nub vs' == vs' res = nub vs' == vs'
in if res then return () else failure $ RepeatedVerb vs in unless res $ failure $ RepeatedVerb vs
newtype RepeatedVerb = RepeatedVerb [(Verb, String)] newtype RepeatedVerb = RepeatedVerb [(Verb, String)]
deriving (Show, Typeable) deriving (Show, Typeable)
@ -234,28 +263,25 @@ instance Exception RepeatedVerb
rpnodesTHCheck :: [RPNode] -> Q Exp rpnodesTHCheck :: [RPNode] -> Q Exp
rpnodesTHCheck nodes = do rpnodesTHCheck nodes = do
nodes' <- runIO $ checkRPNodes nodes nodes' <- runIO $ checkRPNodes nodes
res <- rpnodesTH nodes'
-- For debugging purposes runIO $ putStrLn $ pprint res -- For debugging purposes runIO $ putStrLn $ pprint res
return res rpnodesTH nodes'
notFoundVerb :: Verb -> Handler yesod a notFoundVerb :: Verb -> Handler yesod a
notFoundVerb _verb = notFound notFoundVerb _verb = notFound
rpnodesTH :: [RPNode] -> Q Exp rpnodesTH :: [RPNode] -> Q Exp
rpnodesTH ns = do rpnodesTH ns = do
b <- helper ns b <- mapM helper ns
nfv <- [|notFoundVerb|] nfv <- [|notFoundVerb|]
ow <- [|otherwise|] ow <- [|otherwise|]
let b' = b ++ [(NormalG ow, nfv)] let b' = b ++ [(NormalG ow, nfv)]
return $ LamE [VarP $ mkName "resource"] return $ LamE [VarP $ mkName "resource"]
$ CaseE (TupE []) [Match WildP (GuardedB b') []] $ CaseE (TupE []) [Match WildP (GuardedB b') []]
where where
helper :: [RPNode] -> Q [(Guard, Exp)] helper :: RPNode -> Q (Guard, Exp)
helper nodes = mapM helper2 nodes helper (RPNode rp vm) = do
helper2 :: RPNode -> Q (Guard, Exp)
helper2 (RPNode rp vm) = do
rp' <- lift rp rp' <- lift rp
cpb <- [|checkPatternBool|] cpb <- [|doesPatternMatch|]
let r' = VarE $ mkName "resource" let r' = VarE $ mkName "resource"
let g = cpb `AppE` rp' `AppE` r' let g = cpb `AppE` rp' `AppE` r'
vm' <- liftVerbMap vm $ countParams rp vm' <- liftVerbMap vm $ countParams rp
@ -266,10 +292,9 @@ rpnodesTH ns = do
data UrlParam = SlurpParam { slurpParam :: [String] } data UrlParam = SlurpParam { slurpParam :: [String] }
| StringParam { stringParam :: String } | StringParam { stringParam :: String }
| IntParam { intParam :: Int } | IntParam { intParam :: Int }
deriving Show -- FIXME remove
getUrlParam :: RP -> Resource -> Int -> UrlParam getUrlParam :: RP -> Resource -> Int -> UrlParam
getUrlParam rp r i = checkPatternUP rp r !! i getUrlParam rp = (!!) . paramsFromMatchingPattern rp
getUrlParamSlurp :: RP -> Resource -> Int -> [String] getUrlParamSlurp :: RP -> Resource -> Int -> [String]
getUrlParamSlurp rp r = slurpParam . getUrlParam rp r getUrlParamSlurp rp r = slurpParam . getUrlParam rp r
@ -288,7 +313,7 @@ applyUrlParams rp@(RP rpps) r f = do
helper :: Int -> [RPP] -> Q [Exp] helper :: Int -> [RPP] -> Q [Exp]
helper _ [] = return [] helper _ [] = return []
helper i (Static _:rest) = helper i rest helper i (Static _:rest) = helper i rest
helper i (Dynamic _:rest) = do helper i (DynStr _:rest) = do
rp' <- lift rp rp' <- lift rp
str <- [|getUrlParamString|] str <- [|getUrlParamString|]
i' <- lift i i' <- lift i
@ -327,8 +352,8 @@ instance Lift RPP where
lift (Static s) = do lift (Static s) = do
st <- [|Static|] st <- [|Static|]
return $ st `AppE` (LitE $ StringL s) return $ st `AppE` (LitE $ StringL s)
lift (Dynamic s) = do lift (DynStr s) = do
d <- [|Dynamic|] d <- [|DynStr|]
return $ d `AppE` (LitE $ StringL s) return $ d `AppE` (LitE $ StringL s)
lift (DynInt s) = do lift (DynInt s) = do
d <- [|DynInt|] d <- [|DynInt|]
@ -360,12 +385,6 @@ strToExp toCheck s = do
rpnodes <- runIO $ convertAttemptWrap $ YamlDoc $ cs s rpnodes <- runIO $ convertAttemptWrap $ YamlDoc $ cs s
(if toCheck then rpnodesTHCheck else rpnodesTH) rpnodes (if toCheck then rpnodesTHCheck else rpnodesTH) rpnodes
resources :: QuasiQuoter
resources = QuasiQuoter (strToExp True) undefined
resourcesNoCheck :: QuasiQuoter
resourcesNoCheck = QuasiQuoter (strToExp False) undefined
#if TEST #if TEST
---- Testing ---- Testing
testSuite :: Test testSuite :: Test
@ -373,28 +392,37 @@ testSuite = testGroup "Yesod.Resource"
[ testCase "non-overlap" caseOverlap1 [ testCase "non-overlap" caseOverlap1
, testCase "overlap" caseOverlap2 , testCase "overlap" caseOverlap2
, testCase "overlap-slurp" caseOverlap3 , testCase "overlap-slurp" caseOverlap3
, testCase "validatePatterns" caseValidatePatterns -- FIXME, testCase "validatePatterns" caseValidatePatterns
, testProperty "show pattern" prop_showPattern , testProperty "show pattern" prop_showPattern
, testCase "integers" caseIntegers , testCase "integers" caseIntegers
, testCase "read patterns from YAML" caseFromYaml , testCase "read patterns from YAML" caseFromYaml
, testCase "checkRPNodes" caseCheckRPNodes , testCase "checkRPNodes" caseCheckRPNodes
, testCase "readRP" caseReadRP
] ]
deriving instance Arbitrary RP instance Arbitrary RP where
coarbitrary = undefined
arbitrary = do
size <- elements [1..10]
rpps <- replicateM size arbitrary
let rpps' = filter (not . isSlurp) rpps
extra <- arbitrary
return $ RP $ rpps' ++ [extra]
caseOverlap' :: String -> String -> Bool -> Assertion
caseOverlap' x y b = do
x' <- readRP x
y' <- readRP y
assert $ overlaps (unRP x') (unRP y') == b
caseOverlap1 :: Assertion caseOverlap1 :: Assertion
caseOverlap1 = assert $ not $ overlaps caseOverlap1 = caseOverlap' "/foo/$bar/" "/foo/baz/$bin" False
(unRP $ cs "/foo/$bar/")
(unRP $ cs "/foo/baz/$bin")
caseOverlap2 :: Assertion caseOverlap2 :: Assertion
caseOverlap2 = assert $ overlaps caseOverlap2 = caseOverlap' "/foo/bar" "/foo/$baz" True
(unRP $ cs "/foo/bar")
(unRP $ cs "/foo/$baz")
caseOverlap3 :: Assertion caseOverlap3 :: Assertion
caseOverlap3 = assert $ overlaps caseOverlap3 = caseOverlap' "/foo/bar/baz/$bin" "*slurp" True
(unRP $ cs "/foo/bar/baz/$bin")
(unRP $ cs "*slurp")
{- FIXME rewrite this test
caseValidatePatterns :: Assertion caseValidatePatterns :: Assertion
caseValidatePatterns = caseValidatePatterns =
let p1 = cs "/foo/bar/baz" let p1 = cs "/foo/bar/baz"
@ -402,13 +430,14 @@ caseValidatePatterns =
p3 = cs "/bin" p3 = cs "/bin"
p4 = cs "/bin/boo" p4 = cs "/bin/boo"
p5 = cs "/bin/*slurp" p5 = cs "/bin/*slurp"
in validatePatterns [p1, p2, p3, p4, p5] @?= in validatePatterns [p1, p2, p3, p4, p5] @?= Just
[ (p1, p2) [ (p1, p2)
, (p4, p5) , (p4, p5)
] ]
-}
prop_showPattern :: RP -> Bool prop_showPattern :: RP -> Bool
prop_showPattern p = cs (cs p :: String) == p prop_showPattern p = readRP (cs p) == Just p
caseIntegers :: Assertion caseIntegers :: Assertion
caseIntegers = do caseIntegers = do
@ -420,8 +449,10 @@ caseIntegers = do
p6 = "/foo/*slurp/" p6 = "/foo/*slurp/"
checkOverlap :: String -> String -> Bool -> IO () checkOverlap :: String -> String -> Bool -> IO ()
checkOverlap a b c = do checkOverlap a b c = do
let res1 = overlaps (unRP $ cs a) (unRP $ cs b) rpa <- readRP a
let res2 = overlaps (unRP $ cs b) (unRP $ cs a) rpb <- readRP b
let res1 = overlaps (unRP rpa) (unRP $ rpb)
let res2 = overlaps (unRP rpb) (unRP $ rpa)
when (res1 /= c || res2 /= c) $ assertString $ a when (res1 /= c || res2 /= c) $ assertString $ a
++ (if c then " does not overlap with " else " overlaps with ") ++ (if c then " does not overlap with " else " overlaps with ")
++ b ++ b
@ -433,7 +464,7 @@ caseIntegers = do
instance Arbitrary RPP where instance Arbitrary RPP where
arbitrary = do arbitrary = do
constr <- elements [Static, Dynamic, Slurp, DynInt] constr <- elements [Static, DynStr, Slurp, DynInt]
size <- elements [1..10] size <- elements [1..10]
s <- replicateM size $ elements ['a'..'z'] s <- replicateM size $ elements ['a'..'z']
return $ constr s return $ constr s
@ -442,14 +473,18 @@ instance Arbitrary RPP where
caseFromYaml :: Assertion caseFromYaml :: Assertion
caseFromYaml = do caseFromYaml = do
contents <- readYamlDoc "test/resource-patterns.yaml" contents <- readYamlDoc "test/resource-patterns.yaml"
rp1 <- readRP "static/*filepath"
rp2 <- readRP "page"
rp3 <- readRP "page/$page"
rp4 <- readRP "user/#id"
let expected = let expected =
[ RPNode (cs "static/*filepath") $ AllVerbs "getStatic" [ RPNode rp1 $ AllVerbs "getStatic"
, RPNode (cs "page") $ Verbs [(Get, "pageIndex"), (Put, "pageAdd")] , RPNode rp2 $ Verbs [(Get, "pageIndex"), (Put, "pageAdd")]
, RPNode (cs "page/$page") $ Verbs [ (Get, "pageDetail") , RPNode rp3 $ Verbs [ (Get, "pageDetail")
, (Delete, "pageDelete") , (Delete, "pageDelete")
, (Post, "pageUpdate") , (Post, "pageUpdate")
] ]
, RPNode (cs "user/#id") $ Verbs [(Get, "userInfo")] , RPNode rp4 $ Verbs [(Get, "userInfo")]
] ]
contents' <- fa $ ca contents contents' <- fa $ ca contents
expected @=? contents' expected @=? contents'
@ -459,10 +494,23 @@ caseCheckRPNodes = do
good' <- readYamlDoc "test/resource-patterns.yaml" good' <- readYamlDoc "test/resource-patterns.yaml"
good <- fa $ ca good' good <- fa $ ca good'
Just good @=? checkRPNodes good Just good @=? checkRPNodes good
let bad1 = [ RPNode (cs "foo/bar") $ AllVerbs "foo" rp1 <- readRP "foo/bar"
, RPNode (cs "$foo/bar") $ AllVerbs "bar" rp2 <- readRP "$foo/bar"
let bad1 = [ RPNode rp1 $ AllVerbs "foo"
, RPNode rp2 $ AllVerbs "bar"
] ]
Nothing @=? checkRPNodes bad1 Nothing @=? checkRPNodes bad1
let bad2 = [RPNode (cs "") $ Verbs [(Get, "foo"), (Get, "bar")]] rp' <- readRP ""
let bad2 = [RPNode rp' $ Verbs [(Get, "foo"), (Get, "bar")]]
Nothing @=? checkRPNodes bad2 Nothing @=? checkRPNodes bad2
caseReadRP :: Assertion
caseReadRP = do
Just (RP [Static "foo", DynStr "bar", DynInt "baz", Slurp "bin"]) @=?
readRP "foo/$bar/#baz/*bin/"
Just (RP [Static "foo", DynStr "bar", DynInt "baz", Slurp "bin"]) @=?
readRP "foo/$bar/#baz/*bin"
Nothing @=? readRP "/foo//"
Just (RP []) @=? readRP "/"
Nothing @=? readRP "/*slurp/anything"
#endif #endif

3
test/quasi-resource.hs
View File

@ -1,4 +1,3 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
@ -45,7 +44,7 @@ handler = [$resources|
ph :: Handler MyYesod RepChooser -> IO () ph :: Handler MyYesod RepChooser -> IO ()
ph h = do ph h = do
let eh e = return $ chooseRep $ toHtmlObject $ show e let eh = return . chooseRep . toHtmlObject . show
rr = error "No raw request" rr = error "No raw request"
y = MyYesod y = MyYesod
cts = [TypeHtml] cts = [TypeHtml]