--  --                                                          ; {{{1
--
--  File        : Koneko/Test.hs
--  Maintainer  : Felix C. Stegerman <flx@obfusk.net>
--  Date        : 2022-02-12
--
--  Copyright   : Copyright (C) 2022  Felix C. Stegerman
--  Version     : v0.0.1
--  License     : GPLv3+
--
--  --                                                          ; }}}1

{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Koneko.Test (
  doctest, doctest', testFiles, testKoneko, testMarkdown, testKoneko_,
  testMarkdown_, testKonekoFile, testMarkdownFile, testKonekoFile_,
  testMarkdownFile_
) where

import GHC.IO.Handle (hDuplicate, hDuplicateTo)

import Control.Exception (bracket)
import Control.Monad (unless, when)
import Data.Char (isSpace)
import Data.Foldable (foldl', traverse_)
import Data.Text (Text)
import Prelude hiding (exp, fail)
import System.Console.CmdArgs.Verbosity (Verbosity(..), getVerbosity)
import System.Directory (getTemporaryDirectory, removeFile)
import System.Exit (exitFailure)
import System.FilePath (takeExtension)
import System.IO (Handle)

#if !MIN_VERSION_GLASGOW_HASKELL(8, 8, 1, 0)
import Data.Monoid((<>))
#endif

import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified System.IO as IO
import qualified System.IO.Silently as S

import Koneko.Data (Context, Stack, emptyStack, initMain)
import Koneko.Eval (initContext)

import qualified Koneko.Repl as RE

data Example = Example {
  Example -> FilePath
fileName    :: FilePath,
  Example -> Int
lineNo      :: Int,
  Example -> Text
inputLine   :: Text,
  Example -> [Text]
outputLines :: [Text]
} deriving Int -> Example -> ShowS
[Example] -> ShowS
Example -> FilePath
(Int -> Example -> ShowS)
-> (Example -> FilePath) -> ([Example] -> ShowS) -> Show Example
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Example] -> ShowS
$cshowList :: [Example] -> ShowS
show :: Example -> FilePath
$cshow :: Example -> FilePath
showsPrec :: Int -> Example -> ShowS
$cshowsPrec :: Int -> Example -> ShowS
Show

type ExampleGroup = [Example]
type Examples     = [ExampleGroup]

doctest :: Verbosity -> [FilePath] -> IO Bool
doctest :: Verbosity -> [FilePath] -> IO Bool
doctest Verbosity
v [FilePath]
fs = do
  Context
ctx <- IO Context
initContext
  (Int, Int, Int) -> Bool
_testFail ((Int, Int, Int) -> Bool) -> IO (Int, Int, Int) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> Verbosity -> [FilePath] -> IO (Int, Int, Int)
testFiles Context
ctx Verbosity
v [FilePath]
fs

doctest' :: [FilePath] -> IO ()
doctest' :: [FilePath] -> IO ()
doctest' [FilePath]
fs
  = IO Verbosity
getVerbosity IO Verbosity -> (Verbosity -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Verbosity -> [FilePath] -> IO Bool)
-> [FilePath] -> Verbosity -> IO Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Verbosity -> [FilePath] -> IO Bool
doctest [FilePath]
fs IO Bool -> (Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> IO () -> IO ()) -> IO () -> Bool -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless IO ()
forall a. IO a
exitFailure

testFiles :: Context -> Verbosity -> [FilePath] -> IO (Int, Int, Int)
testFiles :: Context -> Verbosity -> [FilePath] -> IO (Int, Int, Int)
testFiles Context
ctx Verbosity
verb [FilePath]
files = do
    r :: (Int, Int, Int)
r@(Int
t,Int
o,Int
f) <- [(Int, Int, Int)] -> (Int, Int, Int)
s ([(Int, Int, Int)] -> (Int, Int, Int))
-> IO [(Int, Int, Int)] -> IO (Int, Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO (Int, Int, Int))
-> [FilePath] -> IO [(Int, Int, Int)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO (Int, Int, Int)
process [FilePath]
files
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verb Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
/= Verbosity
Quiet) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      FilePath -> IO ()
putStrLn FilePath
"=== Summary ==="
      FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Files: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
files) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"."
      Int -> Int -> Int -> IO ()
printSummary Int
t Int
o Int
f
    (Int, Int, Int) -> IO (Int, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int, Int, Int)
r
  where
    process :: FilePath -> IO (Int, Int, Int)
process FilePath
fp = do
      let (FilePath
what, Context -> Verbosity -> FilePath -> IO (Int, Int, Int)
func)  = FilePath
-> (FilePath,
    Context -> Verbosity -> FilePath -> IO (Int, Int, Int))
