repos / debug-trace-file.hs.git

commit

2c4ebad

parent

2c4ebad

author

Evgenii Akentev

date

2023-06-23 21:38:04 +0400 +04

First release.

 1@@ -0,0 +1,24 @@
 2+dist
 3+dist-*
 4+cabal-dev
 5+*.o
 6+*.hi
 7+*.hie
 8+*.chi
 9+*.chs.h
10+*.dyn_o
11+*.dyn_hi
12+.hpc
13+.hsenv
14+.cabal-sandbox/
15+cabal.sandbox.config
16+*.prof
17+*.aux
18+*.hp
19+*.eventlog
20+.stack-work/
21+cabal.project.local
22+cabal.project.local~
23+.HTF/
24+.ghc.environment.*
25+*.output

1@@ -0,0 +1,5 @@
2+# Revision history for debug-trace-file
3+
4+## 0.1.0.0 -- 2023-06-23
5+
6+* First version. Provides same functions as `Debug.Trace` but allows writing to files.

 1@@ -0,0 +1,20 @@
 2+Copyright (c) 2023 Evgenii Akentev
 3+
 4+Permission is hereby granted, free of charge, to any person obtaining
 5+a copy of this software and associated documentation files (the
 6+"Software"), to deal in the Software without restriction, including
 7+without limitation the rights to use, copy, modify, merge, publish,
 8+distribute, sublicense, and/or sell copies of the Software, and to
 9+permit persons to whom the Software is furnished to do so, subject to
10+the following conditions:
11+
12+The above copyright notice and this permission notice shall be included
13+in all copies or substantial portions of the Software.
14+
15+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
16+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
17+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
18+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
19+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
20+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
21+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

 1@@ -0,0 +1,35 @@
 2+cabal-version:      2.2
 3+name:               debug-trace-file
 4+version:            0.1.0.0
 5+synopsis:           Like Debug.Trace but writing to files.
 6+description:        Debug.Trace like functions to trace to files.
 7+license:            MIT
 8+license-file:       LICENSE
 9+author:             Evgenii Akentev
