{-# 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