Property.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Test.Property where

import           Prelude                      (($), (.), not)
import           Control.Applicative
import qualified Data.List                    as List
import qualified Data.List.NonEmpty           as NonEmpty
import           Data.Semigroup
import           Data.Text                    hiding (toTitle)
import           Data.Text.Titlecase
import           Data.Text.Titlecase.Internal
import           Test.Tasty
import           Test.Tasty.QuickCheck

tests :: TestTree
tests = testGroup "Property tests"
  [ sameLength
  , firstWordCapitalized
  , lastWordCapitalized
  , titlecaseIdempotent
  ]

titlecaseUnsafe :: Text -> Text
titlecaseUnsafe = unTitlecase . titlecase

ignoreList :: [Text]
ignoreList = NonEmpty.toList
   $ (unArticle     <$> articles)
  <> (unConjunction <$> conjunctions)
  <> (unPreposition <$> prepositions)

instance Arbitrary Text where
  arbitrary = elements ignoreList

sameLength :: TestTree
sameLength = testProperty "titlecase doesn't change the length" $
  \t -> length (titlecaseUnsafe t) === length t

firstWordCapitalized :: TestTree
firstWordCapitalized = testProperty "First word is always capitalized" $
  let wordsHead = List.head . words in
  \t -> not (null t) ==>
        wordsHead (titlecaseUnsafe t) === toTitle (wordsHead t)

lastWordCapitalized :: TestTree
lastWordCapitalized = testProperty "Last word is always capitalized" $
  let wordsLast = List.last . words in
  \t -> not (null t) ==>
        wordsLast (titlecaseUnsafe t) === toTitle (wordsLast t)

titlecaseIdempotent :: TestTree
titlecaseIdempotent = testProperty "Applying titlecase twice is the same as doing it once" $
  \t -> titlecaseUnsafe (titlecaseUnsafe t) === titlecaseUnsafe t