@@ -6,17 +6,26 @@ module Katip.Tests.Scribes.Handle
6-------------------------------------------------------------------------------
6-------------------------------------------------------------------------------
7import Control.Monad
7import Control.Monad
8import Data.Aeson
8import Data.Aeson
9+import qualified Data.ByteString.Lazy as BL
9import Data.Monoid
10import Data.Monoid
10−import Data.Text (Text)
11+import Data.Text (Text)
11−import qualified Data.Text.IO as T
12+import qualified Data.Text as T
13+import qualified Data.Text.IO as T
14+import qualified Data.Text.Lazy as LT
15+import qualified Data.Text.Lazy.Builder as LT
17+import Language.Haskell.TH.Syntax (Loc (..))
18+import Lens.Micro ((.~))
12import System.Directory
19import System.Directory
13import System.IO
20import System.IO
14import System.IO.Temp
21import System.IO.Temp
15import Test.Tasty
22import Test.Tasty
23+import Test.Tasty.Golden
16import Test.Tasty.HUnit
24import Test.Tasty.HUnit
17import Text.Regex.TDFA
25import Text.Regex.TDFA
18-------------------------------------------------------------------------------
26-------------------------------------------------------------------------------
19import Katip
27import Katip
28+import Katip.Scribes.Handle
20-------------------------------------------------------------------------------
29-------------------------------------------------------------------------------
@@ -31,6 +40,10 @@ tests = testGroup "Katip.Scribes.Handle"
31 let pat = "\\[[[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2} [[:digit:]]{2}:[[:digit:]]{2}:[[:digit:]]{2}\\]\\[katip-test.test\\]\\[Info\\]\\[.+\\]\\[[[:digit:]]+\\]\\[ThreadId [[:digit:]]+\\]\\[note.deep:some note\\] test message" :: String
40 let pat = "\\[[[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2} [[:digit:]]{2}:[[:digit:]]{2}:[[:digit:]]{2}\\]\\[katip-test.test\\]\\[Info\\]\\[.+\\]\\[[[:digit:]]+\\]\\[ThreadId [[:digit:]]+\\]\\[note.deep:some note\\] test message" :: String
32 let matches = res =~ pat
41 let matches = res =~ pat
33 assertBool (res <> " did not match") matches
42 assertBool (res <> " did not match") matches
43+ , withResource setupTempFile teardownTempFile $ \setup ->
44+ goldenVsString "Text-golden"
45+ "test/Katip/Tests/Scribes/Handle-text.golden"
46+ (setup >>= writeTextLog)
@@ -74,3 +87,146 @@ teardown :: (FilePath, Handle, LogEnv) -> IO ()
74teardown (_, h, _) = do
87teardown (_, h, _) = do
75 chk <- hIsOpen h
88 chk <- hIsOpen h
76 when chk $ hClose h
89 when chk $ hClose h
93+-- Following code tests Handle scribe output against a golden file.
94+-- This test will fail on non utf8 locales because golden file is in utf-8.
95+-- It generates all meaningfull variations of Item, and also tests
96+-- writing of payload of different Aeson constructors
98+-- Note: currently Handle scribe does not write Array items at all
99+-------------------------------------------------------------------------------
100+data AllTypesLogItem = AllTypesLogItem
105+ , atlSub :: Maybe DummyLogItem
109+instance ToJSON AllTypesLogItem where
111+ [ "text" .= atlText it
112+ , "num" .= atlNum it
113+ , "float" .= atlFloat it
114+ , "list" .= atlList it
115+ , "sub" .= atlSub it
119+instance ToObject AllTypesLogItem
122+instance LogItem AllTypesLogItem where
123+ payloadKeys _ _ = AllKeys
126+-------------------------------------------------------------------------------
127+theItem :: Item DummyLogItem
128+theItem = Item (Namespace ["app"])
129+ (Environment "production")
131+ (ThreadIdText "1337")
136+ (mkUTCTime 2016 6 12 12 34 56)
140+genItems :: [Item DummyLogItem]
142+ [ [ itemSeverity .~ s $ theItem
143+ | s <- [minBound .. maxBound]
145+ , [ itemThread .~ (ThreadIdText . T.pack $ show t) $ theItem
146+ | t <- [0, 1, 1337, 2147483647]
148+ , [ itemHost .~ h $ theItem
149+ | h <- ["example", "www.example.com", "127.0.0.1"]
151+ , [ itemProcess .~ p $ theItem
152+ | p <- [0, 1, 1337, 2147483647]
154+ , [ itemMessage .~ LogStr m $ theItem
156+ , "message\nwith newline"
157+ , LT.fromLazyText (LT.replicate 40 " a really long message")
162+ , [ itemTime .~ t $ theItem
165+ , [ itemNamespace .~ Namespace ns $ theItem
169+ , ["with\nnewline"] ]
171+ , [ itemLoc .~ l $ theItem | l <- genLocs
175+genDates :: [UTCTime]
177+ [ mkUTCTime 2000 1 1 0 0 0.0
178+ , mkUTCTime 2123 12 31 23 59 59.999999999999
179+ , mkUTCTime 2016 10 10 1 1 5.0
180+ , mkUTCTime 2100 12 31 12 59 10.1
181+ , mkUTCTime 1982 1 1 12 30 0.000000000001
184+genLocs :: [Maybe Loc]
187+ , Just $ Loc "path/Some/Module.hs"
191+ , Just $ Loc "путь/Some/Module.hs"
194+ (3000,9000) (4000,1)
197+genTypedItems :: [Item AllTypesLogItem]
199+ [ itemPayload .~ p $ theItem
200+ | p <- [ AllTypesLogItem "" 0 0.0 [] Nothing
201+ , AllTypesLogItem "note" 10 5.5 ["one", "two", "three"]
206+mkUTCTime :: Integer -> Int -> Int -> DiffTime -> DiffTime -> DiffTime -> UTCTime
207+mkUTCTime y mt d h mn s = UTCTime day dt
209+ day = fromGregorian y mt d
210+ dt = h * 60 * 60 + mn * 60 + s
212+-------------------------------------------------------------------------------
213+writeTextLog :: (FilePath, Handle) -> IO (BL.ByteString)
214+writeTextLog (path, h) = do
215+ mapM_ (T.hPutStrLn h . formatOne) genItems
216+ mapM_ (T.hPutStrLn h . formatOne) genTypedItems
220+ formatOne :: LogItem a => Item a -> Text
221+ formatOne = LT.toStrict . LT.toLazyText . formatItem False V3
223+setupTempFile :: IO (FilePath, Handle)
225+ tempDir <- getTemporaryDirectory
226+ (fp, h) <- openBinaryTempFile tempDir "katip.log"
229+teardownTempFile :: (FilePath, Handle) -> IO ()
230+teardownTempFile (_, h) = do