Advertisement
Guest User

Untitled

a guest
Apr 2nd, 2013
64
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. getFetchProcessPathRollupR :: Text -> Handler RepPlain
  2. getFetchProcessPathRollupR siteId = do
  3.   day <- yesterday
  4.   req <- assmbleRequest $ assmbleUrl day $ unpack siteId
  5.   runDB $ do
  6.     k <- getKey (UniqueSite siteId)
  7.                 (Site siteId)
  8.     withManager $ \m -> do
  9.       src <- http req m
  10.       responseBody src $$+- (intoCSV defCSVSettings =$= parsePPR (zonedTimeToUTC day) k =$ sinkP\
  11. ersist)
  12.   return $ RepPlain $ toContent ("OK" :: String)
  13.  
  14. assmbleUrl :: (FormatTime t) => t -> String -> String
  15.  
  16. parsePPR :: UTCTime -> SiteId -> Conduit (MapRow Text) (ResourceT (YesodDB App App)) ProcessPathRollup                                                                                        
  17. parsePPR time site = awaitForever $ \r -> do
  18.   let t = (!) r
  19.       d = liftM fst . double . t
  20.       i = liftM fst . decimal . t
  21.   reportKey <- getKey (UniqueReport (t "Report"))
  22.                       (Report (t "Report"))
  23.   lineitemKey <- getKey (UniqueLineitem (t "LineItem Name") (t "LineItem Id"))
  24.                         (Lineitem (t "LineItem Id") (t "LineItem Name"))
  25.   mainProcessKey <- getKey (UniqueMainProcess (t "Main Process"))
  26.                            (MainProcess (t "Main Process"))
  27.   coreProcessKey <- getKey (UniqueCoreProcess (t "Core Process"))
  28.                            (CoreProcess (t "Core Process"))
  29.   unitTypeKey <- getKey (UniqueUnitType (t "Unit Type"))
  30.                         (UnitType (t "Unit Type"))
  31.   case (ProcessPathRollup
  32.         <$> (Right site)
  33.         <*> (Right time)
  34.         <*> (Right reportKey)
  35.         <*> (i "Line Number")
  36.         <*> (Right lineitemKey)
  37.         <*> (Right mainProcessKey)
  38.         <*> (Right coreProcessKey)
  39.         <*> (Right unitTypeKey)
  40.         <*> (i "Actual Volume")
  41.         <*> (d "Actual Hours")
  42.         <*> (d "Actual Rate")
  43.         <*> (d "Plan Variance (Hrs)")
  44.         <*> (d "Hours @ Plan Rate")
  45.         <*> (d "Plan Variance (Hrs)")
  46.         <*> (d "% to Plan")
  47.         <*> (d "YOY Baseline Volume")
  48.         <*> (d "YOY Rate")
  49.         <*> (d "YOY Vol / Actual Rate (Hrs)")
  50.         <*> (d "YOY Vol / PY Rate (Hrs)")
  51.         <*> (d "YOY %")) of
  52.     Left err -> fail err
  53.     Right ppr -> yield ppr
  54.  
  55. sinkPersist :: Sink ProcessPathRollup (ResourceT (YesodDB App App)) ()
  56. sinkPersist = awaitForever $ void . lift . lift . insert
  57.  
  58. getKey us r = do
  59.   mk <- getBy us
  60.   case mk of
  61.     Nothing -> insert r
  62.     Just (Entity l _) -> return l
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement