@@ -0,0 +1,72 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Katip.Tests.Scribes.Handle
3+ ( tests
4+ ) where
5+
6+-------------------------------------------------------------------------------
7+import Control.Monad
8+import Data.Aeson
9+import Data.Text (Text)
10+import qualified Data.Text.IO as T
11+import System.Directory
12+import System.IO
13+import System.IO.Temp
14+import Test.Tasty
15+import Test.Tasty.HUnit
16+import Text.Regex.TDFA
17+-------------------------------------------------------------------------------
18+import Katip
19+-------------------------------------------------------------------------------
20+
21+
22+tests :: TestTree
23+tests = testGroup "Katip.Scribes.Handle"
24+ [
25+ withResource setup teardown $ \setupScribe -> testCase "logs the correct data" $ do
26+ (path, h, le) <- setupScribe
27+ runKatipT le $ logItem dummyLogItem "test" Nothing InfoS "test message"
28+ hClose h
29+ res <- readFile path
30+ let pat = "\\[[[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2} [[:digit:]]{2}:[[:digit:]]{2}:[[:digit:]]{2}\\]\\[katip-test.test\\]\\[Info\\]\\[.+\\]\\[[[:digit:]]+\\]\\[ThreadId [[:digit:]]+\\]\\[note:some note\\] test message" :: String
31+ let matches = res =~ pat
32+ matches @?= True
33+ ]
34+
35+
36+-------------------------------------------------------------------------------
37+data DummyLogItem = DummyLogItem {
38+ dliNote :: Text
39+ }
40+
41+
42+instance ToJSON DummyLogItem where
43+ toJSON (DummyLogItem n) = object ["note" .= n]
44+
45+
46+instance ToObject DummyLogItem
47+
48+
49+instance LogItem DummyLogItem where
50+ payloadKeys _ _ = AllKeys
51+
52+
53+-------------------------------------------------------------------------------
54+dummyLogItem :: DummyLogItem
55+dummyLogItem = DummyLogItem "some note"
56+
57+
58+-------------------------------------------------------------------------------
59+setup :: IO (FilePath, Handle, LogEnv)
60+setup = do
61+ tempDir <- getTemporaryDirectory
62+ (fp, h) <- openTempFile tempDir "katip.log"
63+ s <- mkHandleScribe (ColorLog False) h DebugS V3
64+ le <- initLogEnv "katip-test" "test"
65+ return (fp, h, registerScribe "handle" s le)
66+
67+
68+-------------------------------------------------------------------------------
69+teardown :: (FilePath, Handle, LogEnv) -> IO ()
70+teardown (_, h, _) = do
71+ chk <- hIsOpen h
72+ when chk $ hClose h