liblawless-0.19.0: Tests/TestTextMachine.hs

{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-orphans #-}

{-|
Module:             TestTextMachine
Description:        Test reading lines from text files.
Copyright:          © 2016 All rights reserved.
License:            GPL-3
Maintainer:         Evan Cofsky <evan@theunixman.com>
Stability:          experimental
Portability:        POSIX
-}

module TestTextMachine where

import Lawless
import Path
import Text
import Text.Machine
import IO
import Control.Concurrent.STM
import Machine hiding (run)

import Arbitrary()
import Test.Framework
import Test.Framework.TH
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.QuickCheck
import Test.QuickCheck.Monadic
default (Text)

newtype Line = Line Text deriving (Eq, Ord, Show)
makePrisms ''Line

instance Arbitrary Line where
    arbitrary = Line <$> suchThat arbitrary (allOf each (≢ '\n'))

prop_CheckTextMachine ∷ [Line] → Property
prop_CheckTextMachine lines = monadicIO $ do
    let tls = over traversed (view _Line) lines
    m ← run $ do
        v ← atomically $ newEmptyTMVar
        runManaged $ do
            tf ← tempFile (absDir ("/tmp" ∷ Text)) (relFile ("testTemp" ∷ Text))
            let h = tf ^. tfHandle
            runT_ $ supply tls $ writeLines h
            liftIO $ hSeek h AbsoluteSeek 0
            liftIO $ (runT $ readLines h) >>= atomically ∘ putTMVar v
        liftIO $ atomically $ takeTMVar v
    assert (tls == m)

properties ∷ Test
properties = $(testGroupGenerator)