forall a.
IsString a =>
FilePath
-> (a, Context -> Verbosity -> FilePath -> IO (Int, Int, Int))
typAndFunc FilePath
fp
          info :: FilePath
info          = FilePath
fp FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" (" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
what FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
")"
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verb Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
/= Verbosity
Quiet) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"=== Testing " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
info FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" ==="
      Context -> Verbosity -> FilePath -> IO (Int, Int, Int)
func Context
ctx Verbosity
verb FilePath
fp IO (Int, Int, Int) -> IO () -> IO (Int, Int, Int)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verb Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
/= Verbosity
Quiet) (FilePath -> IO ()
putStrLn FilePath
"")
    typAndFunc :: FilePath
-> (a, Context -> Verbosity -> FilePath -> IO (Int, Int, Int))
typAndFunc FilePath
fp = if ShowS
takeExtension FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".md"
                    then (a
"markdown", Context -> Verbosity -> FilePath -> IO (Int, Int, Int)
testMarkdownFile)
                    else (a
"koneko"  , Context -> Verbosity -> FilePath -> IO (Int, Int, Int)
testKonekoFile  )
    s :: [(Int, Int, Int)] -> (Int, Int, Int)
s = ((Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int))
-> (Int, Int, Int) -> [(Int, Int, Int)] -> (Int, Int, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(Int
t,Int
o,Int
f) (Int
t',Int
o',Int
f') -> (Int
tInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
t',Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
o',Int
fInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
f')) (Int
0,Int
0,Int
0)

testKoneko, testMarkdown
  :: Context -> Verbosity -> FilePath -> [Text] -> IO (Int, Int, Int)
testKoneko :: Context -> Verbosity -> FilePath -> [Text] -> IO (Int, Int, Int)
testKoneko   Context
ctx Verbosity
v FilePath
fp = Context -> Verbosity -> Examples -> IO (Int, Int, Int)
testExamples Context
ctx Verbosity
v (Examples -> IO (Int, Int, Int))
-> ([Text] -> Examples) -> [Text] -> IO (Int, Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [Text] -> Examples
parseKoneko   FilePath
fp
testMarkdown :: Context -> Verbosity -> FilePath -> [Text] -> IO (Int, Int, Int)
testMarkdown Context
ctx Verbosity
v FilePath
fp = Context -> Verbosity -> Examples -> IO (Int, Int, Int)
testExamples Context
ctx Verbosity
v (Examples -> IO (Int, Int, Int))
-> ([Text] -> Examples) -> [Text] -> IO (Int, Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [Text] -> Examples
parseMarkdown FilePath
fp

testKoneko_, testMarkdown_
  :: Context -> Verbosity -> FilePath -> [Text] -> IO Bool
testKoneko_ :: Context -> Verbosity -> FilePath -> [Text] -> IO Bool
testKoneko_   = (FilePath -> [Text] -> Examples)
-> Context -> Verbosity -> FilePath -> [Text] -> IO Bool
_test FilePath -> [Text] -> Examples
parseKoneko
testMarkdown_ :: Context -> Verbosity -> FilePath -> [Text] -> IO Bool
testMarkdown_ = (FilePath -> [Text] -> Examples)
-> Context -> Verbosity -> FilePath -> [Text] -> IO Bool
_test FilePath -> [Text] -> Examples
parseMarkdown

_test :: (FilePath -> [Text] -> Examples)
      -> Context -> Verbosity -> FilePath -> [Text] -> IO Bool
_test :: (FilePath -> [Text] -> Examples)
-> Context -> Verbosity -> FilePath -> [Text] -> IO Bool
_test FilePath -> [Text] -> Examples
f Context
ctx Verbosity
v FilePath
fp [Text]
ls = (Int, Int, Int) -> Bool
_testFail ((Int, Int, Int) -> Bool) -> IO (Int, Int, Int) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> Verbosity -> Examples -> IO (Int, Int, Int)
testExamples Context
ctx Verbosity
v (FilePath -> [Text] -> Examples
f FilePath
fp [Text]
ls)

_testFail :: (Int, Int, Int) -> Bool
_testFail :: (Int, Int, Int) -> Bool
_testFail (Int
_, Int
_, Int
fail) = Int
fail Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

testKonekoFile, testMarkdownFile
  :: Context -> Verbosity -> FilePath -> IO (Int, Int, Int)
testKonekoFile :: Context -> Verbosity -> FilePath -> IO (Int, Int, Int)
testKonekoFile    = (Context -> Verbosity -> FilePath -> [Text] -> IO (Int, Int, Int))
-> Context -> Verbosity -> FilePath -> IO (Int, Int, Int)
forall a.
(Context -> Verbosity -> FilePath -> [Text] -> IO a)
-> Context -> Verbosity -> FilePath -> IO a
_testFile Context -> Verbosity -> FilePath -> [Text] -> IO (Int, Int, Int)
testKoneko
testMarkdownFile :: Context -> Verbosity -> FilePath -> IO (Int, Int, Int)
testMarkdownFile  = (Context -> Verbosity -> FilePath -> [Text] -> IO (Int, Int, Int))
-> Context -> Verbosity -> FilePath -> IO (Int, Int, Int)
forall a.
(Context -> Verbosity -> FilePath -> [Text] -> IO a)
-> Context -> Verbosity -> FilePath -> IO a
_testFile Context -> Verbosity -> FilePath -> [Text] -> IO (Int, Int, Int)
testMarkdown

testKonekoFile_, testMarkdownFile_
  :: Context -> Verbosity -> FilePath -> IO Bool
testKonekoFile_ :: Context -> Verbosity -> FilePath -> IO Bool
testKonekoFile_   = (Context -> Verbosity -> FilePath -> [Text] -> IO Bool)
-> Context -> Verbosity -> FilePath -> IO Bool
forall a.
(Context -> Verbosity -> FilePath -> [Text] -> IO a)
-> Context -> Verbosity -> FilePath -> IO a
_testFile Context -> Verbosity -> FilePath -> [Text] -> IO Bool
testKoneko_
testMarkdownFile_ :: Context -> Verbosity -> FilePath -> IO Bool
testMarkdownFile_ = (Context -> Verbosity -> FilePath -> [Text] -> IO Bool)
-> Context -> Verbosity -> FilePath -> IO Bool
forall a.
(Context -> Verbosity -> FilePath -> [Text] -> IO a)
-> Context -> Verbosity -> FilePath -> IO a
_testFile Context -> Verbosity -> FilePath -> [Text] -> IO Bool
testMarkdown_

_testFile :: (Context -> Verbosity -> FilePath -> [Text] -> IO a)
          -> Context -> Verbosity -> FilePath -> IO a
_testFile :: (Context -> Verbosity -> FilePath -> [Text] -> IO a)
-> Context -> Verbosity -> FilePath -> IO a
_testFile Context -> Verbosity -> FilePath -> [Text] -> IO a
f Context
ctx Verbosity
v FilePath
fp = FilePath -> IO Text
T.readFile FilePath
fp IO Text -> (Text -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Context -> Verbosity -> FilePath -> [Text] -> IO a
f Context
ctx Verbosity
v FilePath
fp ([Text] -> IO a) -> (Text -> [Text]) -> Text -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines

-- parsing --

parseKoneko, parseMarkdown :: FilePath -> [Text] -> Examples
parseKoneko :: FilePath -> [Text] -> Examples
parseKoneko   FilePath
fp = FilePath -> [[(Int, Text)]] -> Examples
examples FilePath
fp ([[(Int, Text)]] -> Examples)
-> ([Text] -> [[(Int, Text)]]) -> [Text] -> Examples
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Int, Text)]] -> [(Int, Text)] -> [[(Int, Text)]]
knkCommentBlocks [] ([(Int, Text)] -> [[(Int, Text)]])
-> ([Text] -> [(Int, Text)]) -> [Text] -> [[(Int, Text)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..]
parseMarkdown :: FilePath -> [Text] -> Examples
parseMarkdown FilePath
fp = FilePath -> [[(Int, Text)]] -> Examples
examples FilePath
fp ([[(Int, Text)]] -> Examples)
-> ([Text] -> [[(Int, Text)]]) -> [Text] -> Examples
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Int, Text)]] -> [(Int, Text)] -> [[(Int, Text)]]
mdCodeBlocks     [] ([(Int, Text)] -> [[(Int, Text)]])
-> ([Text] -> [(Int, Text)]) -> [Text] -> [[(Int, Text)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..]

examples :: FilePath -> [[(Int, Text)]] -> Examples
examples :: FilePath -> [[(Int, Text)]] -> Examples
examples FilePath
fp = ([Example] -> Bool) -> Examples -> Examples
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Example] -> Bool) -> [Example] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Example] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (Examples -> Examples)
-> ([[(Int, Text)]] -> Examples) -> [[(Int, Text)]] -> Examples
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Int, Text)] -> [Example]) -> [[(Int, Text)]] -> Examples
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> [Example] -> [(Int, Text)] -> [Example]
exampleGroup FilePath
fp [])

