apiary-helics (empty) → 1.1.0

raw patch · 4 files changed

+186/−0 lines, 4 filesdep +apiarydep +basedep +bytestringsetup-changed

Dependencies added: apiary, base, bytestring, data-default-class, helics, helics-wai, monad-control, transformers, vault, wai

Files

LICENSE +20/−0
Setup.hs +2/−0
apiary-helics.cabal +38/−0
src/Web/Apiary/Helics.hs +126/−0

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2014 Hirotomo Moriwaki++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ apiary-helics.cabal view

@@ -0,0 +1,38 @@+name:                apiary-helics+version:             1.1.0+synopsis:            helics support for apiary web framework.+description:         helics support for apiary web framework.+license:             MIT+license-file:        LICENSE+author:              HirotomoMoriwaki<philopon.dependence@gmail.com>+maintainer:          HirotomoMoriwaki<philopon.dependence@gmail.com>+Homepage:            https://github.com/philopon/apiary+Bug-reports:         https://github.com/philopon/apiary/issues+copyright:           (c) 2014 Hirotomo Moriwaki+category:            Web+build-type:          Simple+stability:           experimental+-- extra-source-files:  +cabal-version:       >=1.10++library+  exposed-modules:     Web.Apiary.Helics+  other-modules:       +  build-depends:       base               >=4.6   && <4.8+                     , apiary             >=1.1   && <1.2+                     , helics             >=0.2   && <0.3+                     , helics-wai         >=0.2   && <0.3+                     , vault              >=0.3   && <0.4+                     , transformers       >=0.3   && <0.5+                     , monad-control      >=0.3   && <0.4+                     , wai                >=3.0   && <3.1+                     , bytestring         >=0.10  && <0.11+                     , data-default-class >=0.0   && <0.1++  hs-source-dirs:      src+  ghc-options:         -O2 -Wall+  default-language:    Haskell2010++source-repository head+  type:     git+  location: git://github.com/philopon/apiary.git

+ src/Web/Apiary/Helics.hs view

@@ -0,0 +1,126 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoMonomorphismRestriction #-}++module Web.Apiary.Helics+    ( Helics+    -- * initializer+    , HelicsConfig(..)+    , initHelics+    -- * action+    -- ** raw+    , transactionId+    -- ** metric+    , recordMetric+    -- ** transaction+    , addAttribute+    -- ** segment+    , genericSegment+    , datastoreSegment+    , externalSegment+    -- * reexports+    , H.autoScope+    , H.rootSegment+    , H.TransactionId+    , H.SegmentId+    , H.Operation(..)+    , H.DatastoreSegment(..)+    ) where++import Control.Concurrent+import Control.Applicative+import Control.Monad.Apiary.Action+import Control.Monad.IO.Class+import Control.Monad.Trans.Control++import Network.Wai+import qualified Network.Helics as H+import qualified Network.Helics.Wai.Safe as Safe++import Data.Apiary.Compat+import Data.Apiary.Extension+import Data.Default.Class+import qualified Data.Vault.Lazy as V+import qualified Data.ByteString as S++data Helics = Helics (V.Key H.TransactionId) ThreadId+instance Extension Helics where+    extMiddleware (Helics k _) = Safe.helics k++data HelicsConfig = HelicsConfig+    { licenseKey       :: S.ByteString+    , appName          :: S.ByteString+    , language         :: S.ByteString+    , languageVersion  :: S.ByteString+    , statusCallback   :: Maybe (H.StatusCode -> IO ())+    , samplerFrequency :: Int+    }++instance Default HelicsConfig where+    def = HelicsConfig { licenseKey       = H.licenseKey def+                       , appName          = H.appName def+                       , language         = H.language def+                       , languageVersion  = H.languageVersion def+                       , statusCallback   = H.statusCallback def+                       , samplerFrequency = 20+                       }++conv :: HelicsConfig -> H.HelicsConfig+conv c = def { H.licenseKey      = licenseKey c+             , H.appName         = appName c+             , H.language        = language c+             , H.languageVersion = languageVersion c+             , H.statusCallback  = statusCallback c+             }++initHelics :: (MonadBaseControl IO m, MonadIO m) => HelicsConfig -> Initializer' m Helics+initHelics cnf = initializerBracket' $ \m -> do+    k <- liftIO $ V.newKey+    control $ \run -> H.withHelics (conv cnf) $ run $ do+        tid <- liftIO $ forkIO $ H.sampler (samplerFrequency cnf)+        m (Helics k tid)++recordMetric :: MonadIO m => S.ByteString -> Double+             -> ActionT exts prms m ()+recordMetric n v = liftIO $ H.recordMetric n v++transactionId :: (Has Helics exts, Monad m)+              => ActionT exts prms m H.TransactionId+transactionId = do+    Helics key _ <- getExt Proxy+    maybe (error "apiary-helics: vault value not found.") id .+        V.lookup key . vault <$> getRequest++addAttribute :: (MonadIO m, Has Helics exts)+             => S.ByteString -> S.ByteString -> ActionT exts prms m ()+addAttribute key val = do+    tid <- transactionId+    liftIO $ H.addAttribute key val tid++genericSegment :: (Has Helics exts, MonadBaseControl IO m)+               => H.SegmentId  -- ^ parent segment id+               -> S.ByteString -- ^ name of represent segment+               -> ActionT exts prms m a+               -> ActionT exts prms m a+genericSegment sid name act = do+    tid <- transactionId+    control $ \run -> H.genericSegment sid name (run act) tid++datastoreSegment :: (Has Helics exts, MonadBaseControl IO m)+                 => H.SegmentId  -- ^ parent segment id+                 -> H.DatastoreSegment+                 -> ActionT exts prms m a+                 -> ActionT exts prms m a+datastoreSegment sid ds act = do+    tid <- transactionId+    control $ \run -> H.datastoreSegment sid ds (run act) tid++externalSegment :: (Has Helics exts, MonadBaseControl IO m)+                => H.SegmentId  -- ^ parent segment id+                -> S.ByteString -- ^ host of segment+                -> S.ByteString -- ^ name of segment+                -> ActionT exts prms m a+                -> ActionT exts prms m a+externalSegment sid host name act = do+    tid <- transactionId+    control $ \run -> H.externalSegment sid host name (run act) tid