From 2c4ebad6b75254cdd19963c78e2ccbd09b5d8e4e Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Fri, 23 Jun 2023 21:38:04 +0400 Subject: [PATCH 1/1] First release. --- .gitignore | 24 ++++ CHANGELOG.md | 5 + LICENSE | 20 ++++ debug-trace-file.cabal | 35 ++++++ src/Debug/Trace/File.hs | 214 ++++++++++++++++++++++++++++++++++ test/Golden/traceFile | 1 + test/Golden/traceFileId | 1 + test/Golden/traceFileM | 2 + test/Golden/traceFileMW | 1 + test/Golden/traceFileShow | 1 + test/Golden/traceFileShowId | 1 + test/Golden/traceFileShowM | 2 + test/Golden/traceFileShowMW | 1 + test/Golden/traceFileShowWith | 1 + test/Golden/traceFileWith | 1 + test/Main.hs | 93 +++++++++++++++ 16 files changed, 403 insertions(+) create mode 100644 .gitignore create mode 100644 CHANGELOG.md create mode 100644 LICENSE create mode 100644 debug-trace-file.cabal create mode 100644 src/Debug/Trace/File.hs create mode 100644 test/Golden/traceFile create mode 100644 test/Golden/traceFileId create mode 100644 test/Golden/traceFileM create mode 100644 test/Golden/traceFileMW create mode 100644 test/Golden/traceFileShow create mode 100644 test/Golden/traceFileShowId create mode 100644 test/Golden/traceFileShowM create mode 100644 test/Golden/traceFileShowMW create mode 100644 test/Golden/traceFileShowWith create mode 100644 test/Golden/traceFileWith create mode 100644 test/Main.hs diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..d78e142 --- /dev/null +++ b/.gitignore @@ -0,0 +1,24 @@ +dist +dist-* +cabal-dev +*.o +*.hi +*.hie +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp +*.eventlog +.stack-work/ +cabal.project.local +cabal.project.local~ +.HTF/ +.ghc.environment.* +*.output \ No newline at end of file diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..4a7dae2 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for debug-trace-file + +## 0.1.0.0 -- 2023-06-23 + +* First version. Provides same functions as `Debug.Trace` but allows writing to files. diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..4bfd620 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +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. diff --git a/debug-trace-file.cabal b/debug-trace-file.cabal new file mode 100644 index 0000000..221ee49 --- /dev/null +++ b/debug-trace-file.cabal @@ -0,0 +1,35 @@ +cabal-version: 2.2 +name: debug-trace-file +version: 0.1.0.0 +synopsis: Like Debug.Trace but writing to files. +description: Debug.Trace like functions to trace to files. +license: MIT +license-file: LICENSE +author: Evgenii Akentev +maintainer: i@ak3n.com +category: Development +build-type: Simple +extra-doc-files: CHANGELOG.md + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: Debug.Trace.File + build-depends: base >= 4.7 && < 5 + hs-source-dirs: src + default-language: Haskell2010 + +test-suite debug-trace-file-test + import: warnings + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + build-depends: + base >= 4.7 && < 5, + directory, + tasty, + tasty-golden, + debug-trace-file diff --git a/src/Debug/Trace/File.hs b/src/Debug/Trace/File.hs new file mode 100644 index 0000000..e981024 --- /dev/null +++ b/src/Debug/Trace/File.hs @@ -0,0 +1,214 @@ +{-# 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 diff --git a/test/Golden/traceFile b/test/Golden/traceFile new file mode 100644 index 0000000..387bcc5 --- /dev/null +++ b/test/Golden/traceFile @@ -0,0 +1 @@ +tracing to file diff --git a/test/Golden/traceFileId b/test/Golden/traceFileId new file mode 100644 index 0000000..387bcc5 --- /dev/null +++ b/test/Golden/traceFileId @@ -0,0 +1 @@ +tracing to file diff --git a/test/Golden/traceFileM b/test/Golden/traceFileM new file mode 100644 index 0000000..72e90df --- /dev/null +++ b/test/Golden/traceFileM @@ -0,0 +1,2 @@ +x: 3 +y: 12 diff --git a/test/Golden/traceFileMW b/test/Golden/traceFileMW new file mode 100644 index 0000000..aca8c2a --- /dev/null +++ b/test/Golden/traceFileMW @@ -0,0 +1 @@ +y: 12 diff --git a/test/Golden/traceFileShow b/test/Golden/traceFileShow new file mode 100644 index 0000000..0cfbf08 --- /dev/null +++ b/test/Golden/traceFileShow @@ -0,0 +1 @@ +2 diff --git a/test/Golden/traceFileShowId b/test/Golden/traceFileShowId new file mode 100644 index 0000000..00750ed --- /dev/null +++ b/test/Golden/traceFileShowId @@ -0,0 +1 @@ +3 diff --git a/test/Golden/traceFileShowM b/test/Golden/traceFileShowM new file mode 100644 index 0000000..fd59726 --- /dev/null +++ b/test/Golden/traceFileShowM @@ -0,0 +1,2 @@ +3 +12 diff --git a/test/Golden/traceFileShowMW b/test/Golden/traceFileShowMW new file mode 100644 index 0000000..48082f7 --- /dev/null +++ b/test/Golden/traceFileShowMW @@ -0,0 +1 @@ +12 diff --git a/test/Golden/traceFileShowWith b/test/Golden/traceFileShowWith new file mode 100644 index 0000000..00750ed --- /dev/null +++ b/test/Golden/traceFileShowWith @@ -0,0 +1 @@ +3 diff --git a/test/Golden/traceFileWith b/test/Golden/traceFileWith new file mode 100644 index 0000000..ce01362 --- /dev/null +++ b/test/Golden/traceFileWith @@ -0,0 +1 @@ +hello diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 index 0000000..fd87231 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,93 @@ +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 -- 2.34.1