-- TODO
exampleGroup :: FilePath -> ExampleGroup -> [(Int, Text)] -> ExampleGroup
exampleGroup :: FilePath -> [Example] -> [(Int, Text)] -> [Example]
exampleGroup FilePath
fileName [Example]
es [(Int, Text)]
ls
    = if [(Int, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Text)]
ls Bool -> Bool -> Bool
|| [(Int, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Text)]
ls' then [Example] -> [Example]
forall a. [a] -> [a]
reverse [Example]
es
      else FilePath -> [Example] -> [(Int, Text)] -> [Example]
exampleGroup FilePath
fileName (Example :: FilePath -> Int -> Text -> [Text] -> Example
Example{Int
FilePath
[Text]
Text
inputLine :: Text
lineNo :: Int
outputLines :: [Text]
fileName :: FilePath
outputLines :: [Text]
inputLine :: Text
lineNo :: Int
fileName :: FilePath
..}Example -> [Example] -> [Example]
forall a. a -> [a] -> [a]
:[Example]
es) [(Int, Text)]
ls''
  where
    ls' :: [(Int, Text)]
ls'             = ((Int, Text) -> Bool) -> [(Int, Text)] -> [(Int, Text)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> ((Int, Text) -> Bool) -> (Int, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
isPrompt' (Text -> Bool) -> ((Int, Text) -> Text) -> (Int, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Text) -> Text
forall a b. (a, b) -> b
snd) [(Int, Text)]
ls
    ([(Int, Text)]
e, [(Int, Text)]
ls'')       = ((Int, Text) -> Bool)
-> [(Int, Text)] -> ([(Int, Text)], [(Int, Text)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Text -> Bool
isSameExample (Text -> Bool) -> ((Int, Text) -> Text) -> (Int, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Text) -> Text
forall a b. (a, b) -> b
snd) ([(Int, Text)] -> ([(Int, Text)], [(Int, Text)]))
-> [(Int, Text)] -> ([(Int, Text)], [(Int, Text)])
forall a b. (a -> b) -> a -> b
$ [(Int, Text)] -> [(Int, Text)]
forall a. [a] -> [a]
tail [(Int, Text)]
ls'   -- safe!
    e' :: [Text]
e'              = ((Int, Text) -> Text) -> [(Int, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
dropPrefix (Text -> Text) -> ((Int, Text) -> Text) -> (Int, Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Text) -> Text
forall a b. (a, b) -> b
snd) [(Int, Text)]
e
    ([Text]
c,[Text]
outputLines) = (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Text -> Bool
isCont [Text]
e'
    (Int
lineNo, Text
fl)    = [(Int, Text)] -> (Int, Text)
forall a. [a] -> a
head [(Int, Text)]
ls'                                -- safe!
    inputLine :: Text
inputLine       = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
dropPrompt (Text -> Text
dropPrefix Text
flText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
c)
    isSameExample :: Text -> Bool
isSameExample Text
s = Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Text
x -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
isPrompt Text
x Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
x)
                    (Maybe Text -> Bool) -> Maybe Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripPrefix Text