10+maintainer:         i@ak3n.com
11+category:           Development
12+build-type:         Simple
13+extra-doc-files:    CHANGELOG.md
14+
15+common warnings
16+    ghc-options: -Wall
17+
18+library
19+    import:           warnings
20+    exposed-modules:  Debug.Trace.File
21+    build-depends:    base >= 4.7 && < 5
22+    hs-source-dirs:   src
23+    default-language: Haskell2010
24+
25+test-suite debug-trace-file-test
26+    import:           warnings
27+    default-language: Haskell2010
28+    type:             exitcode-stdio-1.0
29+    hs-source-dirs:   test
30+    main-is:          Main.hs
31+    build-depends:
32+        base >= 4.7 && < 5,
33+        directory,
34+        tasty,
35+        tasty-golden,
36+        debug-trace-file

  1@@ -0,0 +1,214 @@
  2+{-# LANGUAGE BangPatterns #-}
  3+
  4+-----------------------------------------------------------------------------
  5+-- |
  6+-- Module      :  Debug.Trace.File
  7+-- Maintainer  :  i@ak3n.com
  8+--
  9+-- Like Debug.Trace but writing to files (when eventlog is too much).
 10+--
 11+-- The functions use 'appendFile' and append to files by default.
 12+-- The functions with suffix W (like 'traceFileW', 'traceFileIdW', etc) use 'writeFile'.
 13+-----------------------------------------------------------------------------
 14+
 15+module Debug.Trace.File
 16+  (
 17+    -- * Tracing to files
 18+    traceFile
 19+  , traceFileW
 20+
 21+  , traceFileId
 22+  , traceFileIdW
 23+
 24+  , traceFileShow
 25+  , traceFileShowW
 26+
 27+  , traceFileShowId
 28+  , traceFileShowIdW
 29+
 30+  , traceFileWith
 31+  , traceFileWithW
 32+
 33+  , traceFileShowWith
 34+  , traceFileShowWithW
 35+
 36+  , traceFileM
 37+  , traceFileMW
 38+
 39+  , traceFileShowM
 40+  , traceFileShowMW
 41+  ) where
 42+
 43+import Data.Functor (($>))
 44+import System.IO.Unsafe (unsafePerformIO)
 45+
 46+-- $setup
 47+-- >>> import Prelude
 48+
 49+{-|
 50+The 'traceFile' function appends to the provided file path given as its first argument,
 51+the trace message given as its second argument, before returning the third argument as its result.
 52+
 53+For example, this returns the value of @f x@ and outputs the message to "\/tmp\/message".
 54+
 55+>>> let x = 123; f = show
 56+>>> traceFile "/tmp/message" ("calling f with x = " ++ show x) (f x)
 57+"123"
 58+>>> readFile "/tmp/message"
 59+"calling f with x = 123\n"
 60+
 61+The 'traceFile' function should /only/ be used for debugging, or for monitoring
 62+execution. The function is not referentially transparent: its type indicates
 63+that it is a pure function but it has the side effect of outputting the
 64+trace message.
 65+-}
 66+traceFile :: FilePath -> String -> a -> a
 67+traceFile = traceInternal appendFile
 68+
 69+{-|
 70+Like 'traceFile' but uses `writeFile` instead of `appendFile` which means will overwrite the contents of the file.
 71+-}
 72+traceFileW :: FilePath -> String -> a -> a
 73+traceFileW = traceInternal writeFile
 74+
 75+{-|
 76+Like 'traceFile' but returns the message instead of a third value.
 77+
 78+>>> traceFileId "/tmp/message" "hello"
 79+"hello"
 80+>>> readFile "/tmp/message"
 81+"hello\n"
 82+-}
 83+traceFileId :: FilePath -> String -> String
 84+traceFileId fp a = traceFile fp a a
 85+
 86+{-|
 87+Like 'traceFileId' but uses `writeFile` instead of `appendFile` which means will overwrite the contents of the file.
 88+-}
 89+traceFileIdW :: FilePath -> String -> String
 90+traceFileIdW fp a = traceFileW fp a a
 91+
 92+{-|
 93+Like 'traceFile', but uses 'show' on the argument to convert it to a 'String'.
 94+
 95+This makes it convenient for printing the values of interesting variables or
 96+expressions inside a function. For example here we print the value of the
 97+variables @x@ and @y@:
 98+
 99+>>> let f x y = traceFileShow "/tmp/message" (x,y) (x + y) in f (1+2) 5
100+8
101+>>> readFile "/tmp/message"
102+"(3,5)\n"
103+-}
104+traceFileShow :: Show a => FilePath -> a -> b -> b
105+traceFileShow fp = traceFile fp . show
106+
107+{-|
108+Like 'traceFileShow' but uses `writeFile` instead of `appendFile` which means will overwrite the contents of the file.
109+-}
110+traceFileShowW :: Show a => FilePath -> a -> b -> b
111+traceFileShowW fp = traceFileW fp . show
112+
113+{-|
114+Like 'traceFileShow' but returns the shown value instead of a third value.
115+
116+>>> traceFileShowId "/tmp/message" (1+2+3, "hello" ++ "world")
117+(6,"helloworld")
118+>>> readFile "/tmp/message"
119+"(6,\"helloworld\")\n"
120+-}
121+traceFileShowId :: Show a => FilePath -> a -> a
122+traceFileShowId fp a = traceFile fp (show a) a
123+
124+{-|
125+Like 'traceFileShowId' but uses `writeFile` instead of `appendFile` which means will overwrite the contents of the file.
126+-}
127+traceFileShowIdW :: Show a => FilePath -> a -> a
128+traceFileShowIdW fp a = traceFileW fp (show a) a
129+
130+{-|
131+Like 'traceFile', but outputs the result of calling a function on the argument.
132+
133+>>> traceFileWith "/tmp/message" fst ("hello","world")
134+("hello","world")
135+>>> readFile "/tmp/message"
136+"hello\n"
137+-}
138+traceFileWith :: FilePath -> (a -> String) -> a -> a
139+traceFileWith fp f a = traceFile fp (f a) a
140+
141+{-|
142+Like 'traceFileWith' but uses `writeFile` instead of `appendFile` which means will overwrite the contents of the file.
143+-}
144+traceFileWithW :: FilePath -> (a -> String) -> a -> a
145+traceFileWithW fp f a = traceFileW fp (f a) a
146+
147+{-|
148+Like 'traceFileWith', but uses 'show' on the result of the function to convert it to
149+a 'String'.
150+
151+>>> traceFileShowWith "/tmp/message" length [1,2,3]
152+[1,2,3]
153+>>> readFile "/tmp/message"
154+"3\n"
155+-}
156+traceFileShowWith :: Show b => FilePath -> (a -> b) -> a -> a
157+traceFileShowWith fp f = traceFileWith fp (show . f)
158+
159+{-|
160+Like 'traceFileWith' but uses `writeFile` instead of `appendFile` which means will overwrite the contents of the file.
161+-}
162+traceFileShowWithW :: Show b => FilePath -> (a -> b) -> a -> a
163+traceFileShowWithW fp f = traceFileWithW fp (show . f)
164+
165+{-|
166+Like 'traceFile' but returning unit in an arbitrary 'Applicative' context. Allows
167+for convenient use in do-notation.
168+
169+>>> :{
170+do
171+    x <- Just 3
172+    traceFileM "/tmp/message" ("x: " ++ show x)
173+    y <- pure 12
174+    traceFileM "/tmp/message" ("y: " ++ show y)
175+    pure (x*2 + y)
176+:}
177+Just 18
178+>>> readFile "/tmp/message"
179+"x: 3\ny: 12\n"
180+-}
181+traceFileM :: Applicative f => FilePath -> String -> f ()
182+traceFileM fp string = traceFile fp string $ pure ()
183+
184+{-|
185+Like 'traceFileM' but uses `writeFile` instead of `appendFile` which means will overwrite the contents of the file.
186+-}
187+traceFileMW :: Applicative f => FilePath -> String -> f ()
188+traceFileMW fp string = traceFileW fp string $ pure ()
189+
190+{-|
191+Like 'traceFileM', but uses 'show' on the argument to convert it to a 'String'.
192+
193+>>> :{
194+do
195+    x <- Just 3
196+    traceFileShowM "/tmp/message" x
197+    y <- pure 12
198+    traceFileShowM "/tmp/message" y
199+    pure (x*2 + y)
200+:}
201+Just 18
202+>>> readFile "/tmp/message"
203+"3\n12\n"
204+-}
205+traceFileShowM :: (Show a, Applicative f) => FilePath -> a -> f ()
206+traceFileShowM fp = traceFileM fp . show
207+
208+{-|
209+Like 'traceFileShowM' but uses `writeFile` instead of `appendFile` which means will overwrite the contents of the file.
210+-}
211+traceFileShowMW :: (Show a, Applicative f) => FilePath -> a -> f ()
212+traceFileShowMW fp = traceFileMW fp . show
213+
214+traceInternal :: (FilePath -> String -> IO ()) -> FilePath -> String -> a -> a
215+traceInternal writeFunc fp str val = unsafePerformIO $! writeFunc fp (str ++ "\n") $> val

1@@ -0,0 +1 @@
2+tracing to file

1@@ -0,0 +1 @@
2+tracing to file

1@@ -0,0 +1,2 @@
2+x: 3
3+y: 12

1@@ -0,0 +1 @@
2+y: 12

1@@ -0,0 +1 @@
2+2

1@@ -0,0 +1 @@
2+3

1@@ -0,0 +1,2 @@
2+3
3+12

1@@ -0,0 +1 @@
2+12

1@@ -0,0 +1 @@
2+3

1@@ -0,0 +1 @@
2+hello

 1@@ -0,0 +1,93 @@
 2+module Main (main) where
 3+
 4+import Control.Monad (void)
 5+import Data.List (isSuffixOf)
 6+import Test.Tasty (defaultMain, TestTree, testGroup)
 7+import Test.Tasty.Golden (goldenVsFile)
 8+import System.Directory (getDirectoryContents, removeFile)
 9+
10+import Debug.Trace.File
11+
12+main :: IO ()
13+main = do
14+  -- remove output files
15+  outputs <- getDirectoryContents "test/Golden/"
16+  mapM_ removeFile (filter (isSuffixOf ".output") $ map ("test/Golden/" <>) outputs)
17+
18+  defaultMain goldenTests
19+
20+goldenTests :: TestTree
21+goldenTests = testGroup "Debug.Trace.File golden tests"
22+  [ let fp = "test/Golden/traceFile.output" in
23+    goldenVsFile "traceFile" "test/Golden/traceFile" fp (pure $! traceFile fp "tracing to file" ())
24+
25+  , let fp = "test/Golden/traceFile.output" in
26+    goldenVsFile "traceFileW" "test/Golden/traceFile" fp (pure $! traceFileW fp "tracing to file" ())
27+
28+  , let fp = "test/Golden/traceFileId.output" in
29+    goldenVsFile "traceFileId" "test/Golden/traceFileId" fp ((pure $! traceFileId fp "tracing to file") >> pure ())
30+
31+  , let fp = "test/Golden/traceFileId.output" in
32+    goldenVsFile "traceFileIdW" "test/Golden/traceFileId" fp ((pure $! traceFileIdW fp "tracing to file") >> pure ())
33+
34+  , let fp = "test/Golden/traceFileShow.output" in
35+    goldenVsFile "traceFileShow" "test/Golden/traceFileShow" fp ((pure $! traceFileShow fp (2 :: Int) (3 :: Int)) >> pure ())
36+
37+  , let fp = "test/Golden/traceFileShow.output" in
38+    goldenVsFile "traceFileShowW" "test/Golden/traceFileShow" fp ((pure $! traceFileShowW fp (2 :: Int) (3 :: Int)) >> pure ())
39+
40+  , let fp = "test/Golden/traceFileShowId.output" in
41+    goldenVsFile "traceFileShowId" "test/Golden/traceFileShowId" fp ((pure $! traceFileShowId fp (3 :: Int)) >> pure ())
42+
43+  , let fp = "test/Golden/traceFileShowId.output" in
44+    goldenVsFile "traceFileShowIdW" "test/Golden/traceFileShowId" fp ((pure $! traceFileShowIdW fp (3 :: Int)) >> pure ())
45+
46+  , let fp = "test/Golden/traceFileWith.output" in
47+    goldenVsFile "traceFileWith" "test/Golden/traceFileWith" fp ((pure $! traceFileWith fp fst ("hello","world")) >> pure ())
48+
49+  , let fp = "test/Golden/traceFileWith.output" in
50+    goldenVsFile "traceFileWithW" "test/Golden/traceFileWith" fp ((pure $! traceFileWithW fp fst ("hello","world")) >> pure ())
51+
52+  , let fp = "test/Golden/traceFileShowWith.output" in
53+    goldenVsFile "traceFileShowWith" "test/Golden/traceFileShowWith" fp ((pure $! traceFileShowWith fp length [1 :: Int,2,3]) >> pure ())
54+
55+  , let fp = "test/Golden/traceFileShowWith.output" in
56+    goldenVsFile "traceFileShowWithW" "test/Golden/traceFileShowWith" fp ((pure $! traceFileShowWithW fp length [1 :: Int,2,3]) >> pure ())
57+
58+  , let fp = "test/Golden/traceFileM.output" in
59+    goldenVsFile "traceFileM" "test/Golden/traceFileM" fp $
60+      void $ pure $! do
61+        x <- Just (3 :: Int)
62+        traceFileM fp ("x: " ++ show x)
63+        y <- pure 12
64+        traceFileM fp ("y: " ++ show y)
65+        pure (x*2 + y)
66+
67+  , let fp = "test/Golden/traceFileMW.output" in
68+    goldenVsFile "traceFileMW" "test/Golden/traceFileMW" fp $
69+      void $ pure $! do
70+        x <- Just (3 :: Int)
71+        traceFileMW fp ("x: " ++ show x)
72+        y <- pure 12
73+        traceFileMW fp ("y: " ++ show y)
74+        pure (x*2 + y)
75+
76+  , let fp = "test/Golden/traceFileShowM.output" in
77+    goldenVsFile "traceFileShowM" "test/Golden/traceFileShowM" fp $
78+      void $ pure $! do
79+        x <- Just (3 :: Int)
80+        traceFileShowM fp x
81+        y <- pure 12
82+        traceFileShowM fp y
83+        pure (x*2 + y)
84+
85+  , let fp = "test/Golden/traceFileShowMW.output" in
86+    goldenVsFile "traceFileShowMW" "test/Golden/traceFileShowMW" fp $
87+      void $ pure $! do
88+        x <- Just (3 :: Int)
89+        traceFileShowMW fp x
90+        y <- pure 12
91+        traceFileShowMW fp y
92+        pure (x*2 + y)
93+
94+  ]