heart-app (empty) → 0.1.0

raw patch · 8 files changed

+264/−0 lines, 8 filesdep +basedep +co-logdep +co-log-core

Dependencies added: base, co-log, co-log-core, ekg, ekg-core, ekg-statsd, heart-core, text

Files

• LICENSE +30/−0
• README.md +5/−0
• heart-app.cabal +51/−0
• src/Heart/App/App.hs +46/−0
• src/Heart/App/Logging.hs +50/−0
• src/Heart/App/Prelude.hs +11/−0
• src/Heart/App/Stats.hs +60/−0
• src/Heart/App/SuperPrelude.hs +11/−0

@@ -0,0 +1,30 @@+Copyright Eric Conlon (c) 2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Eric Conlon nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,5 @@+# heart-app++[![CircleCI](https://circleci.com/gh/ejconlon/heart-app/tree/master.svg?style=svg)](https://circleci.com/gh/ejconlon/heart-app/tree/master)++An opinionated app prelude and framework in the UnliftIO style.

@@ -0,0 +1,51 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 70e10c64507e544a0c8b368dfbd6e2a31da96f824f964da56d6c87b823735b7a++name:           heart-app+version:        0.1.0+synopsis:       An opinionated app prelude and framework in the UnliftIO style+description:    Please see the README on GitHub at <https://github.com/ejconlon/heart-app#readme>+category:       Prelude+homepage:       https://github.com/ejconlon/heart-app#readme+bug-reports:    https://github.com/ejconlon/heart-app/issues+author:         Eric Conlon+maintainer:     ejconlon@gmail.com+copyright:      (c) 2019 Eric Conlon+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/ejconlon/heart-app++library+  exposed-modules:+      Heart.App.App+      Heart.App.Logging+      Heart.App.Prelude+      Heart.App.Stats+      Heart.App.SuperPrelude+  other-modules:+      Paths_heart_app+  hs-source-dirs:+      src+  default-extensions: ConstraintKinds DataKinds DeriveFunctor DeriveFoldable DeriveGeneric DeriveTraversable DerivingStrategies FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NoImplicitPrelude OverloadedStrings Rank2Types StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds+  build-depends:+      base >=4.12 && <5+    , co-log >=0.3+    , co-log-core >=0.2+    , ekg >=0.4+    , ekg-core >=0.1+    , ekg-statsd >=0.2+    , heart-core >=0.1+    , text >=1.2+  default-language: Haskell2010

