packages feed

gore-and-ash-logging (empty) → 1.1.0.0

raw patch · 7 files changed

+360/−0 lines, 7 filesdep +basedep +containersdep +deepseqsetup-changed

Dependencies added: base, containers, deepseq, exceptions, gore-and-ash, mtl, text, text-show, transformers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Gushcha Anton (c) 2015-2016++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  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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ gore-and-ash-logging.cabal view
@@ -0,0 +1,42 @@+name:                gore-and-ash-logging+version:             1.1.0.0+synopsis:            Core module for gore-and-ash with logging utilities+description:         Please see README.md+homepage:            https://github.com/Teaspot-Studio/gore-and-ash-logging+license:             BSD3+license-file:        LICENSE+author:              Anton Gushcha+maintainer:          ncrashed@gmail.com+copyright:           2015-2016 Anton Gushcha+category:            Game+build-type:          Simple+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Game.GoreAndAsh.Logging+                       Game.GoreAndAsh.Logging.API+                       Game.GoreAndAsh.Logging.Module+                       Game.GoreAndAsh.Logging.State++  default-language:    Haskell2010+  build-depends:       base >= 4.7 && < 5+                     , containers >= 0.5.6+                     , deepseq >= 1.4+                     , exceptions >= 0.8.0.2+                     , gore-and-ash >= 1.1.0.0+                     , mtl >= 2.2+                     , text >= 1.2.1+                     , text-show >= 2+                     , transformers >= 0.4.2+                     +  default-extensions:  +                       DataKinds+                       DeriveGeneric+                       FlexibleInstances+                       GeneralizedNewtypeDeriving+                       MultiParamTypeClasses+                       OverloadedStrings+                       RecordWildCards+                       TypeFamilies+                       UndecidableInstances
+ src/Game/GoreAndAsh/Logging.hs view
@@ -0,0 +1,74 @@+{-|+Module      : Game.GoreAndAsh.Logging+Description : Module that contains all logging API for Gore&Ash+Copyright   : (c) Anton Gushcha, 2015-2016+License     : BSD3+Maintainer  : ncrashed@gmail.com+Stability   : experimental+Portability : POSIX++The module contains all API for Gore&Ash logging module. The module doesn't depends on+others core modules and could be place in any place in game monad stack.++The core module is pure on it first phase and could be used with 'Identity' end monad.+See 'ModuleStack' documentation.++Example of embedding:++@+-- | Application monad is monad stack build from given list of modules over base monad (IO)+type AppStack = ModuleStack [LoggingT, ... other modules ... ] IO+newtype AppState = AppState (ModuleState AppStack)+  deriving (Generic)++instance NFData AppState ++-- | Wrapper around type family+newtype AppMonad a = AppMonad (AppStack a)+  deriving (Functor, Applicative, Monad, MonadFix, MonadIO, LoggingMonad, ... other modules monads ... )+  +instance GameModule AppMonad AppState where +  type ModuleState AppMonad = AppState+  runModule (AppMonad m) (AppState s) = do +    (a, s') <- runModule m s +    return (a, AppState s')+  newModuleState = AppState <$> newModuleState+  withModule _ = withModule (Proxy :: Proxy AppStack)+  cleanupModule (AppState s) = cleanupModule s ++-- | Arrow that is build over the monad stack+type AppWire a b = GameWire AppMonad a b+@+playerActor :: ActorMonad m => (PlayerId -> Player) -> GameActor m PlayerId Game Player +playerActor initialPlayer = makeActor $ \i -> stateWire (initialPlayer i) $ mainController i+  where+  mainController i = proc (g, p) -> do+    +@+-}+module Game.GoreAndAsh.Logging(+  -- * Low-level API+    LoggingState+  , LoggingT+  , LoggingMonad(..)+  -- * Arrow API+  , logA+  , logALn+  , logE+  , logELn+  -- ** Every frame+  , logInfoA+  , logWarnA+  , logErrorA+  -- ** Event based+  , logInfoE+  , logWarnE+  , logErrorE+  -- ** Event tracing+  , traceEvent+  , traceEventShow+  ) where++import Game.GoreAndAsh.Logging.API+import Game.GoreAndAsh.Logging.Module +import Game.GoreAndAsh.Logging.State
+ src/Game/GoreAndAsh/Logging/API.hs view
@@ -0,0 +1,114 @@+{-|+Module      : Game.GoreAndAsh.Module+Description : Module that contains monadic and arrow API of logging module.+Copyright   : (c) Anton Gushcha, 2015-2016+License     : BSD3+Maintainer  : ncrashed@gmail.com+Stability   : experimental+Portability : POSIX++Module that contains monadic and arrow API of logging module.+-}+module Game.GoreAndAsh.Logging.API(+    LoggingMonad(..)+  -- * Arrow API+  , logA+  , logALn+  , logE+  , logELn++  -- ** Every frame+  , logInfoA+  , logWarnA+  , logErrorA+  -- ** Event based+  , logInfoE+  , logWarnE+  , logErrorE++  -- ** Event tracing+  , traceEvent+  , traceEventShow+  ) where++import Control.Monad.State.Strict+import Control.Wire+import Data.Text+import Prelude hiding (id, (.))+import qualified Data.Sequence as S +import TextShow ++import Game.GoreAndAsh+import Game.GoreAndAsh.Logging.State+import Game.GoreAndAsh.Logging.Module++-- | Low level API for module+class Monad m => LoggingMonad m where +  -- | Put message to the console.+  putMsgM :: Text -> m ()+  -- | Put message and new line to the console.+  putMsgLnM :: Text -> m ()++instance {-# OVERLAPPING #-} Monad m => LoggingMonad (LoggingT s m) where+  putMsgM t = do +    cntx <- get +    let newMsgs = case S.viewr $ loggingMsgs cntx of +          S.EmptyR -> loggingMsgs cntx S.|> t+          (s' S.:> t') -> s' S.|> (t' <> t)+    put $ cntx { loggingMsgs = newMsgs }++  putMsgLnM t = do +    cntx <- get +    put $ cntx { loggingMsgs = loggingMsgs cntx S.|> t }++instance {-# OVERLAPPABLE #-} (Monad (mt m), LoggingMonad m, MonadTrans mt) => LoggingMonad (mt m) where +  putMsgM = lift . putMsgM+  putMsgLnM = lift . putMsgLnM++-- | Put message to console on every frame without newline+logA :: LoggingMonad m => GameWire m Text ()+logA = liftGameMonad1 putMsgM++-- | Put message to console on every frame+logALn :: LoggingMonad m => GameWire m Text ()+logALn = liftGameMonad1 putMsgLnM++-- | Put message to console on event without newline+logE :: LoggingMonad m => GameWire m (Event Text) (Event ())+logE = liftGameMonadEvent1 putMsgM++-- | Put message to console on event+logELn :: LoggingMonad m => GameWire m (Event Text) (Event ())+logELn = liftGameMonadEvent1 putMsgLnM++-- | Put info msg to console+logInfoA :: LoggingMonad m => GameWire m Text ()+logInfoA = logALn . arr ("Info: " <>)++-- | Put warn msg to console+logWarnA :: LoggingMonad m => GameWire m Text ()+logWarnA = logALn . arr ("Info: " <>)++-- | Put error msg to console+logErrorA :: LoggingMonad m => GameWire m Text ()+logErrorA = logALn . arr ("Info: " <>)++-- | Put info msg to console on event+logInfoE :: LoggingMonad m => GameWire m (Event Text) (Event ())+logInfoE = logELn . mapE ("Info: " <>)++-- | Put warn msg to console on event+logWarnE :: LoggingMonad m => GameWire m (Event Text) (Event ())+logWarnE = logELn . mapE ("Info: " <>)++-- | Put error msg to console on event+logErrorE :: LoggingMonad m => GameWire m (Event Text) (Event ())+logErrorE = logELn . mapE ("Info: " <>)++-- | Prints event with given function+traceEvent :: LoggingMonad m => (a -> Text) -> GameWire m (Event a) (Event ())+traceEvent f = logELn . mapE f++-- | Prints event +traceEventShow :: (TextShow a, LoggingMonad m) => GameWire m (Event a) (Event ())+traceEventShow = traceEvent showt
+ src/Game/GoreAndAsh/Logging/Module.hs view
@@ -0,0 +1,69 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-|+Module      : Game.GoreAndAsh.Logging.Module+Description : Monad transformer for logging module+Copyright   : (c) Anton Gushcha, 2015-2016+License     : BSD3+Maintainer  : ncrashed@gmail.com+Stability   : experimental+Portability : POSIX++Contains description of logging monad transformer and instance for+'GameModule' class.+-}+module Game.GoreAndAsh.Logging.Module(+    LoggingT(..)+  ) where++import Control.Monad.Catch+import Control.Monad.Fix +import Control.Monad.State.Strict+import qualified Data.Sequence as S+import qualified Data.Text.IO as T++import Game.GoreAndAsh+import Game.GoreAndAsh.Logging.State++-- | Monad transformer of logging core module.+--+-- [@s@] - State of next core module in modules chain;+--+-- [@m@] - Next monad in modules monad stack;+--+-- [@a@] - Type of result value;+--+-- How to embed module:+-- +-- @+-- type AppStack = ModuleStack [LoggingT, ... other modules ... ] IO+--+-- newtype AppMonad a = AppMonad (AppStack a)+--   deriving (Functor, Applicative, Monad, MonadFix, MonadIO, LoggingMonad)+-- @+--+-- The module is pure within first phase (see 'ModuleStack' docs) and could be used+-- with 'Identity' end monad.+newtype LoggingT s m a = LoggingT { runLoggingT :: StateT (LoggingState s) m a }+  deriving (Functor, Applicative, Monad, MonadState (LoggingState s), MonadFix, MonadTrans, MonadIO, MonadThrow, MonadCatch, MonadMask)++instance GameModule m s => GameModule (LoggingT s m) (LoggingState s) where +  type ModuleState (LoggingT s m) = LoggingState s+  runModule (LoggingT m) s = do+    ((a, s'), nextState) <- runModule (runStateT m s) (loggingNextState s)+    printAllMsgs s'+    return (a, s' { +        loggingMsgs = S.empty+      , loggingNextState = nextState +      })+    where +      printAllMsgs LoggingState{..} = liftIO $ mapM_ T.putStrLn loggingMsgs      ++  newModuleState = do+    s <- newModuleState+    return $ LoggingState {+        loggingMsgs = S.empty+      , loggingNextState = s+      }++  withModule _ = id+  cleanupModule _ = return ()
+ src/Game/GoreAndAsh/Logging/State.hs view
@@ -0,0 +1,29 @@+{-|+Module      : Game.GoreAndAsh.Logging.State+Description : State of logging core module+Copyright   : (c) Anton Gushcha, 2015-2016+License     : BSD3+Maintainer  : ncrashed@gmail.com+Stability   : experimental+Portability : POSIX++Contains description of state for logging core module.+-}+module Game.GoreAndAsh.Logging.State(+    LoggingState(..)+  ) where++import qualified Data.Sequence as S+import Data.Text +import GHC.Generics (Generic)+import Control.DeepSeq ++-- | Inner state of logger.+--+-- [@s@] next state, states of modules are chained via nesting+data LoggingState s = LoggingState {+  loggingMsgs :: !(S.Seq Text)+, loggingNextState :: !s+} deriving (Generic)++instance NFData s => NFData (LoggingState s)