├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── Readme.md ├── bower.json ├── doc └── Example.purs ├── package.json ├── psc-package.json ├── shell.nix └── src ├── Control └── Monad │ └── Logger │ ├── Class.purs │ └── Trans.purs └── Data └── Log ├── Filter.purs ├── Formatter ├── JSON.purs └── Pretty.purs ├── Level.purs ├── Message.purs └── Tag.purs /.gitignore: -------------------------------------------------------------------------------- 1 | node_modules 2 | bower_components 3 | .psc-package 4 | yarn.lock 5 | output -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # v1.3.0 2 | 3 | - Add logging functions with empty tagsets (thanks @drewolson) 4 | - Add MonadState instance (thanks @drewolson) 5 | - Add MonadLogger instances for transformers (thanks @drewolson) 6 | 7 | # v1.2.0 8 | 9 | - Add typeclass instance for `MonadRec` (thanks @Dretch) 10 | 11 | # v1.1.0 12 | 13 | - Add typeclass instances for `MonadThrow` and `MonadError` 14 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2019 Connor Prussin 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. -------------------------------------------------------------------------------- /Readme.md: -------------------------------------------------------------------------------- 1 | # Purescript Logging Monad Transformer 2 | 3 | This library provides a class for monads which can log messages, and an 4 | associated monad transformer. It also includes associated data types and 5 | utilities, like a `Message` type, log filters, and formatters. It's roughly 6 | inspired by http://hackage.haskell.org/package/monad-logger. 7 | 8 | See [doc/Example.purs](doc/Example.purs) for an example of how to use this 9 | library. 10 | 11 | ## Usage 12 | 13 | Say you have a function that returns an effect to calculate a string: 14 | 15 | ```purescript 16 | doSomething :: forall m. MonadEffect m => m String 17 | doSomething = pure "foobar!" 18 | ``` 19 | 20 | You can add logging to it by doing something like this: 21 | 22 | ```purescript 23 | doSomethingWithLog :: forall m. MonadLogger m => MonadEffect m => m String 24 | doSomethingWithLog = do 25 | debug empty "About to do something!" 26 | result <- doSomething 27 | debug (tag "Result" result) "Did the thing!" 28 | pure result 29 | ``` 30 | 31 | To resolve the logger context, pass a log handler to `runLoggerT`: 32 | 33 | ``` purescript 34 | runLoggedStuff:: forall m. MonadEffect m => m String 35 | runLoggedStuff = runLoggerT doSomethingWithLog $ prettyFormatter >=> Console.log 36 | ``` 37 | 38 | ## Levels 39 | 40 | Log levels are defined in [Data.Log.Level](src/Data/Log/Level.purs). For each 41 | level, there is an associated function in 42 | [Control.Monad.Logger.Class](src/Control/Monad/Logger/Class.purs) which will 43 | generate a timestamped `Message` of that level and pass it onto the log handler. 44 | 45 | ## Tags 46 | 47 | You can add various metadata to your log lines by using tags. You can generate 48 | tags of various types by using the functions exported from 49 | [Data.Log.Tag](src/Data/Log/Tag.purs). 50 | 51 | ## Log Handlers 52 | 53 | A log handler is just a function with the signature: 54 | 55 | ```purescript 56 | forall m. MonadEffect m => Message -> m Unit 57 | ``` 58 | 59 | The `MonadEffect` constraint is required, even if you don't do anything 60 | effectual with your log handler, because this library generates timestamps for 61 | each message. 62 | 63 | Typically you will create a log handler by passing log messages through a 64 | formatter and to something like `Console.log`. Sometimes you might want to add 65 | a message filter, if you don't want to deliver all logs to a particular target. 66 | 67 | ## Formatters 68 | 69 | Formatters map `Message` payloads to strings. There are two formatters built 70 | in: 71 | 72 | - [Data.Log.Formatter.Pretty](src/Data/Log/Formatter/Pretty.purs): generates 73 | beautiful, asci-colored strings, appropriate for a developer console log 74 | - [Data.Log.Formatter.JSON](src/Data/Log/Formatter/JSON.purs): generates compact 75 | JSON strings, appropriate for log files or piping logs through an external 76 | tool for processing 77 | 78 | ## Filters 79 | 80 | Filters are used, as the name implies, to only pass through certain messages to 81 | handler. Built-in formatters are available in 82 | [Data.Log.Filter](src/Data/Log/Filter.purs) and can be used to filter messages 83 | out by log level. 84 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-monad-logger", 3 | "homepage": "https://github.com/cprussin/purescript-monad-logger", 4 | "description": "A purescrpt logging monad transformer", 5 | "license": "MIT", 6 | "repository": { 7 | "type": "git", 8 | "url": "https://github.com/cprussin/purescript-monad-logger" 9 | }, 10 | "ignore": [ 11 | "**/.*", 12 | "docs", 13 | "*.json", 14 | "*.md" 15 | ], 16 | "dependencies": { 17 | "purescript-aff": "^5.1.0", 18 | "purescript-ansi": "^5.0.0", 19 | "purescript-argonaut-core": "^5.0.0", 20 | "purescript-arrays": "^5.2.0", 21 | "purescript-console": "^4.2.0", 22 | "purescript-control": "^4.1.0", 23 | "purescript-effect": "^2.0.1", 24 | "purescript-foldable-traversable": "^4.1.1", 25 | "purescript-foreign-object": "^2.0.1", 26 | "purescript-integers": "^4.0.0", 27 | "purescript-js-date": "^6.0.0", 28 | "purescript-maybe": "^4.0.1", 29 | "purescript-newtype": "^3.0.0", 30 | "purescript-ordered-collections": "^1.6.0", 31 | "purescript-prelude": "^4.1.0", 32 | "purescript-strings": "^4.0.1", 33 | "purescript-transformers": "^4.2.0", 34 | "purescript-tuples": "^5.1.0" 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /doc/Example.purs: -------------------------------------------------------------------------------- 1 | module Example where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Logger.Trans 6 | ( class MonadLogger 7 | , runLoggerT 8 | , trace 9 | , info 10 | , error 11 | ) 12 | import Data.JSDate (now) 13 | import Data.Log.Formatter.Pretty (prettyFormatter) 14 | import Data.Log.Filter (minimumLevel) 15 | import Data.Log.Level (LogLevel(Info)) 16 | import Data.Log.Tag 17 | ( TagSet 18 | , tag 19 | , intTag 20 | , jsDateTag 21 | , booleanTag 22 | , tagSetTag 23 | , empty 24 | ) 25 | import Effect (Effect) 26 | import Effect.Class (class MonadEffect, liftEffect) 27 | import Effect.Console (log) 28 | 29 | main :: Effect Unit 30 | main = runLoggerT logMessage $ minimumLevel Info $ prettyFormatter >=> log 31 | 32 | logMessage :: forall m. MonadLogger m => m Unit 33 | logMessage = do 34 | tags <- getTags 35 | trace empty "Almost Hello World!" 36 | info tags "Hello World!" 37 | error empty "Goodbye World!" 38 | 39 | getTags :: forall m. MonadEffect m => m TagSet 40 | getTags = do 41 | now' <- liftEffect now 42 | pure $ 43 | tag "foo" "bar" <> 44 | intTag "baz" 0 <> 45 | booleanTag "isTrue" true <> 46 | jsDateTag "starting time" now' <> 47 | tagSetTag "extra tags" ( 48 | tag "sub foo" "bar" <> 49 | intTag "sub baz" 1 <> 50 | tagSetTag "sub sub tags" ( 51 | tag "sub sub foo" "bar" <> 52 | intTag "sub sub baz" 2 53 | ) 54 | ) 55 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "private": true, 3 | "dependencies": { 4 | "bower": "^1.8.8", 5 | "pulp": "^12.3.1" 6 | } 7 | } 8 | -------------------------------------------------------------------------------- /psc-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "monad-logger", 3 | "set": "psc-0.12.3", 4 | "source": "https://github.com/purescript/package-sets.git", 5 | "depends": [ 6 | "aff", 7 | "ansi", 8 | "argonaut", 9 | "arrays", 10 | "console", 11 | "control", 12 | "effect", 13 | "foldable-traversable", 14 | "foreign-object", 15 | "integers", 16 | "js-date", 17 | "maybe", 18 | "newtype", 19 | "ordered-collections", 20 | "prelude", 21 | "strings", 22 | "transformers", 23 | "tuples" 24 | ] 25 | } 26 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | { 2 | purescript ? "0.12.4", 3 | nixjs ? fetchTarball "https://github.com/cprussin/nixjs/tarball/release-19.03", 4 | nixpkgs ? 5 | }: 6 | 7 | let 8 | nixjs-overlay = import nixjs { purescript = purescript; }; 9 | pkgs = import nixpkgs { overlays = [ nixjs-overlay ]; }; 10 | in 11 | 12 | pkgs.mkShell { 13 | buildInputs = [ 14 | pkgs.git 15 | pkgs.nodejs 16 | pkgs.yarn 17 | pkgs.purescript 18 | pkgs.psc-package 19 | ]; 20 | } 21 | -------------------------------------------------------------------------------- /src/Control/Monad/Logger/Class.purs: -------------------------------------------------------------------------------- 1 | module Control.Monad.Logger.Class 2 | ( class MonadLogger 3 | , log 4 | , trace 5 | , debug 6 | , info 7 | , warn 8 | , error 9 | ) where 10 | 11 | import Prelude 12 | 13 | import Control.Monad.Cont.Trans (ContT) 14 | import Control.Monad.Except.Trans (ExceptT) 15 | import Control.Monad.List.Trans (ListT) 16 | import Control.Monad.Maybe.Trans (MaybeT) 17 | import Control.Monad.RWS.Trans (RWST) 18 | import Control.Monad.Reader.Trans (ReaderT) 19 | import Control.Monad.State.Trans (StateT) 20 | import Control.Monad.Trans.Class (lift) 21 | import Control.Monad.Writer.Trans (WriterT) 22 | import Data.JSDate (now) 23 | import Data.Log.Level (LogLevel(Trace, Debug, Info, Warn, Error)) 24 | import Data.Log.Message (Message) 25 | import Data.Log.Tag (TagSet, empty) 26 | import Effect.Class (class MonadEffect, liftEffect) 27 | 28 | class MonadEffect m <= MonadLogger m where 29 | log :: Message -> m Unit 30 | 31 | instance monadLoggerContT :: MonadLogger m => MonadLogger (ContT a m) where 32 | log = lift <<< log 33 | 34 | instance monadLoggerExceptT :: MonadLogger m => MonadLogger (ExceptT a m) where 35 | log = lift <<< log 36 | 37 | instance monadLoggerListT :: MonadLogger m => MonadLogger (ListT m) where 38 | log = lift <<< log 39 | 40 | instance monadLoggerMaybeT :: MonadLogger m => MonadLogger (MaybeT m) where 41 | log = lift <<< log 42 | 43 | instance monadLoggerRWST :: (Monoid w, MonadLogger m) => MonadLogger (RWST r w s m) where 44 | log = lift <<< log 45 | 46 | instance monadLoggerReaderT :: MonadLogger m => MonadLogger (ReaderT a m) where 47 | log = lift <<< log 48 | 49 | instance monadLoggerStateT :: MonadLogger m => MonadLogger (StateT a m) where 50 | log = lift <<< log 51 | 52 | instance monadLoggerWriterT :: (Monoid w, MonadLogger m) => MonadLogger (WriterT w m) where 53 | log = lift <<< log 54 | 55 | log' :: forall m. MonadLogger m => LogLevel -> TagSet -> String -> m Unit 56 | log' level tags message = 57 | liftEffect now >>= log <<< { level, message, tags, timestamp: _ } 58 | 59 | trace :: forall m. MonadLogger m => TagSet -> String -> m Unit 60 | trace = log' Trace 61 | 62 | trace' :: forall m. MonadLogger m => String -> m Unit 63 | trace' = trace empty 64 | 65 | debug :: forall m. MonadLogger m => TagSet -> String -> m Unit 66 | debug = log' Debug 67 | 68 | debug' :: forall m. MonadLogger m => String -> m Unit 69 | debug' = debug empty 70 | 71 | info :: forall m. MonadLogger m => TagSet -> String -> m Unit 72 | info = log' Info 73 | 74 | info' :: forall m. MonadLogger m => String -> m Unit 75 | info' = info empty 76 | 77 | warn :: forall m. MonadLogger m => TagSet -> String -> m Unit 78 | warn = log' Warn 79 | 80 | warn' :: forall m. MonadLogger m => String -> m Unit 81 | warn' = warn empty 82 | 83 | error :: forall m. MonadLogger m => TagSet -> String -> m Unit 84 | error = log' Error 85 | 86 | error' :: forall m. MonadLogger m => String -> m Unit 87 | error' = error empty 88 | -------------------------------------------------------------------------------- /src/Control/Monad/Logger/Trans.purs: -------------------------------------------------------------------------------- 1 | module Control.Monad.Logger.Trans 2 | ( LoggerT(..) 3 | , runLoggerT 4 | , mapLoggerT 5 | , module Control.Monad.Trans.Class 6 | , module Control.Monad.Logger.Class 7 | ) where 8 | 9 | import Prelude 10 | 11 | import Effect.Class (class MonadEffect, liftEffect) 12 | import Effect.Aff.Class (class MonadAff, liftAff) 13 | import Control.Monad.Error.Class 14 | ( class MonadThrow 15 | , class MonadError 16 | , throwError 17 | , catchError 18 | ) 19 | import Control.Monad.Logger.Class 20 | ( class MonadLogger 21 | , trace 22 | , debug 23 | , info 24 | , warn 25 | , error 26 | ) 27 | import Control.Monad.Reader.Trans 28 | ( class MonadAsk 29 | , class MonadReader 30 | , ask 31 | , local 32 | ) 33 | import Control.Monad.Rec.Class 34 | ( class MonadRec 35 | , tailRecM 36 | ) 37 | import Control.Monad.State.Trans 38 | ( class MonadState 39 | , state 40 | ) 41 | import Control.Monad.Trans.Class (class MonadTrans, lift) 42 | import Data.Log.Message (Message) 43 | import Data.Newtype (class Newtype, unwrap) 44 | 45 | newtype LoggerT m a = LoggerT ((Message -> m Unit) -> m a) 46 | 47 | runLoggerT :: forall m a. LoggerT m a -> (Message -> m Unit) -> m a 48 | runLoggerT (LoggerT m) = m 49 | 50 | mapLoggerT :: forall m a b. (m a -> m b) -> LoggerT m a -> LoggerT m b 51 | mapLoggerT f (LoggerT m) = LoggerT $ f <<< m 52 | 53 | withLoggerT 54 | :: forall m a 55 | . ((Message -> m Unit) -> (Message -> m Unit)) 56 | -> LoggerT m a 57 | -> LoggerT m a 58 | withLoggerT f (LoggerT m) = LoggerT $ f >>> m 59 | 60 | derive instance newtypeLoggerT :: Newtype (LoggerT m a) _ 61 | 62 | instance functorLoggerT :: Functor m => Functor (LoggerT m) where 63 | map = map >>> mapLoggerT 64 | 65 | instance applyLoggerT :: Monad m => Apply (LoggerT m) where 66 | apply = ap 67 | 68 | instance applicativeLoggerT :: Monad m => Applicative (LoggerT m) where 69 | pure = pure >>> const >>> LoggerT 70 | 71 | instance bindLoggerT :: Monad m => Bind (LoggerT m) where 72 | bind (LoggerT m) f = LoggerT \l -> m l >>= f >>> unwrap >>> (_ $ l) 73 | 74 | instance monadLoggerT :: Monad m => Monad (LoggerT m) 75 | 76 | instance monadTransLoggerT :: MonadTrans LoggerT where 77 | lift = LoggerT <<< const 78 | 79 | instance monadEffectLoggerT :: MonadEffect m => MonadEffect (LoggerT m) where 80 | liftEffect = lift <<< liftEffect 81 | 82 | instance monadAffLoggerT :: MonadAff m => MonadAff (LoggerT m) where 83 | liftAff = lift <<< liftAff 84 | 85 | instance monadAskLoggerT :: MonadAsk r m => MonadAsk r (LoggerT m) where 86 | ask = lift ask 87 | 88 | instance monadStateLoggerT :: MonadState s m => MonadState s (LoggerT m) where 89 | state = lift <<< state 90 | 91 | instance monadReaderLoggerT :: MonadReader r m => MonadReader r (LoggerT m) where 92 | local = mapLoggerT <<< local 93 | 94 | instance monadRecLoggerT :: MonadRec m => MonadRec (LoggerT m) where 95 | tailRecM step a = 96 | LoggerT \l -> tailRecM (\a' -> unwrap (step a') l) a 97 | 98 | instance monadLoggerLoggerT :: MonadEffect m => MonadLogger (LoggerT m) where 99 | log message = LoggerT (_ $ message) 100 | 101 | instance monadThrowLoggerT :: MonadThrow e m => MonadThrow e (LoggerT m) where 102 | throwError = throwError >>> lift 103 | 104 | instance monadErrorLoggerT :: MonadError e m => MonadError e (LoggerT m) where 105 | catchError (LoggerT m) h = 106 | LoggerT \l -> catchError (m l) $ h >>> unwrap >>> (_ $ l) 107 | -------------------------------------------------------------------------------- /src/Data/Log/Filter.purs: -------------------------------------------------------------------------------- 1 | module Data.Log.Filter 2 | ( minimumLevel 3 | , maximumLevel 4 | , onlyLevel 5 | ) where 6 | 7 | import Prelude 8 | 9 | import Data.Log.Level (LogLevel) 10 | import Data.Log.Message (Message) 11 | import Effect.Class (class MonadEffect) 12 | 13 | type LogFilter m = (Message -> m Unit) -> Message -> m Unit 14 | 15 | filterLevel 16 | :: forall m 17 | . MonadEffect m 18 | => (LogLevel -> LogLevel -> Boolean) 19 | -> LogLevel 20 | -> LogFilter m 21 | filterLevel op level logger message = 22 | if message.level `op` level 23 | then logger message 24 | else pure unit 25 | 26 | minimumLevel :: forall m. MonadEffect m => LogLevel -> LogFilter m 27 | minimumLevel = filterLevel (>=) 28 | 29 | maximumLevel :: forall m. MonadEffect m => LogLevel -> LogFilter m 30 | maximumLevel = filterLevel (<=) 31 | 32 | onlyLevel :: forall m. MonadEffect m => LogLevel -> LogFilter m 33 | onlyLevel = filterLevel (==) 34 | -------------------------------------------------------------------------------- /src/Data/Log/Formatter/JSON.purs: -------------------------------------------------------------------------------- 1 | module Data.Log.Formatter.JSON 2 | ( jsonFormatter 3 | ) where 4 | 5 | import Prelude 6 | 7 | import Data.Argonaut.Core 8 | ( Json 9 | , fromObject 10 | , fromString 11 | , fromNumber 12 | , fromBoolean 13 | , stringify 14 | ) 15 | import Data.Int (toNumber) 16 | import Data.JSDate (getTime) 17 | import Data.Log.Level (LogLevel(Trace, Debug, Info, Warn, Error)) 18 | import Data.Log.Message (Message) 19 | import Data.Log.Tag 20 | ( TagSet 21 | , Tag(StringTag, NumberTag, IntTag, BooleanTag, JSDateTag, TagSetTag) 22 | , fromArray 23 | , tag 24 | , intTag 25 | , jsDateTag 26 | , tagSetTag 27 | , empty 28 | ) 29 | import Data.Map (toUnfoldable, isEmpty) 30 | import Data.Tuple (Tuple) 31 | import Foreign.Object (fromFoldable) 32 | 33 | jsonFormatter :: Message -> String 34 | jsonFormatter = buildPayload >>> toJson >>> stringify 35 | 36 | buildPayload :: Message -> TagSet 37 | buildPayload { level, timestamp, message, tags } = fromArray $ 38 | [ intTag "level" $ levelCode level 39 | , jsDateTag "ts" timestamp 40 | , tag "message" message 41 | , if isEmpty tags then empty else tagSetTag "tags" tags 42 | ] 43 | 44 | toJson :: TagSet -> Json 45 | toJson set = fromObject $ fromFoldable $ jsonify set 46 | 47 | jsonify :: TagSet -> Array (Tuple String Json) 48 | jsonify set = toUnfoldable $ fieldToJson <$> set 49 | 50 | fieldToJson :: Tag -> Json 51 | fieldToJson (StringTag value) = fromString value 52 | fieldToJson (IntTag value) = fromNumber $ toNumber value 53 | fieldToJson (NumberTag value) = fromNumber value 54 | fieldToJson (BooleanTag value) = fromBoolean value 55 | fieldToJson (JSDateTag value) = fromNumber $ getTime value 56 | fieldToJson (TagSetTag value) = toJson value 57 | 58 | levelCode :: LogLevel -> Int 59 | levelCode Trace = 0 60 | levelCode Debug = 1 61 | levelCode Info = 2 62 | levelCode Warn = 3 63 | levelCode Error = 4 64 | -------------------------------------------------------------------------------- /src/Data/Log/Formatter/Pretty.purs: -------------------------------------------------------------------------------- 1 | module Data.Log.Formatter.Pretty 2 | ( prettyFormatter 3 | ) where 4 | 5 | import Prelude 6 | 7 | import Ansi.Codes (Color(BrightBlack, Cyan, Blue, White, Yellow, Red)) 8 | import Ansi.Output (foreground, withGraphics, bold) 9 | import Control.Plus (empty) 10 | import Data.Array (concat, cons, singleton) 11 | import Data.Map (toUnfoldable, isEmpty) 12 | import Data.Maybe (Maybe(Nothing, Just), fromMaybe) 13 | import Data.JSDate (JSDate, toISOString) 14 | import Data.Log.Level (LogLevel(Trace, Debug, Info, Warn, Error)) 15 | import Data.Log.Message (Message) 16 | import Data.Log.Tag 17 | ( TagSet 18 | , Tag(StringTag, NumberTag, IntTag, BooleanTag, JSDateTag, TagSetTag) 19 | ) 20 | import Data.String (joinWith) 21 | import Data.Traversable (sequence) 22 | import Data.Tuple (Tuple(Tuple)) 23 | import Effect.Class (class MonadEffect, liftEffect) 24 | 25 | prettyFormatter :: forall m. MonadEffect m => Message -> m String 26 | prettyFormatter message = 27 | append <$> showMainLine message <*> showTags message.tags 28 | 29 | showMainLine :: forall m. MonadEffect m => Message -> m String 30 | showMainLine { level, timestamp, message } = 31 | liftEffect $ toISOString timestamp <#> \ts -> 32 | joinWith " " 33 | [ showLevel level 34 | , color BrightBlack ts 35 | , color Cyan message 36 | ] 37 | 38 | showLevel :: LogLevel -> String 39 | showLevel Trace = color Cyan "[TRACE]" 40 | showLevel Debug = color Blue "[DEBUG]" 41 | showLevel Info = color White "[INFO]" 42 | showLevel Warn = color Yellow "[WARN]" 43 | showLevel Error = color Red "[ERROR]" 44 | 45 | showTags :: forall m. MonadEffect m => TagSet -> m String 46 | showTags = tagLines >>> case _ of 47 | Nothing -> pure "" 48 | Just lines -> lines <#> joinWith "\n" >>> append "\n" 49 | 50 | tagLines :: forall m. MonadEffect m => TagSet -> Maybe (m (Array String)) 51 | tagLines tags 52 | | isEmpty tags = empty 53 | | otherwise = pure $ indentEachLine <$> concat <$> lineify tags 54 | 55 | lineify :: forall m. MonadEffect m => TagSet -> m (Array (Array String)) 56 | lineify tags = sequence $ showField <$> toUnfoldable tags 57 | 58 | showField :: forall m. MonadEffect m => Tuple String Tag -> m (Array String) 59 | showField (Tuple name value) = showTag value $ bold' name <> bold' ": " 60 | 61 | showTag :: forall m. MonadEffect m => Tag -> String -> m (Array String) 62 | showTag (StringTag value) = showBasic value 63 | showTag (IntTag value) = showSpecial $ show value 64 | showTag (NumberTag value) = showSpecial $ show value 65 | showTag (BooleanTag value) = showSpecial $ show value 66 | showTag (TagSetTag value) = showSubTags value 67 | showTag (JSDateTag value) = showJsDate value 68 | 69 | showSubTags :: forall m. MonadEffect m => TagSet -> String -> m (Array String) 70 | showSubTags value label = cons label <$> fromMaybe (pure []) (tagLines value) 71 | 72 | showJsDate :: forall m. MonadEffect m => JSDate -> String -> m (Array String) 73 | showJsDate value label = 74 | liftEffect $ toISOString value >>= flip showSpecial label 75 | 76 | showBasic :: forall m. Applicative m => String -> String -> m (Array String) 77 | showBasic value label = pure $ singleton $ label <> value 78 | 79 | showSpecial :: forall m. Applicative m => String -> String -> m (Array String) 80 | showSpecial = color Yellow >>> showBasic 81 | 82 | indentEachLine :: forall m. Functor m => m String -> m String 83 | indentEachLine = map $ append " " 84 | 85 | color :: Color -> String -> String 86 | color = foreground >>> withGraphics 87 | 88 | bold' :: String -> String 89 | bold' = withGraphics bold 90 | -------------------------------------------------------------------------------- /src/Data/Log/Level.purs: -------------------------------------------------------------------------------- 1 | module Data.Log.Level 2 | ( LogLevel(..) 3 | ) where 4 | 5 | import Prelude 6 | 7 | data LogLevel = Trace | Debug | Info | Warn | Error 8 | derive instance eqLogLevel :: Eq LogLevel 9 | derive instance ordLogLevel :: Ord LogLevel 10 | -------------------------------------------------------------------------------- /src/Data/Log/Message.purs: -------------------------------------------------------------------------------- 1 | module Data.Log.Message 2 | ( Message 3 | ) where 4 | 5 | import Data.JSDate (JSDate) 6 | import Data.Log.Level (LogLevel) 7 | import Data.Log.Tag (TagSet) 8 | 9 | type Message = 10 | { level :: LogLevel 11 | , timestamp :: JSDate 12 | , message :: String 13 | , tags :: TagSet 14 | } 15 | -------------------------------------------------------------------------------- /src/Data/Log/Tag.purs: -------------------------------------------------------------------------------- 1 | module Data.Log.Tag 2 | ( TagSet 3 | , Tag(..) 4 | , tag 5 | , intTag 6 | , numberTag 7 | , booleanTag 8 | , jsDateTag 9 | , tagSetTag 10 | , fromArray 11 | , module Data.Map 12 | ) where 13 | 14 | import Prelude 15 | 16 | import Data.JSDate (JSDate) 17 | import Data.Map (Map, singleton, unions, empty) 18 | 19 | data Tag 20 | = StringTag String 21 | | NumberTag Number 22 | | IntTag Int 23 | | BooleanTag Boolean 24 | | JSDateTag JSDate 25 | | TagSetTag TagSet 26 | 27 | type TagSet = Map String Tag 28 | 29 | mkTagType :: forall m. (m -> Tag) -> String -> m -> TagSet 30 | mkTagType tagger name = tagger >>> singleton name 31 | 32 | tag :: String -> String -> TagSet 33 | tag = mkTagType StringTag 34 | 35 | intTag :: String -> Int -> TagSet 36 | intTag = mkTagType IntTag 37 | 38 | numberTag :: String -> Number -> TagSet 39 | numberTag = mkTagType NumberTag 40 | 41 | booleanTag :: String -> Boolean -> TagSet 42 | booleanTag = mkTagType BooleanTag 43 | 44 | jsDateTag :: String -> JSDate -> TagSet 45 | jsDateTag = mkTagType JSDateTag 46 | 47 | tagSetTag :: String -> TagSet -> TagSet 48 | tagSetTag = mkTagType TagSetTag 49 | 50 | fromArray :: Array TagSet -> TagSet 51 | fromArray = unions 52 | --------------------------------------------------------------------------------