prefix Text
s
    dropPrefix :: Text -> Text
dropPrefix      = Int -> Text -> Text
T.drop (Int -> Text -> Text) -> Int -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
prefix
    dropPrompt :: Text -> Text
dropPrompt      = Int -> Text -> Text
T.drop (Int -> Text -> Text) -> Int -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
forall s. IsString s => s
RE.promptText
    prefix :: Text
prefix          = (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
isSpace Text
fl
    isPrompt' :: Text -> Bool
isPrompt'       = Text -> Bool
isPrompt (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isSpace
    isPrompt :: Text -> Bool
isPrompt        = Text -> Text -> Bool
T.isPrefixOf Text
forall s. IsString s => s
RE.promptText
    isCont :: Text -> Bool
isCont          = Text -> Text -> Bool
T.isPrefixOf Text
"... "                     --  TODO

-- TODO
knkCommentBlocks :: [[(Int, Text)]] -> [(Int, Text)] -> [[(Int, Text)]]
knkCommentBlocks :: [[(Int, Text)]] -> [(Int, Text)] -> [[(Int, Text)]]
knkCommentBlocks [[(Int, Text)]]
bs [(Int, Text)]
ls
    = if [(Int, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Text)]
ls Bool -> Bool -> Bool
|| [(Int, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Text)]
ls' then [[(Int, Text)]] -> [[(Int, Text)]]
forall a. [a] -> [a]
reverse [[(Int, Text)]]
bs
      else [[(Int, Text)]] -> [(Int, Text)] -> [[(Int, Text)]]
knkCommentBlocks ([(Int, Text)]
b'[(Int, Text)] -> [[(Int, Text)]] -> [[(Int, Text)]]
forall a. a -> [a] -> [a]
:[[(Int, Text)]]
bs) [(Int, Text)]
ls''
  where
    ls' :: [(Int, Text)]
ls'             = ((Int, Text) -> Bool) -> [(Int, Text)] -> [(Int, Text)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> ((Int, Text) -> Bool) -> (Int, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Text) -> Bool
forall a. (a, Text) -> Bool
isComment) [(Int, Text)]
ls
    ([(Int, Text)]
b, [(Int, Text)]
ls'')       = ((Int, Text) -> Bool)
-> [(Int, Text)] -> ([(Int, Text)], [(Int, Text)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Int, Text) -> Bool
forall a. (a, Text) -> Bool
isSameComment [(Int, Text)]
ls'
    b' :: [(Int, Text)]
b'              = [ (Int
n,Int -> Text -> Text
T.drop (Text -> Int
T.length Text
prefix) Text
x) | (Int
n,Text
x) <- [(Int, Text)]
b ]
    isComment :: (a, Text) -> Bool
