Broke di library into: df1, di, di-core, di-handle, di-monad, di-df1

.travis.yml

@@ -1,3 +1,3 @@
 language: nix
-script: nix build -f ./release.nix --argstr nixpkgs /nix/var/nix/profiles/per-user/root/channels/nixpkgs di
+script: nix build -f ./release.nix --argstr nixpkgs /nix/var/nix/profiles/per-user/root/channels/nixpkgs
 

df1/CHANGELOG.md

@@ -0,0 +1,4 @@
+# Version 0.1
+
+Consider this a preview release: The API is likely to stay stable, but extensive
+testing, formalization and tooling is due.

df1/LICENSE.txt

@@ -0,0 +1,30 @@
+Copyright (c) 2018, Renzo Carbonara
+
+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 Renzo Carbonara 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.

df1/README.md

@@ -0,0 +1,14 @@
+# df1
+
+Hierarchical structured logging format. Easy for humans, fast for computers.
+
+This library provides types, parsers and renderers for `df1`.
+
+Consider this a preview release: The API is likely to stay stable, but extensive
+testing, formalization and tooling is due.
+
+[![Build Status](https://travis-ci.org/k0001/di.svg?branch=master)](https://travis-ci.org/k0001/di)
+
+See the [BSD3 LICENSE](https://github.com/k0001/di/blob/master/df1/LICENSE.txt)
+file to learn about the legal terms and conditions for this library.
+

df1/Setup.hs

@@ -0,0 +1,4 @@
+#! /usr/bin/env nix-shell
+#! nix-shell ./shell.nix -i runghc
+import Distribution.Simple
+main = defaultMain

df1/default.nix

@@ -0,0 +1 @@
+(import ../release.nix {}).df1

df1/df1.cabal

@@ -0,0 +1,48 @@
+name: df1
+version: 0.1
+author: Renzo Carbonara
+maintainer: renλren.zone
+copyright: Renzo Carbonara 2018
+license: BSD3
+license-file: LICENSE.txt
+extra-source-files: README.md CHANGELOG.md
+category: Logging
+build-type: Simple
+cabal-version: >=1.18
+synopsis: Type, render and parse the df1 hierarchical structured log format
+description:
+  Type, render and parse logs in /df1/ format, a hierarchical structured
+  log format that is easy for humans and fast for computers.
+homepage: https://github.com/k0001/di
+bug-reports: https://github.com/k0001/di/issues
+
+library
+  hs-source-dirs: lib
+  default-language: Haskell2010
+  exposed-modules: Df1
+  other-modules: Df1.Render Df1.Parse Df1.Types
+  build-depends:
+    attoparsec,
+    base >=4.9 && <5.0,
+    bytestring,
+    containers,
+    text,
+    time
+  ghcjs-options: -Wall -O3
+  ghc-options: -Wall -O2
+
+test-suite test
+  default-language: Haskell2010
+  type: exitcode-stdio-1.0
+  hs-source-dirs: test
+  main-is: Main.hs
+  build-depends:
+    attoparsec,
+    base,
+    bytestring,
+    df1,
+    QuickCheck,
+    text,
+    time,
+    tasty,
+    tasty-quickcheck

df1/lib/Df1.hs

@@ -0,0 +1,25 @@
+-- | This module exports tools for typing, parsing, and rendering logs in the
+-- /df1/ hierarchical structured logging format.
+--
+-- Consider this a preview release: The API is likely to stay stable, but
+-- extensive testing, formalization and tooling is due.
+module Df1
+ ( -- * Types
+   T.Log(Log, log_time, log_level, log_path, log_message)
+ , T.Level(Debug, Info, Notice, Warning, Error, Critical, Alert, Emergency)
+ , T.Path(Attr, Push)
+ , T.Segment, T.unSegment, T.segment
+ , T.Key, T.unKey, T.key
+ , T.Value, T.unValue, T.value
+ , T.Message, T.unMessage, T.message
+   -- * Parsing
+ , P.parse
+   -- * Rendering
+ , R.render
+ , R.renderColor
+ ) where
+
+import qualified Df1.Parse as P
+import qualified Df1.Render as R
+import qualified Df1.Types as T
+

df1/lib/Df1/Parse.hs

@@ -0,0 +1,199 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Df1.Parse
+ ( parse
+ ) where
+
+import Control.Applicative ((<|>), many, empty)
+import Data.Bits (shiftL)
+import qualified Data.Sequence as Seq
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as BL
+import Data.Function (fix)
+import Data.Functor (($>))
+import qualified Data.Attoparsec.ByteString as AB
+import qualified Data.Attoparsec.ByteString.Lazy as ABL
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TL
+import qualified Data.Time as Time
+import qualified Data.Time.Clock.System as Time
+import Data.Word (Word8, Word16, Word32)
+
+import Df1.Types
+ (Log(Log, log_time, log_level, log_path, log_message),
+  Level(Debug, Info, Notice, Warning, Error, Critical, Alert, Emergency),
+  Path(Attr, Push),
+  Segment, segment,
+  Key, key,
+  Value, value,
+  Message, message)
+
+--------------------------------------------------------------------------------
+
+-- | If sucessful, parsing will stop after the first CR or LF newline marker if
+-- any, otherwise it will consume all input.
+parse :: AB.Parser Log
+{-# INLINABLE parse #-}
+parse = (AB.<?> "parse") $ do
+  t <- AB.skipWhile (== 32) *> pIso8601
+  p <- AB.skipWhile (== 32) *> pPath
+  l <- AB.skipWhile (== 32) *> pLevel
+  m <- AB.skipWhile (== 32) *> pMessage
+  pure (Log { log_time = Time.utcToSystemTime t
+            , log_level = l, log_path = p, log_message = m })
+
+pIso8601 :: AB.Parser Time.UTCTime
+{-# INLINABLE pIso8601 #-}
+pIso8601 = (AB.<?> "pIso8601") $ do
+  year <- (pNum4Digits AB.<?> "year") <* (AB.skip (== 45) AB.<?> "-")
+  month <- (pNum2Digits AB.<?> "month") <* (AB.skip (== 45) AB.<?> "-")
+  day <- (pNum2Digits AB.<?> "day") <* (AB.skip (== 84) AB.<?> "T")
+  Just tday <- pure (Time.fromGregorianValid
+     (fromIntegral year) (fromIntegral month) (fromIntegral day))
+  hour <- (pNum2Digits AB.<?> "hour") <* (AB.skip (== 58) AB.<?> ":")
+  min' <- (pNum2Digits AB.<?> "minute") <* (AB.skip (== 58) AB.<?> ":")
+  sec <- (pNum2Digits AB.<?> "second") <* (AB.skip (== 46) AB.<?> ".")
+  nsec <- (pNum9Digits AB.<?> "nanosecond") <* (AB.skip (== 90) AB.<?> "Z")
+  Just ttod <- pure (Time.makeTimeOfDayValid
+     (fromIntegral hour) (fromIntegral min')
+     (fromIntegral sec + (fromIntegral nsec / 1000000000)))
+  pure (Time.UTCTime tday (Time.timeOfDayToTime ttod))
+
+pNum1Digit :: AB.Parser Word8
+{-# INLINE pNum1Digit #-}
+pNum1Digit = AB.satisfyWith (subtract 48) (< 10) AB.<?> "pNum1Digit"
+
+pNum2Digits :: AB.Parser Word8
+{-# INLINE pNum2Digits #-}
+pNum2Digits = (AB.<?> "pNum2Digits") $ do
+  (+) <$> fmap (* 10) pNum1Digit <*> pNum1Digit
+
+pNum4Digits :: AB.Parser Word16
+{-# INLINE pNum4Digits #-}
+pNum4Digits = (AB.<?> "pNum4Digits") $ do
+  (\a b c d -> a + b + c + d)
+     <$> fmap ((* 1000) . fromIntegral) pNum1Digit
+     <*> fmap ((* 100) . fromIntegral) pNum1Digit
+     <*> fmap ((* 10) . fromIntegral) pNum1Digit
+          <*> fmap fromIntegral pNum1Digit
+
+pNum9Digits :: AB.Parser Word32
+{-# INLINE pNum9Digits #-}
+pNum9Digits = (AB.<?> "pNum9Digits") $ do
+  (\a b c d e f g h i -> a + b + c + d + e + f + g + h + i)
+     <$> fmap ((* 100000000) . fromIntegral) pNum1Digit
+     <*> fmap ((* 10000000) . fromIntegral) pNum1Digit
+     <*> fmap ((* 1000000) . fromIntegral) pNum1Digit
+     <*> fmap ((* 100000) . fromIntegral) pNum1Digit
+     <*> fmap ((* 10000) . fromIntegral) pNum1Digit
+     <*> fmap ((* 1000) . fromIntegral) pNum1Digit
+     <*> fmap ((* 100) . fromIntegral) pNum1Digit
+     <*> fmap ((* 10) . fromIntegral) pNum1Digit
+     <*> fmap fromIntegral pNum1Digit
+
+pLevel :: AB.Parser Level
+{-# INLINE pLevel #-}
+pLevel = (AB.<?> "pLevel")
+  -- In decreasing frequency we expect logs to happen.
+  -- We expect 'Debug' to mostly be muted, so 'Info' is prefered.
+  (AB.string "INFO"      $> Info)     <|>
+  (AB.string "DEBUG"     $> Debug)    <|>
+  (AB.string "NOTICE"    $> Notice)   <|>
+  (AB.string "WARNING"   $> Warning)  <|>
+  (AB.string "ERROR"     $> Error)    <|>
+  (AB.string "CRITICAL"  $> Critical) <|>
+  (AB.string "ALERT"     $> Alert)    <|>
+  (AB.string "EMERGENCY" $> Emergency)
+
+pPath :: AB.Parser (Seq.Seq Path)
+{-# INLINABLE pPath #-}
+pPath = (AB.<?> "pPath") $ do
+    fix (\k ps -> ((pPush <|> pAttr) >>= \p -> k (ps Seq.|> p)) <|> pure ps)
+        mempty
+  where
+    {-# INLINE pPush #-}
+    pPush :: AB.Parser Path
+    pPush = (AB.<?> "pPush") $ do
+      seg <- pSegment <* AB.skipWhile (== 32)
+      pure (Push seg)
+    {-# INLINE pAttr #-}
+    pAttr :: AB.Parser Path
+    pAttr = do
+      k <- pKey <* AB.skip (== 61)
+      v <- pValue <* AB.skipWhile (== 32)
+      pure (Attr k v)
+
+pSegment :: AB.Parser Segment
+pSegment = (AB.<?> "pSegment") $ do
+  AB.skip (== 47) AB.<?> "/"
+  bl <- pUtf8LtoL =<< pDecodePercents =<< AB.takeWhile (/= 32) -- :space:
+  pure (segment (TL.toStrict bl))
+
+pKey :: AB.Parser Key
+pKey = (AB.<?> "pKey") $ do
+
+  bl <- pUtf8LtoL =<< pDecodePercents
+          =<< AB.takeWhile (\w -> w /= 61 && w /= 32) -- '=' or :space:
+  pure (key (TL.toStrict bl))
+
+pValue :: AB.Parser Value
+pValue = (AB.<?> "pValue") $ do
+  bl <- pUtf8LtoL =<< pDecodePercents =<< AB.takeWhile (/= 32) -- :space:
+  pure (value bl)
+
+pMessage :: AB.Parser Message
+{-# INLINE pMessage #-}
+pMessage = (AB.<?> "pMessage") $ do
+  b <- AB.takeWhile (\w -> w /= 10 && w /= 13) -- CR and LF
+  tl <- pUtf8LtoL =<< pDecodePercents b
+  pure (message tl)
+
+pUtf8LtoL :: BL.ByteString -> AB.Parser TL.Text
+{-# INLINE pUtf8LtoL #-}
+pUtf8LtoL = \bl -> case TL.decodeUtf8' bl of
+   Right x -> pure x
+   Left e -> fail (show e) AB.<?> "pUtf8LtoL"
+
+-- | Parse @\"%FF\"@. Always consumes 3 bytes from the input, if successful.
+pNumPercent :: AB.Parser Word8
+{-# INLINE pNumPercent #-}
+pNumPercent = (AB.<?> "pNum2Nibbles") $ do
+   AB.skip (== 37) -- percent
+   wh <- pHexDigit
+   wl <- pHexDigit
+   pure (shiftL wh 4 + wl)
+
+pHexDigit :: AB.Parser Word8
+{-# INLINE pHexDigit #-}
+pHexDigit = AB.satisfyWith
+  (\case w | w >= 48 && w <=  57 -> w - 48
+           | w >= 65 && w <=  70 -> w - 55
+           | w >= 97 && w <= 102 -> w - 87
+           | otherwise -> 99)
+  (\w -> w /= 99)
+
+-- | Like 'pDecodePercentsL' but takes strict bytes.
+pDecodePercents :: B.ByteString -> AB.Parser BL.ByteString
+{-# INLINE pDecodePercents #-}
+pDecodePercents = pDecodePercentsL . BL.fromStrict
+
+-- | Decodes all 'pNumPercent' occurences from the given input.
+--
+-- TODO: Make faster and more space efficient.
+pDecodePercentsL :: BL.ByteString -> AB.Parser BL.ByteString
+{-# INLINABLE pDecodePercentsL #-}
+pDecodePercentsL = \bl ->
+    either fail pure (ABL.eitherResult (ABL.parse p bl))
+  where
+    p :: AB.Parser BL.ByteString
+    p = AB.atEnd >>= \case
+          True -> pure mempty
+          False -> fix $ \k -> do
+             b <- AB.peekWord8 >>= \case
+                Nothing -> empty
+                Just 37 -> fmap B.singleton pNumPercent
+                Just _  -> AB.takeWhile1 (\w -> w /= 37)
+             bls <- many k <* AB.endOfInput
+             pure (mconcat (BL.fromStrict b : bls))
+