baa7dea · typeable/stupid-logging

git.iko.soy/typeable/stupid-logging

Initial.

commitbaa7dea94a87935b54d8792cd6107c75750c0c40 authorNick <nick@typeable.io> dateFri 17 Nov 2023, 10:40 (3 years ago)

8 files changed+168

unifiedsplit

LICENSE+20 src/System/Logging.hs+9 src/System/Logging/JSON.hs+25 src/System/Logging/Plain.hs+17 src/System/Logging/Types.hs+29 src/System/Logging/Utils.hs+24 stack.yaml+8 stupid-logging.cabal+36

LICENSEnew file+20

@@ -0,0 +1,20 @@

3+Permission is hereby granted, free of charge, to any person obtaining

4+a copy of this software and associated documentation files (the

5+"Software"), to deal in the Software without restriction, including

6+without limitation the rights to use, copy, modify, merge, publish,

7+distribute, sublicense, and/or sell copies of the Software, and to

8+permit persons to whom the Software is furnished to do so, subject to

9+the following conditions:

10+

11+The above copyright notice and this permission notice shall be included

12+in all copies or substantial portions of the Software.

13+

14+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,

15+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF

16+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.

17+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY

18+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,

19+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE

20+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

src/System/Logging.hsnew file+9

@@ -0,0 +1,9 @@

1+{-# LANGUAGE CPP #-}

2+module System.Logging (module Export) where

4+#ifdef WITHJSON

5+import System.Logging.JSON as Export

6+#endif

7+import System.Logging.Plain as Export

8+import System.Logging.Types as Export

src/System/Logging/JSON.hsnew file+25

@@ -0,0 +1,25 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+module System.Logging.JSON where

4+import Control.Monad.IO.Class

5+import Data.Aeson (ToJSON(..), Value(..), (.=), object, encode)

6+import Data.ByteString.Lazy.Char8 as ByteString

7+import System.Logging.Types

9+instance ToJSON Priority where

10+ toJSON p =

11+ String $ case p of

12+ Debug -> "debug"

13+ Info -> "info"

14+ Warning -> "warning"

15+ Error -> "error"

16+ Critical -> "critical"

17+

18+instance ToJSON ctx => ToJSON (LogEntry ctx) where

19+ toJSON e = object [ "priority" .= e.priority

20+ , "text" .= e.text

21+ , "context" .= e.context

22+ ]

23+

24+jsonLogToStdout :: (MonadIO m, ToJSON ctx) => LogEntry ctx -> m ()

25+jsonLogToStdout = liftIO . ByteString.putStrLn . encode

src/System/Logging/Plain.hsnew file+17

@@ -0,0 +1,17 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+module System.Logging.Plain where

4+import Control.Monad.IO.Class

5+import Data.Text (Text)

6+import Data.Text qualified as Text

7+import Data.Text.IO qualified as Text

8+import System.Logging.Types

10+formatMsg :: Show ctx => LogEntry ctx -> Text

11+formatMsg msg = Text.unlines [ "[" <> Text.pack (show msg.priority) <> "]"

12+ , msg.text

13+ , "Context: " <> Text.pack (show msg.context)

14+ ]

15+

16+msgToStdout :: (MonadIO m, Show ctx) => LogEntry ctx -> m ()

17+msgToStdout = liftIO . Text.putStr . formatMsg

src/System/Logging/Types.hsnew file+29

@@ -0,0 +1,29 @@

1+{-# LANGUAGE TypeFamilies #-}

2+module System.Logging.Types where

4+import Data.Kind

5+import Data.Text (Text)

7+data Priority = Debug

8+ | Info

9+ | Warning

10+ | Error

11+ | Critical

12+ deriving (Eq, Ord, Enum)

13+

14+instance Show Priority where

15+ show Debug = "DEBUG"

16+ show Info = "INFO"

17+ show Warning = "WARNING"

18+ show Error = "ERROR"

19+ show Critical = "CRITICAL"

20+

21+data LogEntry ctx = LogEntry { text :: !Text

22+ , priority :: !Priority

23+ , context :: !ctx

24+ }

25+

26+class Monad m => Log (m :: Type -> Type) where

27+ type LogContext m

28+ createContext :: m (LogContext m)

29+ logEntry :: LogEntry (LogContext m) -> m ()

src/System/Logging/Utils.hsnew file+24

@@ -0,0 +1,24 @@

1+module System.Logging.Utils where

3+import Data.Text

4+import System.Logging.Types

6+withContext :: Log m => (LogContext m -> m a) -> m a

7+withContext f = do ctx <- createContext

8+ f ctx

10+logMessage :: Log m => Priority -> Text -> m ()

11+logMessage p t =

12+ withContext $ \ctx ->

13+ let e = LogEntry { text = t

14+ , priority = p

15+ , context = ctx

16+ }

17+ in logEntry e

18+

19+logDebug, logInfo, logWarn, logError, logCritical :: Log m => Text -> m ()

20+logDebug = logMessage Debug

21+logInfo = logMessage Info

22+logWarn = logMessage Warning

23+logError = logMessage Error

24+logCritical = logMessage Critical

stack.yamlnew file+8

@@ -0,0 +1,8 @@

1+resolver: lts-21.20

3+packages:

4+- .

6+flags:

7+ stupid-logging:

8+ json: true

stupid-logging.cabalnew file+36

@@ -0,0 +1,36 @@

1+cabal-version: 3.0

2+name: stupid-logging

3+version: 0.1

4+synopsis: Do logging in a very stupid way

5+-- description:

6+license: MIT

7+license-file: LICENSE

8+author: Nick

9+maintainer: nick@typeable.io

10+copyright: Typeable.io

11+category: System

12+build-type: Simple

13+

14+flag json

15+ description: Enable JSON logging support with aeson

16+ default: False

17+ manual: True

18+

19+common warnings

20+ ghc-options: -Wall -Wno-orphans

21+

22+library

23+ import: warnings

24+ exposed-modules: System.Logging

25+ other-modules: System.Logging.Plain

26+ System.Logging.Types

27+ default-extensions: OverloadedRecordDot

28+ build-depends: base >=4.16 && < 5.0

29+ , text

30+ if flag(json)

31+ other-modules: System.Logging.JSON

32+ build-depends: aeson

33+ , bytestring

34+ cpp-options: -DWITHJSON

35+ hs-source-dirs: src

36+ default-language: GHC2021