@@ -0,0 +1,46 @@+{-# LANGUAGE UndecidableInstances #-}++module Heart.App.App+  ( App (..)+  , AppWrapper (..)+  , appLogAction+  , appStore+  , HasApp (..)+  , newApp+  ) where++import Colog.Actions (richMessageAction)+import Colog.Message (Message)+import Heart.App.Logging (HasSimpleLog (..))+import Heart.App.Prelude+import Heart.App.Stats (HasStore (..), Store, newStore)++data App = App+  { _appLogAction :: !(LogAction IO Message)+  , _appStore     :: !Store+  }++$(makeLenses ''App)++class HasApp env where+  appL :: Lens' env App++instance HasApp App where+  appL = simple++instance HasSimpleLog App where+  simpleLogL = appLogAction++instance HasStore App where+  storeL = appStore++newApp :: MonadIO m => m App+newApp = App richMessageAction <$> newStore++newtype AppWrapper env = AppWrapper env++instance HasApp (AppWrapper env) => HasSimpleLog (AppWrapper env) where+  simpleLogL = appL . simpleLogL++instance HasApp (AppWrapper env) => HasStore (AppWrapper env) where+  storeL = appL . storeL

@@ -0,0 +1,50 @@+module Heart.App.Logging+  ( SimpleLogAction+  , HasSimpleLog (..)+  , WithSimpleLog+  , logMsg+  , log+  , logDebug+  , logInfo+  , logWarning+  , logError+  , logException+  ) where++import Colog.Message (Msg (..))+import qualified Data.Text as Text+import GHC.Stack (HasCallStack, callStack, withFrozenCallStack)+import Heart.App.Prelude++type SimpleLogAction = LogAction IO Message++class HasSimpleLog env where+  simpleLogL :: Lens' env SimpleLogAction++instance HasSimpleLog SimpleLogAction where+  simpleLogL = simple++type WithSimpleLog env m = (MonadIO m, MonadReader env m, HasSimpleLog env, HasCallStack)++logMsg :: WithSimpleLog env m => Message -> m ()+logMsg msg = do+  LogAction act <- view simpleLogL+  liftIO (act msg)++log :: WithSimpleLog env m => Severity -> Text -> m ()+log sev txt = withFrozenCallStack (logMsg Msg { msgStack = callStack, msgSeverity = sev, msgText = txt })++logDebug :: WithSimpleLog env m => Text -> m ()+logDebug = withFrozenCallStack (log Debug)++logInfo :: WithSimpleLog env m => Text -> m ()+logInfo = withFrozenCallStack (log Info)++logWarning :: WithSimpleLog env m => Text -> m ()+logWarning = withFrozenCallStack (log Warning)++logError :: WithSimpleLog env m => Text -> m ()+logError = withFrozenCallStack (log Error)++logException :: forall e m env . (WithSimpleLog env m, Exception e) => e -> m ()+logException = withFrozenCallStack (logError . Text.pack . displayException)

@@ -0,0 +1,11 @@+module Heart.App.Prelude+  ( module Heart.Core.Prelude+  , LogAction (..)+  , Message+  , Severity (..)+  ) where++import Colog.Core.Action (LogAction (..))+import Colog.Core.Severity (Severity (..))+import Colog.Message (Message)+import Heart.Core.Prelude

@@ -0,0 +1,60 @@+module Heart.App.Stats+  ( Counter+  , HasStore (..)+  , Server+  , Store+  , forkServer+  , killServer+  , newCounter+  , newStore+  , registerCounter+  , registerGcMetrics+  , incCounter+  , readCounter+  ) where++import Control.Concurrent (killThread)+import Data.Text.Encoding (encodeUtf8)+import Heart.App.Prelude+import System.Metrics (Store)+import qualified System.Metrics as M+import System.Metrics.Counter (Counter)+import qualified System.Metrics.Counter as C+import System.Remote.Monitoring (Server, forkServerWith, serverThreadId)++class HasStore env where+  storeL :: Lens' env Store++instance HasStore Store where+  storeL = simple++newStore :: MonadIO m => m Store+newStore = liftIO M.newStore++registerGcMetrics :: (MonadReader env m, HasStore env, MonadIO m) => m ()+registerGcMetrics = do+  store <- view storeL+  liftIO (M.registerGcMetrics store)++forkServer :: (MonadReader env m, HasStore env, MonadIO m) => Text -> Int -> m Server+forkServer host port = do+  store <- view storeL+  liftIO (forkServerWith store (encodeUtf8 host) port)++killServer :: MonadIO m => Server -> m ()+killServer server = liftIO (killThread (serverThreadId server))++newCounter :: MonadIO m => m Counter+newCounter = liftIO C.new++registerCounter :: (MonadReader env m, HasStore env, MonadIO m) => Text -> Getter env Counter -> m ()+registerCounter name lenz = do+  store <- view storeL+  v <- view lenz+  liftIO (M.registerCounter name (C.read v) store)++incCounter :: (MonadReader env m, MonadIO m) => Getter env Counter -> m ()+incCounter lenz = view lenz >>= liftIO . C.inc++readCounter :: (MonadReader env m, MonadIO m) => Getter env Counter -> m Int64+readCounter lenz = view lenz >>= liftIO . C.read

@@ -0,0 +1,11 @@+module Heart.App.SuperPrelude+  ( module Heart.Core.SuperPrelude+  , module Heart.App.App+  , module Heart.App.Logging+  , module Heart.App.Stats+  ) where++import Heart.App.App+import Heart.App.Logging+import Heart.App.Stats+import Heart.Core.SuperPrelude