isComment       = Text -> Text -> Bool
T.isPrefixOf Text
";" (Text -> Bool) -> ((a, Text) -> Text) -> (a, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isSpace (Text -> Text) -> ((a, Text) -> Text) -> (a, Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Text) -> Text
forall a b. (a, b) -> b
snd
    isSameComment :: (a, Text) -> Bool
isSameComment   = Text -> Text -> Bool
T.isPrefixOf Text
prefix (Text -> Bool) -> ((a, Text) -> Text) -> (a, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Text) -> Text
forall a b. (a, b) -> b
snd
    prefix :: Text
prefix          = (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
isSpace ((Int, Text) -> Text
forall a b. (a, b) -> b
snd ((Int, Text) -> Text) -> (Int, Text) -> Text
forall a b. (a -> b) -> a -> b
$ [(Int, Text)] -> (Int, Text)
forall a. [a] -> a
head [(Int, Text)]
ls') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";" -- safe!

-- TODO
mdCodeBlocks :: [[(Int, Text)]] -> [(Int, Text)] -> [[(Int, Text)]]
mdCodeBlocks :: [[(Int, Text)]] -> [(Int, Text)] -> [[(Int, Text)]]
mdCodeBlocks [[(Int, Text)]]
bs [] = [[(Int, Text)]] -> [[(Int, Text)]]
forall a. [a] -> [a]
reverse [[(Int, Text)]]
bs
mdCodeBlocks [[(Int, Text)]]
bs [(Int, Text)]
ls = [[(Int, Text)]] -> [(Int, Text)] -> [[(Int, Text)]]
mdCodeBlocks ([(Int, Text)]
b[(Int, Text)] -> [[(Int, Text)]] -> [[(Int, Text)]]
forall a. a -> [a] -> [a]
:[[(Int, Text)]]
bs) ([(Int, Text)] -> [[(Int, Text)]])
-> [(Int, Text)] -> [[(Int, Text)]]
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, Text)] -> [(Int, Text)]
forall a. Int -> [a] -> [a]
drop Int
1 [(Int, Text)]
ls''
  where
    ls' :: [(Int, Text)]
ls'             = ((Int, Text) -> Bool) -> [(Int, Text)] -> [(Int, Text)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
mdCodeStart) (Text -> Bool) -> ((Int, Text) -> Text) -> (Int, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Text) -> Text
forall a b. (a, b) -> b
snd) [(Int, Text)]
ls
    ([(Int, Text)]
b, [(Int, Text)]
ls'')       = ((Int, Text) -> Bool)
-> [(Int, Text)] -> ([(Int, Text)], [(Int, Text)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
mdCodeEnd) (Text -> Bool) -> ((Int, Text) -> Text) -> (Int, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Text) -> Text
forall a b. (a, b) -> b
snd) ([(Int, Text)] -> ([(Int, Text)], [(Int, Text)]))
-> [(Int, Text)] -> ([(Int, Text)], [(Int, Text)])
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, Text)] -> [(Int, Text)]
forall a. Int -> [a] -> [a]
drop Int
1 [(Int, Text)]
ls'

mdCodeStart, mdCodeEnd :: Text
mdCodeStart :: Text
mdCodeStart = Text
"```koneko"
mdCodeEnd :: Text
mdCodeEnd   = Text
"```"

