apiary 0.2.0.0 → 0.3.0.0
raw patch · 7 files changed
+108/−120 lines, 7 filesdep +warpPVP ok
version bump matches the API change (PVP)
Dependencies added: warp
API changes (from Hackage documentation)
- Web.Apiary.QQ: capture :: QuasiQuoter
+ Web.Apiary.TH: capture :: QuasiQuoter
Files
- apiary.cabal +5/−11
- src/Control/Monad/Apiary/Action/Internal.hs +0/−6
- src/Web/Apiary.hs +2/−2
- src/Web/Apiary/QQ.hs +0/−5
- src/Web/Apiary/QQ/Capture.hs +0/−96
- src/Web/Apiary/TH.hs +5/−0
- src/Web/Apiary/TH/Capture.hs +96/−0
apiary.cabal view
@@ -1,5 +1,5 @@ name: apiary-version: 0.2.0.0+version: 0.3.0.0 x-revision: 1 synopsis: Simple web framework inspired by scotty. description:@@ -40,17 +40,13 @@ -- extra-source-files: cabal-version: >=1.10 -flag MonadLogger- description: define MonadLogger instance- default: True- library exposed-modules: Web.Apiary- Web.Apiary.QQ+ Web.Apiary.TH Control.Monad.Apiary Control.Monad.Apiary.Filter Control.Monad.Apiary.Action- other-modules: Web.Apiary.QQ.Capture+ other-modules: Web.Apiary.TH.Capture Control.Monad.Apiary.Internal Control.Monad.Apiary.Action.Internal other-extensions: TemplateHaskell@@ -68,15 +64,13 @@ , bytestring >=0.10 && <0.11 , blaze-builder >=0.3 && <0.4 , conduit >=1.1 && <1.2+ , monad-logger >=0.3 && <0.4 , data-default >=0.5 && <0.6 , http-types >=0.8 && <0.9 , mime-types >=0.1 && <0.2 , wai >=2.1 && <2.2-- if flag(MonadLogger)- build-depends: monad-logger >=0.3 && <0.4- cpp-options: -DDefineMonadLoggerInstance+ , warp >=2.1 && <2.2 hs-source-dirs: src ghc-options: -O2 -Wall
src/Control/Monad/Apiary/Action/Internal.hs view
@@ -7,7 +7,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE Rank2Types #-}-{-# LANGUAGE CPP #-} module Control.Monad.Apiary.Action.Internal where @@ -30,10 +29,7 @@ import qualified Data.Text as T import Data.Conduit import Control.Monad.Morph--#ifdef DefineMonadLoggerInstance import qualified Control.Monad.Logger as Logger-#endif data ApiaryConfig = ApiaryConfig { -- | call when no handler matched.@@ -139,10 +135,8 @@ ask = lift ask local f = hoist $ local f -#ifdef DefineMonadLoggerInstance instance Logger.MonadLogger m => Logger.MonadLogger (ActionT m) where monadLoggerLog loc src lv msg = lift $ Logger.monadLoggerLog loc src lv msg-#endif getRequest :: Monad m => ActionT m Request getRequest = ActionT $ lift ask
src/Web/Apiary.hs view
@@ -2,9 +2,9 @@ ( module Control.Monad.Apiary , module Control.Monad.Apiary.Action- , module Web.Apiary.QQ+ , module Web.Apiary.TH ) where import Control.Monad.Apiary import Control.Monad.Apiary.Action-import Web.Apiary.QQ+import Web.Apiary.TH
− src/Web/Apiary/QQ.hs
@@ -1,5 +0,0 @@-module Web.Apiary.QQ- (capture- ) where--import Web.Apiary.QQ.Capture
− src/Web/Apiary/QQ/Capture.hs
@@ -1,96 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-}--module Web.Apiary.QQ.Capture where--import Control.Monad-import Network.Wai-import Text.Read-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import Language.Haskell.TH-import Language.Haskell.TH.Quote-import Data.Int-import Data.Word--import Control.Monad.Apiary--preCapture :: [Char] -> [T.Text]-preCapture ('/':s) = T.splitOn "/" $ T.pack s-preCapture s = T.splitOn "/" $ T.pack s--capture :: QuasiQuoter-capture = QuasiQuoter- { quoteExp = capture' . preCapture- , quotePat = \_ -> error "No quotePat."- , quoteType = \_ -> error "No quoteType."- , quoteDec = \_ -> error "No quoteDec."- }--class Param a where- readParam :: T.Text -> Maybe a--instance Param Char where- readParam s | T.null s = Nothing- | otherwise = Just $ T.head s--instance Param Int where readParam = readMaybe . T.unpack-instance Param Int8 where readParam = readMaybe . T.unpack-instance Param Int16 where readParam = readMaybe . T.unpack-instance Param Int32 where readParam = readMaybe . T.unpack-instance Param Int64 where readParam = readMaybe . T.unpack-instance Param Integer where readParam = readMaybe . T.unpack--instance Param Word where readParam = readMaybe . T.unpack-instance Param Word8 where readParam = readMaybe . T.unpack-instance Param Word16 where readParam = readMaybe . T.unpack-instance Param Word32 where readParam = readMaybe . T.unpack-instance Param Word64 where readParam = readMaybe . T.unpack--instance Param Double where readParam = readMaybe . T.unpack-instance Param Float where readParam = readMaybe . T.unpack--instance Param T.Text where- readParam = Just--instance Param TL.Text where- readParam = Just . TL.fromStrict--instance Param String where- readParam = Just . T.unpack--integralE :: Integral i => i -> ExpQ-integralE = litE . integerL . fromIntegral--capture' :: [T.Text] -> ExpQ-capture' cap = [| function $ \_ request -> - $(caseE [|pathInfo request|] - [ match pat (guards >>= \g -> body >>= \b -> normalB (doE $ g ++ b)) []- , match wildP (normalB [|mzero|]) []- ]) |]- where- varNames = zip cap $ map (('v':) . show) [0 :: Int ..]- pat = listP $ map (varP . mkName . snd) varNames- isType s | T.null s = False- | T.head s == ':' = True- | otherwise = False- guards = return $ - map (\(a,v) -> noBindS [|guard $ $(varE $ mkName v) == $(stringE $ T.unpack a) |]) $- filter (not . isType . fst) varNames- body = do- let ss = map (\(a,v) -> do- ty <- lookupType a- -- let ty = mkName . T.unpack $ T.tail a- bindS (varP . mkName $ v ++ "'")- [| (readParam $(varE $ mkName v) :: Maybe $(conT ty) ) |])- $ filter (isType . fst) varNames- rt = tupE $ map (\(_,v) -> varE $ mkName (v ++ "'")) $ filter (isType . fst) varNames- return $ ss ++ [noBindS [| return $rt |]]- lookupType n = lookupTypeName (T.unpack $ T.tail n) >>= \case- Nothing -> fail $ "capture': type not found: " ++ T.unpack (T.tail n)- Just ty -> return ty--
+ src/Web/Apiary/TH.hs view
@@ -0,0 +1,5 @@+module Web.Apiary.TH+ (capture+ ) where++import Web.Apiary.TH.Capture
+ src/Web/Apiary/TH/Capture.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}++module Web.Apiary.TH.Capture where++import Control.Monad+import Network.Wai+import Text.Read+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import Language.Haskell.TH+import Language.Haskell.TH.Quote+import Data.Int+import Data.Word++import Control.Monad.Apiary++preCapture :: [Char] -> [T.Text]+preCapture ('/':s) = T.splitOn "/" $ T.pack s+preCapture s = T.splitOn "/" $ T.pack s++capture :: QuasiQuoter+capture = QuasiQuoter+ { quoteExp = capture' . preCapture+ , quotePat = \_ -> error "No quotePat."+ , quoteType = \_ -> error "No quoteType."+ , quoteDec = \_ -> error "No quoteDec."+ }++class Param a where+ readParam :: T.Text -> Maybe a++instance Param Char where+ readParam s | T.null s = Nothing+ | otherwise = Just $ T.head s++instance Param Int where readParam = readMaybe . T.unpack+instance Param Int8 where readParam = readMaybe . T.unpack+instance Param Int16 where readParam = readMaybe . T.unpack+instance Param Int32 where readParam = readMaybe . T.unpack+instance Param Int64 where readParam = readMaybe . T.unpack+instance Param Integer where readParam = readMaybe . T.unpack++instance Param Word where readParam = readMaybe . T.unpack+instance Param Word8 where readParam = readMaybe . T.unpack+instance Param Word16 where readParam = readMaybe . T.unpack+instance Param Word32 where readParam = readMaybe . T.unpack+instance Param Word64 where readParam = readMaybe . T.unpack++instance Param Double where readParam = readMaybe . T.unpack+instance Param Float where readParam = readMaybe . T.unpack++instance Param T.Text where+ readParam = Just++instance Param TL.Text where+ readParam = Just . TL.fromStrict++instance Param String where+ readParam = Just . T.unpack++integralE :: Integral i => i -> ExpQ+integralE = litE . integerL . fromIntegral++capture' :: [T.Text] -> ExpQ+capture' cap = [| function $ \_ request -> + $(caseE [|pathInfo request|] + [ match pat (guards >>= \g -> body >>= \b -> normalB (doE $ g ++ b)) []+ , match wildP (normalB [|mzero|]) []+ ]) |]+ where+ varNames = zip cap $ map (('v':) . show) [0 :: Int ..]+ pat = listP $ map (varP . mkName . snd) varNames+ isType s | T.null s = False+ | T.head s == ':' = True+ | otherwise = False+ guards = return $ + map (\(a,v) -> noBindS [|guard $ $(varE $ mkName v) == $(stringE $ T.unpack a) |]) $+ filter (not . isType . fst) varNames+ body = do+ let ss = map (\(a,v) -> do+ ty <- lookupType a+ -- let ty = mkName . T.unpack $ T.tail a+ bindS (varP . mkName $ v ++ "'")+ [| (readParam $(varE $ mkName v) :: Maybe $(conT ty) ) |])+ $ filter (isType . fst) varNames+ rt = tupE $ map (\(_,v) -> varE $ mkName (v ++ "'")) $ filter (isType . fst) varNames+ return $ ss ++ [noBindS [| return $rt |]]+ lookupType n = lookupTypeName (T.unpack $ T.tail n) >>= \case+ Nothing -> fail $ "capture': type not found: " ++ T.unpack (T.tail n)+ Just ty -> return ty++