--- /dev/null
+Copyright (c) 2023 Evgenii Akentev
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
--- /dev/null
+{-# LANGUAGE BangPatterns #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : Debug.Trace.File
+-- Maintainer : i@ak3n.com
+--
+-- Like Debug.Trace but writing to files (when eventlog is too much).
+--
+-- The functions use 'appendFile' and append to files by default.
+-- The functions with suffix W (like 'traceFileW', 'traceFileIdW', etc) use 'writeFile'.
+-----------------------------------------------------------------------------
+
+module Debug.Trace.File
+ (
+ -- * Tracing to files
+ traceFile
+ , traceFileW
+
+ , traceFileId
+ , traceFileIdW
+
+ , traceFileShow
+ , traceFileShowW
+
+ , traceFileShowId
+ , traceFileShowIdW
+
+ , traceFileWith
+ , traceFileWithW
+
+ , traceFileShowWith
+ , traceFileShowWithW
+
+ , traceFileM
+ , traceFileMW
+
+ , traceFileShowM
+ , traceFileShowMW
+ ) where
+
+import Data.Functor (($>))
+import System.IO.Unsafe (unsafePerformIO)
+
+-- $setup
+-- >>> import Prelude
+
+{-|
+The 'traceFile' function appends to the provided file path given as its first argument,
+the trace message given as its second argument, before returning the third argument as its result.
+
+For example, this returns the value of @f x@ and outputs the message to "\/tmp\/message".
+
+>>> let x = 123; f = show
+>>> traceFile "/tmp/message" ("calling f with x = " ++ show x) (f x)
+"123"
+>>> readFile "/tmp/message"
+"calling f with x = 123\n"
+
+The 'traceFile' function should /only/ be used for debugging, or for monitoring
+execution. The function is not referentially transparent: its type indicates
+that it is a pure function but it has the side effect of outputting the
+trace message.
+-}
+traceFile :: FilePath -> String -> a -> a
+traceFile = traceInternal appendFile
+
+{-|
+Like 'traceFile' but uses `writeFile` instead of `appendFile` which means will overwrite the contents of the file.
+-}
+traceFileW :: FilePath -> String -> a -> a
+traceFileW = traceInternal writeFile
+
+{-|
+Like 'traceFile' but returns the message instead of a third value.
+
+>>> traceFileId "/tmp/message" "hello"
+"hello"
+>>> readFile "/tmp/message"
+"hello\n"
+-}
+traceFileId :: FilePath -> String -> String
+traceFileId fp a = traceFile fp a a
+
+{-|
+Like 'traceFileId' but uses `writeFile` instead of `appendFile` which means will overwrite the contents of the file.
+-}
+traceFileIdW :: FilePath -> String -> String
+traceFileIdW fp a = traceFileW fp a a
+
+{-|
+Like 'traceFile', but uses 'show' on the argument to convert it to a 'String'.
+
+This makes it convenient for printing the values of interesting variables or
+expressions inside a function. For example here we print the value of the
+variables @x@ and @y@:
+
+>>> let f x y = traceFileShow "/tmp/message" (x,y) (x + y) in f (1+2) 5
+8
+>>> readFile "/tmp/message"
+"(3,5)\n"
+-}
+traceFileShow :: Show a => FilePath -> a -> b -> b
+traceFileShow fp = traceFile fp . show
+
+{-|
+Like 'traceFileShow' but uses `writeFile` instead of `appendFile` which means will overwrite the contents of the file.
+-}
+traceFileShowW :: Show a => FilePath -> a -> b -> b
+traceFileShowW fp = traceFileW fp . show
+
+{-|
+Like 'traceFileShow' but returns the shown value instead of a third value.
+
+>>> traceFileShowId "/tmp/message" (1+2+3, "hello" ++ "world")
+(6,"helloworld")
+>>> readFile "/tmp/message"
+"(6,\"helloworld\")\n"
+-}
+traceFileShowId :: Show a => FilePath -> a -> a
+traceFileShowId fp a = traceFile fp (show a) a
+
+{-|
+Like 'traceFileShowId' but uses `writeFile` instead of `appendFile` which means will overwrite the contents of the file.
+-}
+traceFileShowIdW :: Show a => FilePath -> a -> a
+traceFileShowIdW fp a = traceFileW fp (show a) a
+
+{-|
+Like 'traceFile', but outputs the result of calling a function on the argument.
+
+>>> traceFileWith "/tmp/message" fst ("hello","world")
+("hello","world")
+>>> readFile "/tmp/message"
+"hello\n"
+-}
+traceFileWith :: FilePath -> (a -> String) -> a -> a
+traceFileWith fp f a = traceFile fp (f a) a
+
+{-|
+Like 'traceFileWith' but uses `writeFile` instead of `appendFile` which means will overwrite the contents of the file.
+-}
+traceFileWithW :: FilePath -> (a -> String) -> a -> a
+traceFileWithW fp f a = traceFileW fp (f a) a
+
+{-|
+Like 'traceFileWith', but uses 'show' on the result of the function to convert it to
+a 'String'.
+
+>>> traceFileShowWith "/tmp/message" length [1,2,3]
+[1,2,3]
+>>> readFile "/tmp/message"
+"3\n"
+-}
+traceFileShowWith :: Show b => FilePath -> (a -> b) -> a -> a
+traceFileShowWith fp f = traceFileWith fp (show . f)
+
+{-|
+Like 'traceFileWith' but uses `writeFile` instead of `appendFile` which means will overwrite the contents of the file.
+-}
+traceFileShowWithW :: Show b => FilePath -> (a -> b) -> a -> a
+traceFileShowWithW fp f = traceFileWithW fp (show . f)
+
+{-|
+Like 'traceFile' but returning unit in an arbitrary 'Applicative' context. Allows
+for convenient use in do-notation.
+
+>>> :{
+do
+ x <- Just 3
+ traceFileM "/tmp/message" ("x: " ++ show x)
+ y <- pure 12
+ traceFileM "/tmp/message" ("y: " ++ show y)
+ pure (x*2 + y)
+:}
+Just 18
+>>> readFile "/tmp/message"
+"x: 3\ny: 12\n"
+-}
+traceFileM :: Applicative f => FilePath -> String -> f ()
+traceFileM fp string = traceFile fp string $ pure ()
+
+{-|
+Like 'traceFileM' but uses `writeFile` instead of `appendFile` which means will overwrite the contents of the file.
+-}
+traceFileMW :: Applicative f => FilePath -> String -> f ()
+traceFileMW fp string = traceFileW fp string $ pure ()
+
+{-|
+Like 'traceFileM', but uses 'show' on the argument to convert it to a 'String'.
+
+>>> :{
+do
+ x <- Just 3
+ traceFileShowM "/tmp/message" x
+ y <- pure 12
+ traceFileShowM "/tmp/message" y
+ pure (x*2 + y)
+:}
+Just 18
+>>> readFile "/tmp/message"
+"3\n12\n"
+-}
+traceFileShowM :: (Show a, Applicative f) => FilePath -> a -> f ()
+traceFileShowM fp = traceFileM fp . show
+
+{-|
+Like 'traceFileShowM' but uses `writeFile` instead of `appendFile` which means will overwrite the contents of the file.
+-}
+traceFileShowMW :: (Show a, Applicative f) => FilePath -> a -> f ()
+traceFileShowMW fp = traceFileMW fp . show
+
+traceInternal :: (FilePath -> String -> IO ()) -> FilePath -> String -> a -> a
+traceInternal writeFunc fp str val = unsafePerformIO $! writeFunc fp (str ++ "\n") $> val
\ No newline at end of file
--- /dev/null
+module Main (main) where
+
+import Control.Monad (void)
+import Data.List (isSuffixOf)
+import Test.Tasty (defaultMain, TestTree, testGroup)
+import Test.Tasty.Golden (goldenVsFile)
+import System.Directory (getDirectoryContents, removeFile)
+
+import Debug.Trace.File
+
+main :: IO ()
+main = do
+ -- remove output files
+ outputs <- getDirectoryContents "test/Golden/"
+ mapM_ removeFile (filter (isSuffixOf ".output") $ map ("test/Golden/" <>) outputs)
+
+ defaultMain goldenTests
+
+goldenTests :: TestTree
+goldenTests = testGroup "Debug.Trace.File golden tests"
+ [ let fp = "test/Golden/traceFile.output" in
+ goldenVsFile "traceFile" "test/Golden/traceFile" fp (pure $! traceFile fp "tracing to file" ())
+
+ , let fp = "test/Golden/traceFile.output" in
+ goldenVsFile "traceFileW" "test/Golden/traceFile" fp (pure $! traceFileW fp "tracing to file" ())
+
+ , let fp = "test/Golden/traceFileId.output" in
+ goldenVsFile "traceFileId" "test/Golden/traceFileId" fp ((pure $! traceFileId fp "tracing to file") >> pure ())
+
+ , let fp = "test/Golden/traceFileId.output" in
+ goldenVsFile "traceFileIdW" "test/Golden/traceFileId" fp ((pure $! traceFileIdW fp "tracing to file") >> pure ())
+
+ , let fp = "test/Golden/traceFileShow.output" in
+ goldenVsFile "traceFileShow" "test/Golden/traceFileShow" fp ((pure $! traceFileShow fp (2 :: Int) (3 :: Int)) >> pure ())
+
+ , let fp = "test/Golden/traceFileShow.output" in
+ goldenVsFile "traceFileShowW" "test/Golden/traceFileShow" fp ((pure $! traceFileShowW fp (2 :: Int) (3 :: Int)) >> pure ())
+
+ , let fp = "test/Golden/traceFileShowId.output" in
+ goldenVsFile "traceFileShowId" "test/Golden/traceFileShowId" fp ((pure $! traceFileShowId fp (3 :: Int)) >> pure ())
+
+ , let fp = "test/Golden/traceFileShowId.output" in
+ goldenVsFile "traceFileShowIdW" "test/Golden/traceFileShowId" fp ((pure $! traceFileShowIdW fp (3 :: Int)) >> pure ())
+
+ , let fp = "test/Golden/traceFileWith.output" in
+ goldenVsFile "traceFileWith" "test/Golden/traceFileWith" fp ((pure $! traceFileWith fp fst ("hello","world")) >> pure ())
+
+ , let fp = "test/Golden/traceFileWith.output" in
+ goldenVsFile "traceFileWithW" "test/Golden/traceFileWith" fp ((pure $! traceFileWithW fp fst ("hello","world")) >> pure ())
+
+ , let fp = "test/Golden/traceFileShowWith.output" in
+ goldenVsFile "traceFileShowWith" "test/Golden/traceFileShowWith" fp ((pure $! traceFileShowWith fp length [1 :: Int,2,3]) >> pure ())
+
+ , let fp = "test/Golden/traceFileShowWith.output" in
+ goldenVsFile "traceFileShowWithW" "test/Golden/traceFileShowWith" fp ((pure $! traceFileShowWithW fp length [1 :: Int,2,3]) >> pure ())
+
+ , let fp = "test/Golden/traceFileM.output" in
+ goldenVsFile "traceFileM" "test/Golden/traceFileM" fp $
+ void $ pure $! do
+ x <- Just (3 :: Int)
+ traceFileM fp ("x: " ++ show x)
+ y <- pure 12
+ traceFileM fp ("y: " ++ show y)
+ pure (x*2 + y)
+
+ , let fp = "test/Golden/traceFileMW.output" in
+ goldenVsFile "traceFileMW" "test/Golden/traceFileMW" fp $
+ void $ pure $! do
+ x <- Just (3 :: Int)
+ traceFileMW fp ("x: " ++ show x)
+ y <- pure 12
+ traceFileMW fp ("y: " ++ show y)
+ pure (x*2 + y)
+
+ , let fp = "test/Golden/traceFileShowM.output" in
+ goldenVsFile "traceFileShowM" "test/Golden/traceFileShowM" fp $
+ void $ pure $! do
+ x <- Just (3 :: Int)
+ traceFileShowM fp x
+ y <- pure 12
+ traceFileShowM fp y
+ pure (x*2 + y)
+
+ , let fp = "test/Golden/traceFileShowMW.output" in
+ goldenVsFile "traceFileShowMW" "test/Golden/traceFileShowMW" fp $
+ void $ pure $! do
+ x <- Just (3 :: Int)
+ traceFileShowMW fp x
+ y <- pure 12
+ traceFileShowMW fp y
+ pure (x*2 + y)
+
+ ]
\ No newline at end of file
projects / debug-trace-file.git / commitdiff