ReadWrite.hs

{- SPDX-FileCopyrightText: 2020 Serokell <https://serokell.io/>
 -
 - SPDX-License-Identifier: MPL-2.0
 -}

{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PackageImports      #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- Due to our Data.Text.IO.Utf8 which is deprecated and
-- will be removed later.
{-# OPTIONS_GHC -fno-warn-deprecations #-}

module Test.Utf8.ReadWrite where

import Control.DeepSeq (force)
import Control.Exception (IOException, evaluate)
import Control.Exception.Safe (MonadMask, try)
import Control.Monad ((>=>))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Text (Text)
import GHC.IO.Encoding (utf8)
import System.IO.Temp (withSystemTempFile)

import Hedgehog (Property, forAll, property, (===))
import Test.HUnit (Assertion, assertFailure)

import qualified Data.Text.IO as T
import qualified "with-utf8" Data.Text.IO.Utf8 as Utf8
import qualified System.IO as IO
import qualified System.IO.Utf8 as Utf8

import qualified Hedgehog.Gen as G
import qualified Hedgehog.Range as R


-- | Helper that writes Text to a temp file.
withTestFile :: (MonadIO m, MonadMask m) => Text -> (FilePath -> m r) -> m r
withTestFile t act = withSystemTempFile "utf8.txt" $ \fp h -> do
    liftIO $ IO.hSetEncoding h utf8 *> T.hPutStr h t *> IO.hClose h
    act fp


-- | Sanity check.
unit_standard_readFile_fails :: Assertion
unit_standard_readFile_fails = withTestFile str $ \fp ->
    try (T.readFile fp) >>= \case
      Right _ -> assertFailure "Standard `readFile` should fail."
      Left (_ :: IOException) -> pure ()
  where
    -- We use an escape here because otherwise _both_ tasty-discover
    -- and hedgehog fail when they are reading this file for their
    -- discovery or nice error reporting purposes... I know, right?
    str = "doma\285e"


hprop_readFile :: Property
hprop_readFile = property $ do
    str <- forAll $ G.text (R.linear 0 1000) G.unicode
    str' <- liftIO $ withTestFile str (Utf8.readFile >=> evaluate . force)
    str === str'

hprop_writeFile :: Property
hprop_writeFile = property $ do
    str <- forAll $ G.text (R.linear 0 1000) G.unicode
    liftIO $ withTestFile str (`Utf8.writeFile` str)

hprop_openFile :: Property
hprop_openFile = property $ do
    str <- forAll $ G.text (R.linear 0 1000) G.unicode
    str' <- liftIO $ withTestFile str $ \fp -> do
      h <- Utf8.openFile fp IO.ReadMode
      res <- T.hGetContents h
      res' <- evaluate . force $ res
      IO.hClose h
      pure res'
    str === str'

hprop_withFile :: Property
hprop_withFile = property $ do
    str <- forAll $ G.text (R.linear 0 1000) G.unicode
    str' <- liftIO $ withTestFile str $ \fp ->
      Utf8.withFile fp IO.ReadMode $ \h -> do
        res <- T.hGetContents h
        evaluate . force $ res
    str === str'