Targets.hs

module UnitTests.Distribution.Client.Targets (
  tests
  ) where

import Distribution.Client.Targets     (UserConstraint (..), readUserConstraint)
import Distribution.Compat.ReadP       (ReadP, readP_to_S)
import Distribution.Package            (PackageName (..))
import Distribution.ParseUtils         (parseCommaList)
import Distribution.Text               (parse)

import Test.Tasty
import Test.Tasty.HUnit

import Data.Char                       (isSpace)

tests :: [TestTree]
tests = [ testCase "readUserConstraint" readUserConstraintTest
        , testCase "parseUserConstraint" parseUserConstraintTest
        , testCase "readUserConstraints" readUserConstraintsTest
        ]

readUserConstraintTest :: Assertion
readUserConstraintTest =
  assertEqual ("Couldn't read constraint: '" ++ constr ++ "'") expected actual
  where
    pkgName  = "template-haskell"
    constr   = pkgName ++ " installed"

    expected = UserConstraintInstalled (PackageName pkgName)
    actual   = let (Right r) = readUserConstraint constr in r

parseUserConstraintTest :: Assertion
parseUserConstraintTest =
  assertEqual ("Couldn't parse constraint: '" ++ constr ++ "'") expected actual
  where
    pkgName  = "template-haskell"
    constr   = pkgName ++ " installed"

    expected = [UserConstraintInstalled (PackageName pkgName)]
    actual   = [ x | (x, ys) <- readP_to_S parseUserConstraint constr
                   , all isSpace ys]

    parseUserConstraint :: ReadP r UserConstraint
    parseUserConstraint = parse

readUserConstraintsTest :: Assertion
readUserConstraintsTest =
  assertEqual ("Couldn't read constraints: '" ++ constr ++ "'") expected actual
  where
    pkgName  = "template-haskell"
    constr   = pkgName ++ " installed"

    expected = [[UserConstraintInstalled (PackageName pkgName)]]
    actual   = [ x | (x, ys) <- readP_to_S parseUserConstraints constr
                   , all isSpace ys]

    parseUserConstraints :: ReadP r [UserConstraint]
    parseUserConstraints = parseCommaList parse