-- internal --

-- TODO
testExamples :: Context -> Verbosity -> Examples -> IO (Int, Int, Int)
testExamples :: Context -> Verbosity -> Examples -> IO (Int, Int, Int)
testExamples Context
ctx Verbosity
verb Examples
ex = do
    r :: (Int, Int, Int)
r@(Int
total, Int
ok, Int
fail) <- Int -> Int -> Int -> Examples -> IO (Int, Int, Int)
go Int
0 Int
0 Int
0 Examples
ex
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verb Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Loud) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      FilePath -> IO ()
putStrLn FilePath
"=== Summary ==="
      Int -> Int -> Int -> IO ()
printSummary Int
total Int
ok Int
fail
    (Int, Int, Int) -> IO (Int, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int, Int, Int)
r
  where
    go :: Int -> Int -> Int -> Examples -> IO (Int, Int, Int)
go Int
total Int
ok Int
fail []     = (Int, Int, Int) -> IO (Int, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
total, Int
ok, Int
fail)
    go Int
total Int
ok Int
fail ([Example]
g:Examples
gt) = do
      (Int
t, Int
o, Int
f) <- Context -> Verbosity -> [Example] -> IO (Int, Int, Int)
testExampleGroup Context
ctx Verbosity
verb [Example]
g
      Int -> Int -> Int -> Examples -> IO (Int, Int, Int)
go (Int
totalInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
t) (Int
okInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
o) (Int
failInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
f) Examples
gt

-- TODO
testExampleGroup
  :: Context -> Verbosity -> ExampleGroup -> IO (Int, Int, Int)
testExampleGroup :: Context -> Verbosity -> [Example] -> IO (Int, Int, Int)
testExampleGroup Context
ctx Verbosity
verb [Example]
g = do
    Context -> IO ()
initMain Context
ctx                                              --  TODO
    let st :: Stack
st = Stack
emptyStack; total :: Int
total = [Example] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Example]
g
    (Int
ok, Int
fail, Stack
_) <- Int -> Int -> [Example] -> Context -> Stack -> IO (Int, Int, Stack)
loop Int
0 Int
0 [Example]
g Context
ctx Stack
st
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verb Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Loud) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do Int -> Int -> Int -> IO ()
printTTPF Int
total Int
ok Int
fail; FilePath -> IO ()
putStrLn FilePath
""
    (Int, Int, Int) -> IO (Int, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
total, Int
ok, Int
fail)
  where
    loop :: Int -> Int -> ExampleGroup
         -> Context -> Stack -> IO (Int, Int, Stack)
    loop :: Int -> Int -> [Example] -> Context -> Stack -> IO (Int, Int, Stack)
loop Int
ok Int
fail [] Context
_ Stack
s = (Int, Int, Stack) -> IO (Int, Int, Stack)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
ok, Int
fail, Stack
s)
    loop Int
ok Int
fail (e :: Example
e@Example{Int
FilePath
[Text]
Text
outputLines :: [Text]
inputLine :: Text
lineNo :: Int
fileName :: FilePath
outputLines :: Example -> [Text]
inputLine :: Example -> Text
lineNo :: Example -> Int
fileName :: Example -> FilePath
..}:[Example]
et) Context
c Stack
s = do
      (FilePath
out, FilePath
err, Stack
s') <- FilePath
-> IO (FilePath, FilePath, Stack) -> IO (FilePath, FilePath, Stack)
forall a. FilePath -> IO a -> IO a
provide (Text -> FilePath
T.unpack Text
inputLine)
                      (IO (FilePath, FilePath, Stack) -> IO (FilePath, FilePath, Stack))
-> IO (FilePath, FilePath, Stack) -> IO (FilePath, FilePath, Stack)
forall a b. (a -> b) -> a -> b
$ IO Stack -> IO (FilePath, FilePath, Stack)
forall a. IO a -> IO (FilePath, FilePath, a)
capture (IO Stack -> IO (FilePath, FilePath, Stack))
-> IO Stack -> IO (FilePath, FilePath, Stack)
forall a b. (a -> b) -> a -> b
$ Context -> Stack -> IO Stack
repl Context
c Stack
s
      let olines :: [Text]
olines = FilePath -> [Text]
asLines FilePath
out; elines :: [Text]
elines = FilePath -> [Text]
asLines FilePath
err
      if [Text] -> [Text] -> [Text] -> Bool
compareOutput [Text]
outputLines [Text]
olines [Text]
elines then do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verb Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Loud) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Example -> IO ()
printSucc Example
e
        Int -> Int -> [Example] -> Context -> Stack -> IO (Int, Int, Stack)
