67 lines
2.5 KiB
Haskell
67 lines
2.5 KiB
Haskell
{-# LANGUAGE NumericUnderscores #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE ApplicativeDo #-}
|
|
module Test.Hledger.Row where
|
|
|
|
import Data.Time
|
|
import qualified Hedgehog.Gen as Gen
|
|
import qualified Hedgehog.Range as Range
|
|
import Hledger.Row
|
|
import Test.Hspec
|
|
import Test.Hspec.Hedgehog
|
|
import qualified Data.Text.Encoding as TE
|
|
import qualified Data.Conduit.Combinators as Conduit
|
|
import Conduit (runConduit, (.|), yield)
|
|
import Data.Foldable (traverse_)
|
|
import qualified Data.ByteString.Char8 as B
|
|
import Data.Maybe (fromJust)
|
|
|
|
genRow :: Gen Row
|
|
genRow = Gen.frequency [(1, pure Empty), (9, Row <$> genContent)]
|
|
where
|
|
genContent :: Gen RowContent
|
|
genContent = RowContent <$> genOperation <*> genTime
|
|
genOperation :: Gen Operation
|
|
genOperation = Gen.choice [In <$> genTask, pure Out]
|
|
genTime :: Gen LocalTime
|
|
genTime = do
|
|
(days, tod) <- timeToDaysAndTimeOfDay . fromInteger <$> Gen.integral (Range.linear 0 1_000_000_000)
|
|
pure $ LocalTime (ModifiedJulianDay days) tod
|
|
genTask :: Gen Task
|
|
-- The fromJust is sensible here because the generator makes non-empty
|
|
-- tasks
|
|
genTask = fromJust . task <$> Gen.text (Range.linear 1 50) (Gen.element taskChars)
|
|
taskChars :: String
|
|
taskChars = '.' : ['a'..'z'] <> ['A'..'Z']
|
|
|
|
spec :: Spec
|
|
spec = context "Hledger.Row" $ do
|
|
describe "Properties of tasks" $ do
|
|
it "a task is never empty" $ hedgehog $ do
|
|
t <- forAll (task <$> Gen.text (Range.linear 0 100) Gen.unicode)
|
|
case t of
|
|
-- If the smart constructor has failed, it means it has caught something
|
|
Nothing -> success
|
|
Just t' -> assert (getTask t' /= "")
|
|
describe "Encoding and decoding rows" $ do
|
|
it "satisfies roundtripping property" $ hedgehog $ do
|
|
row <- forAll genRow
|
|
tripping row encode decode
|
|
it "decodes in the presence of whitespace" $ hedgehog $ do
|
|
row <- forAll genRow
|
|
whitespace <- forAll (TE.encodeUtf8 <$> Gen.text (Range.linear 0 10) (pure ' '))
|
|
let encoded = whitespace <> encode row
|
|
annotateShow encoded
|
|
decode encoded === pure row
|
|
it "doesn't add any extra whitespace" $ hedgehog $ do
|
|
row <- forAll genRow
|
|
let encoded = encode row
|
|
annotateShow encoded
|
|
assert (not (" " `B.isSuffixOf` encoded))
|
|
assert (not (" " `B.isPrefixOf` encoded))
|
|
describe "Handling files" $ do
|
|
it "roundtrips file contents" $ hedgehog $ do
|
|
rows <- forAll (Gen.list (Range.linear 0 100) genRow)
|
|
got <- runConduit (traverse_ yield rows .| encodeFile .| decodeFile .| Conduit.sinkList )
|
|
rows === got
|