yesod-job-queue 0.2.0.1 → 0.3.0.0
raw patch · 5 files changed
+87/−25 lines, 5 files
Files
- Yesod/JobQueue.hs +22/−18
- Yesod/JobQueue/GenericConstr.hs +52/−0
- app/dist/app.bundle.js too large to diff
- example/Main.hs +10/−6
- yesod-job-queue.cabal +3/−1
Yesod/JobQueue.hs view
@@ -7,7 +7,6 @@ module Yesod.JobQueue ( YesodJobQueue (..) , JobQueue- , JobInfo (..) , startDequeue , enqueue , JobState@@ -20,9 +19,10 @@ import Yesod.JobQueue.Routes import Yesod.JobQueue.Types+import Yesod.JobQueue.GenericConstr import qualified Data.List as L-import ClassyPrelude.Yesod+import ClassyPrelude.Yesod hiding (Proxy) import Control.Concurrent import Control.Lens ((^.)) import qualified Data.ByteString.Char8 as BSC (pack, unpack)@@ -36,15 +36,12 @@ import Data.Time.Clock import Data.Aeson.TH+import GHC.Generics (Rep)+import Data.Proxy import Data.FileEmbed (embedFile) --- | description for JobType-class JobInfo j where- describe :: j -> String- describe _ = ""- -- | Thread ID for convenience type ThreadNum = Int @@ -77,8 +74,8 @@ -- | Backend jobs for Yesod class (Yesod master, Read (JobType master), Show (JobType master)- , Enum (JobType master), Bounded (JobType master)- , JobInfo (JobType master))+ , Generic (JobType master), Constructors (Rep (JobType master))+ ) => YesodJobQueue master where -- | Custom Job Type@@ -116,6 +113,10 @@ jobManagerJSUrl :: master -> String jobManagerJSUrl m = (jobAPIBaseUrl m) ++ "/manager/app.js" + -- | Job Information+ describeJob :: master -> JobTypeString -> Maybe Text+ describeJob _ _ = Nothing+ -- | get information of all type classes related job-queue getClassInformation :: master -> [JobQueueClassInfo] getClassInformation m = [jobQueueInfo m]@@ -181,10 +182,6 @@ readJobType :: YesodJobQueue master => master -> String -> Maybe (JobType master) readJobType _ = readMay --- | get all job type list-allJobTypes :: (YesodJobQueue master) => master -> [JobType master]-allJobTypes _ = [minBound..]- -- | Need by 'getClassInformation' jobQueueInfo :: YesodJobQueue master => master -> JobQueueClassInfo jobQueueInfo m = JobQueueClassInfo "JobQueue" [threadInfo]@@ -195,16 +192,23 @@ type JobHandler master a = YesodJobQueue master => HandlerT JobQueue (HandlerT master IO) a +jobTypeProxy :: (YesodJobQueue m) => m -> Proxy (JobType m)+jobTypeProxy _ = Proxy+ -- | get job definitions getJobR :: JobHandler master Value getJobR = lift $ do y <- getYesod- -- job types- let f x = object ["type" .= show x, "description" .= describe x]- let ts = map f $ allJobTypes y- -- type class info+ let parseConstr (c:args) = object ["type" .= c, "args" .= args, "description" .= describeJob y c]+ constrs = map parseConstr $ genericConstructors $ jobTypeProxy y let info = getClassInformation y- returnJson $ object ["jobTypes" .= ts, "information" .= info]+ returnJson $ object ["jobTypes" .= constrs, "information" .= info]+ -- -- job types+ -- let f x = object ["type" .= show x, "description" .= describe x]+ -- let ts = map f $ allJobTypes y+ -- -- type class info+ -- let info = getClassInformation y+ -- returnJson $ object ["jobTypes" .= ts, "information" .= info] -- | get a list of jobs in queue getJobQueueR :: JobHandler master Value
+ Yesod/JobQueue/GenericConstr.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeOperators #-}+module Yesod.JobQueue.GenericConstr where++import GHC.Generics+import Data.Proxy+import Data.Typeable++-- *Demo> genericConstructors (Proxy :: Proxy (Either Int Bool))+-- [["Left","Int"],["Right","Bool"]]+-- *Demo> genericConstructors (Proxy :: Proxy [Bool])+-- [["[]"],[":","Bool","[Bool]"]]++class Constructors (f :: * -> *) where+ constructors :: Proxy f -> [[String]]++pmap :: (f a -> g b) -> proxy g -> Proxy f+pmap _ _ = Proxy++genericConstructors :: forall a proxy.+ (Generic a, Constructors (Rep a)) => proxy a -> [[String]]+genericConstructors _ = constructors (Proxy :: Proxy (Rep a))++instance Constructors f => Constructors (D1 d f) where+ constructors = constructors . pmap M1++instance (Constructors f, Constructors g) => Constructors (f :+: g) where+ constructors p = constructors (pmap L1 p) ++ constructors (pmap R1 p)++instance (Fields f, Constructor c) => Constructors (C1 c f) where+ constructors p =+ [conName (M1 Proxy :: C1 c Proxy ()) : fields (pmap M1 p) ]++class Fields (f :: * -> *) where+ fields :: proxy f -> [String]++instance Fields f => Fields (M1 i c f) where+ fields = fields . pmap M1++instance Fields U1 where+ fields _ = []++instance (Fields f, Fields g) => Fields (f :*: g) where+ fields _ = fields (Proxy :: Proxy f)+ ++ fields (Proxy :: Proxy g)++instance Typeable a => Fields (K1 i a) where+ fields _ = [show (typeRep (Proxy :: Proxy a))]+
app/dist/app.bundle.js view
file too large to diff
example/Main.hs view
@@ -36,10 +36,10 @@ |] -- JobQueue settings-data MyJobType = AggregationUser | PushNotification deriving (Show, Read, Enum, Bounded)-instance JobInfo MyJobType where- describe AggregationUser = "aggregate user's activities"- describe _ = "No information"+data MyJobType = AggregationUser+ | PushNotification+ | HelloJob String+ deriving (Show, Read, Generic) instance YesodJobQueue App where type JobType App = MyJobType@@ -54,8 +54,12 @@ print us putStrLn "complate job!" runJob _ PushNotification = do- putStrLn "send norification!"+ putStrLn "sent notification!"+ runJob _ (HelloJob name) = do+ putStrLn . pack $ "Hello " ++ name getClassInformation app = [jobQueueInfo app, schedulerInfo app]+ describeJob _ "AggregationUser" = Just "aggregate user's activities"+ describeJob _ _ = Nothing -- jobManagerJSUrl _ = "http://localhost:3001/dist/app.bundle.js" -- use for development with "npm run bs" -- queueConnectInfo _ = R.defaultConnectInfo -- {R.connectHost = "127.0.0.1"@@ -63,7 +67,7 @@ instance YesodJobQueueScheduler App where getJobSchedules _ = [("* * * * *", AggregationUser)- , ("* * * * *", PushNotification)]+ , ("* * * * *", HelloJob "Foo")] -- Handlers getHomeR :: HandlerT App IO Html
yesod-job-queue.cabal view
@@ -1,5 +1,5 @@ name: yesod-job-queue-version: 0.2.0.1+version: 0.3.0.0 synopsis: Background jobs library for Yesod. description: Background jobs library for Yesod@@ -30,6 +30,7 @@ , Yesod.JobQueue.Scheduler , Yesod.JobQueue.Types , Yesod.JobQueue.Routes+ , Yesod.JobQueue.GenericConstr default-extensions: TemplateHaskell , MultiParamTypeClasses , FunctionalDependencies@@ -73,6 +74,7 @@ , MultiParamTypeClasses , EmptyDataDecls , GeneralizedNewtypeDeriving+ , DeriveGeneric -- other-modules: ghc-options: -Wall -fwarn-tabs -O2