loop (Int
okInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
fail [Example]
et Context
c Stack
s'
      else do
        Example -> [Text] -> [Text] -> IO ()
printFail Example
e [Text]
olines [Text]
elines
        (Int, Int, Stack) -> IO (Int, Int, Stack)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
ok, Int
failInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Stack
s')
    repl :: Context -> Stack -> IO Stack
repl = Bool -> Text -> Context -> Stack -> IO Stack
RE.repl' Bool
True Text
""
    asLines :: FilePath -> [Text]
asLines FilePath
x = let l :: [Text]
l = Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
x in
                if Bool -> Bool
not ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
l) Bool -> Bool -> Bool
&& [Text] -> Text
forall a. [a] -> a
last [Text]
l Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" then [Text] -> [Text]
forall a. [a] -> [a]
init [Text]
l else [Text]
l

-- TODO: "...", ...
compareOutput :: [Text] -> [Text] -> [Text] -> Bool
compareOutput :: [Text] -> [Text] -> [Text] -> Bool
compareOutput [Text]
exp [Text]
got [Text]
err
    = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
err then [Text]
exp' [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text]
got else [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
got Bool -> Bool -> Bool
&&
      Text -> Text -> Bool
T.isPrefixOf Text
forall s. IsString s => s
RE.errorText ([Text] -> Text
forall a. [a] -> a
head [Text]
err) Bool -> Bool -> Bool
&& [Text]
exp' [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text]
err     -- safe!
  where
    exp' :: [Text]
exp' = [ if Text
l Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"<BLANKLINE>" then Text
"" else Text
l | Text
l <- [Text]
exp ]

printSummary :: Int -> Int -> Int -> IO ()
printSummary :: Int -> Int -> Int -> IO ()
printSummary Int
total Int
ok Int
fail = do
  Int -> Int -> Int -> IO ()
printTTPF Int
total Int
ok Int
fail
  FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Test " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ if Int
fail Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then FilePath
"passed." else FilePath
"failed."

printTTPF :: Int -> Int -> Int -> IO ()
printTTPF :: Int -> Int -> Int -> IO ()
printTTPF Int
total Int
ok Int
fail =
  FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$  FilePath
"Total: "   FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
total) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
            FilePath
", Tried: "   FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath) -> Int -> FilePath
forall a b. (a -> b) -> a -> b
$ Int
ok Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fail) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
            FilePath
", Passed: "  FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
ok) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
            FilePath
", Failed: "  FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
fail) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"."

-- TODO
printSucc :: Example -> IO ()
printSucc :: Example -> IO ()
printSucc Example{Int
FilePath
[Text]
Text
outputLines :: [Text]
inputLine :: Text
lineNo :: Int
fileName :: FilePath
outputLines :: Example -> [Text]
inputLine :: Example -> Text
lineNo :: Example -> Int
fileName :: Example -> FilePath
..} = do
    Text -> IO ()
p Text
"Trying:"   ; Text -> IO ()
p (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
indent Text
inputLine
    Text -> IO ()
p Text
"Expecting:"; (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Text -> IO ()
p (Text -> IO ()) -> (Text -> Text) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
indent) [Text]
outputLines
    Text -> IO ()
p Text
"ok"
  where
    p :: Text -> IO ()
p = Text -> IO ()
T.putStrLn

-- TODO
printFail :: Example -> [Text] -> [Text] -> IO ()
printFail :: Example -> [Text] -> [Text] -> IO ()
printFail Example{Int
FilePath
[Text]
Text
outputLines :: [Text]
inputLine :: Text
lineNo :: Int
fileName :: FilePath
outputLines :: Example -> [Text]
inputLine :: Example -> Text
lineNo :: Example -> Int
fileName :: Example -> FilePath
..} [Text]
out [Text]
err = do
    Text -> IO ()
p (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
"File " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
fileName FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
", line " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
lineNo
    Text -> IO ()
p Text
"Failed example:" ; Text -> IO ()
p (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
indent Text
inputLine
    Text -> IO ()
p Text
"Expected:"       ; (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Text -> IO ()
p (Text -> IO ()) -> (Text -> Text) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
indent) [Text]
outputLines
    Text -> IO ()
p Text
"Got:"            ; (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Text -> IO ()
p (Text -> IO ()) -> (Text -> Text) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
indent) [Text]
out
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Text -> IO ()
p Text
"Errors:"       ; (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Text -> IO ()
p (Text -> IO ()) -> (Text -> Text) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
indent) [Text]
err
  where
    p :: Text -> IO ()
p = Handle -> Text -> IO ()
T.hPutStrLn Handle
IO.stderr

indent :: Text -> Text
indent :: Text -> Text
indent = (Text
"  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)

-- stdio --

capture :: IO a -> IO (String, String, a)
capture :: IO a -> IO (FilePath, FilePath, a)
capture IO a
act = do
  (FilePath
err, (FilePath
out, a
x)) <- [Handle] -> IO (FilePath, a) -> IO (FilePath, (FilePath, a))
forall a. [Handle] -> IO a -> IO (FilePath, a)
S.hCapture [Handle
IO.stderr] (IO (FilePath, a) -> IO (FilePath, (FilePath, a)))
-> IO (FilePath, a) -> IO (FilePath, (FilePath, a))
forall a b. (a -> b) -> a -> b
$ IO a -> IO (FilePath, a)
forall a. IO a -> IO (FilePath, a)
S.capture IO a
act
  (FilePath, FilePath, a) -> IO (FilePath, FilePath, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
out, FilePath
err, a
x)

provide :: String -> IO a -> IO a
provide :: FilePath -> IO a -> IO a
provide = Handle -> FilePath -> IO a -> IO a
forall a. Handle -> FilePath -> IO a -> IO a
hProvide Handle
IO.stdin

hProvide :: Handle -> String -> IO a -> IO a
hProvide :: Handle -> FilePath -> IO a -> IO a
hProvide Handle
h FilePath
str IO a
act = FilePath -> (Handle -> IO a) -> IO a
forall a. FilePath -> (Handle -> IO a) -> IO a
withTempFile FilePath
"provide" Handle -> IO a
f
  where
    f :: Handle -> IO a
f Handle
hTmp = do
      Handle -> FilePath -> IO ()
IO.hPutStr Handle
hTmp FilePath
str; Handle -> IO ()
IO.hFlush Handle
hTmp
      Handle -> SeekMode -> Integer -> IO ()
IO.hSeek Handle
hTmp SeekMode
IO.AbsoluteSeek Integer
0
      Handle -> Handle -> IO a -> IO a
forall a. Handle -> Handle -> IO a -> IO a
withRedirect Handle
h Handle
hTmp IO a
act

withRedirect :: Handle -> Handle -> IO a -> IO a
withRedirect :: Handle -> Handle -> IO a -> IO a
withRedirect Handle
hOrig Handle
hRepl IO a
act = do
    BufferMode
buf <- Handle -> IO BufferMode
IO.hGetBuffering Handle
hOrig
    IO Handle -> (Handle -> IO ()) -> (Handle -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Handle
redirect (BufferMode -> Handle -> IO ()
restore BufferMode
buf) ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ IO a -> Handle -> IO a
forall a b. a -> b -> a
const IO a
act
  where
    redirect :: IO Handle
redirect = do
      Handle
hDup <- Handle -> IO Handle
hDuplicate Handle
hOrig
      Handle -> Handle -> IO ()
hDuplicateTo Handle
hRepl Handle
hOrig
      Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
hDup
    restore :: BufferMode -> Handle -> IO ()
restore BufferMode
buf Handle
hDup = do
      Handle -> Handle -> IO ()
hDuplicateTo Handle
hDup Handle
hOrig
      Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
hOrig BufferMode
buf
      Handle -> IO ()
IO.hClose Handle
hDup

withTempFile :: String -> (Handle -> IO a) -> IO a
withTempFile :: FilePath -> (Handle -> IO a) -> IO a
withTempFile FilePath
template Handle -> IO a
f = do
    FilePath
tmpDir <- IO FilePath
getTemporaryDirectory
    IO (FilePath, Handle)
-> ((FilePath, Handle) -> IO ())
-> ((FilePath, Handle) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> FilePath -> IO (FilePath, Handle)
IO.openTempFile FilePath
tmpDir FilePath
template) (FilePath, Handle) -> IO ()
cleanup (Handle -> IO a
f (Handle -> IO a)
-> ((FilePath, Handle) -> Handle) -> (FilePath, Handle) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, Handle) -> Handle
forall a b. (a, b) -> b
snd)
  where
    cleanup :: (FilePath, Handle) -> IO ()
cleanup (FilePath
tmpFile, Handle
h) = Handle -> IO ()
IO.hClose Handle
h IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
removeFile FilePath
tmpFile  -- !!!

-- vim: set tw=70 sw=2 sts=2 et fdm=marker :