kicad-data-0.5.0: tests/PcbnewExpr.hs
{-# OPTIONS_GHC -fno-warn-orphans #-}
module PcbnewExpr
( tests
)
where
import Test.Framework (Test)
import Test.Framework.Providers.QuickCheck2
import Test.QuickCheck
import Control.Monad
import Utils
import Data.Kicad.PcbnewExpr
import Data.Kicad.PcbnewExpr.PcbnewExpr
tests :: [Test]
tests = [ testProperty "parse fp_line correctly" parseFpLineCorrectly
, testProperty "parse fp_arc correctly" parseFpArcCorrectly
, testProperty "parse fp_poly correctly" parseFpPolyCorrectly
, testProperty "parse and write any PcbnewExpr" parseAndWriteAnyPcbnewExpr
, testProperty "parse and pretty any PcbnewExpr" parseAndPrettyAnyPcbnewExpr
]
parseFpLineCorrectly :: (Double, Double, Double, Double, Double)
-> PcbnewLayerT
-> Bool
parseFpLineCorrectly (d1, d2, d3, d4, d5) l =
tracedPropAEq (parse fp_line) fpLine
where
fp_line =
"(fp_line (start " ++ show d1 ++ " "
++ show d2 ++ ") (end " ++ show d3 ++ " "
++ show d4 ++ ") (layer "
++ layerToStr l
++ ") (width " ++ show d5 ++ "))"
fpLine = Right $ PcbnewExprItem
$ PcbnewFpLine (d1, d2) (d3, d4) l d5
parseFpArcCorrectly :: (Double, Double, Double, Double, Double) -> Double
-> PcbnewLayerT
-> Bool
parseFpArcCorrectly (d1, d2, d3, d4, d5) d6 l =
tracedPropAEq (parse fp_arc) fpArc
where
fp_arc =
"(fp_arc (start " ++ show d1 ++ " "
++ show d2 ++ ") (end " ++ show d3 ++ " "
++ show d4 ++ ") (angle " ++ show d5
++ ") (layer " ++ layerToStr l ++ ") (width "
++ show d6 ++ "))"
fpArc = Right $ PcbnewExprItem
$ PcbnewFpArc (d1, d2) (d3, d4) d5 l d6
parseFpPolyCorrectly :: [(Double, Double)] -> Double
-> PcbnewLayerT
-> Bool
parseFpPolyCorrectly ds w l =
tracedPropAEq (parse fp_poly) fpPoly
where
fp_poly =
"(fp_poly (pts "
++ unwords
(map
(\(d1,d2) -> "(xy " ++ show d1 ++ " " ++ show d2 ++ ")")
ds)
++ ") (layer " ++ layerToStr l ++ ") (width "
++ show w ++ "))"
fpPoly = Right $ PcbnewExprItem $ PcbnewFpPoly ds l w
parseAndWriteAnyPcbnewExpr :: PcbnewExpr -> Bool
parseAndWriteAnyPcbnewExpr a = tracedPropAEq t1 t2
where t1 = parse $ write a
t2 = Right a
parseAndPrettyAnyPcbnewExpr :: PcbnewExpr -> Bool
parseAndPrettyAnyPcbnewExpr a = tracedPropAEq t1 t2
where t1 = parse $ show $ pretty a
t2 = Right a
instance Arbitrary PcbnewExpr where
arbitrary = oneof [ do a <- arbitrary
return $ PcbnewExprModule a
, do a <- arbitrary
return $ PcbnewExprItem a
, do a <- arbitrary
return $ PcbnewExprAttribute a
]
instance Arbitrary PcbnewModule where
arbitrary = do n <- genSafeString
l <- arbitrary
attrs <- listOf genModuleAttr
items <- arbitrary
return $ PcbnewModule n l attrs items
where
genModuleAttr :: Gen PcbnewAttribute
genModuleAttr = suchThat arbitrary not_layer
not_layer (PcbnewLayer _) = False
not_layer _ = True
instance Arbitrary PcbnewItem where
arbitrary = oneof [ do t <- arbitrary
s <- genSafeString
a <- arbitrary
l <- arbitrary
h <- arbitrary
si <- arbitrary
th <- arbitrary
i <- arbitrary
j <- arbitrary
return $ PcbnewFpText t s a l h si th i j
, do s <- arbitrary
e <- arbitrary
l <- arbitrary
w <- arbitrary
fp <- elements [PcbnewFpLine, PcbnewFpCircle]
return $ fp s e l w
, do s <- arbitrary
e <- arbitrary
a <- arbitrary
l <- arbitrary
w <- arbitrary
return $ PcbnewFpArc s e a l w
, do ps <- arbitrary
l <- arbitrary
w <- arbitrary
return $ PcbnewFpPoly ps l w
, do n <- genSafeString
t <- arbitrary
s <- arbitrary
a <- arbitrary
si <- arbitrary
l <- arbitrary
attrs <- listOf genPadAttrs
return $ PcbnewPad n t s a si l attrs
]
genPadAttrs :: Gen PcbnewAttribute
genPadAttrs = oneof [ liftM PcbnewRectDelta arbitrary
, liftM PcbnewMaskMargin arbitrary
, liftM PcbnewPasteMarginRatio arbitrary
, liftM PcbnewPasteMargin arbitrary
, liftM PcbnewClearance arbitrary
, liftM PcbnewZoneConnect arbitrary
, liftM PcbnewThermalWidth arbitrary
, liftM PcbnewThermalGap arbitrary
, do a <- arbitrary
b <- arbitrary
return $ PcbnewDrill $ PcbnewDrillT a True b
, do a <- suchThatMaybe arbitrary (uncurry (==))
b <- arbitrary
return $ PcbnewDrill $ PcbnewDrillT a False b
]
instance Arbitrary PcbnewAttribute where
arbitrary = oneof [ genPadAttrs
, oneof [ liftM PcbnewLayer arbitrary
, liftM PcbnewAt arbitrary
, liftM PcbnewSize arbitrary
, liftM PcbnewThickness arbitrary
, liftM PcbnewTedit genSafeString
, liftM PcbnewStart arbitrary
, liftM PcbnewEnd arbitrary
, liftM PcbnewCenter arbitrary
, liftM PcbnewWidth arbitrary
, liftM PcbnewDescr genSafeString
, liftM PcbnewTags genSafeString
, liftM PcbnewAttr genSafeString
, liftM PcbnewLayers arbitrary
, liftM PcbnewAngle arbitrary
, liftM PcbnewXy arbitrary
, liftM PcbnewPts arbitrary
, liftM PcbnewXyz arbitrary
, liftM PcbnewZoneConnect arbitrary
, liftM PcbnewThermalGap arbitrary
, liftM PcbnewThermalWidth arbitrary
, liftM PcbnewModelScale arbitrary
, liftM PcbnewModelRotate arbitrary
, liftM PcbnewClearance arbitrary
, liftM PcbnewMaskMargin arbitrary
, liftM PcbnewPasteMargin arbitrary
, liftM PcbnewPasteMarginRatio arbitrary
, liftM PcbnewAutoplaceCost90 arbitrary
, liftM PcbnewAutoplaceCost180 arbitrary
, liftM PcbnewJustify arbitrary
, do s <- arbitrary
t <- arbitrary
i <- arbitrary
return $ PcbnewFont s t i
, do p <- genSafeString
a <- arbitrary
s <- arbitrary
r <- arbitrary
return $ PcbnewModel p a s r
]
]
instance Arbitrary PcbnewJustifyT where
arbitrary = arbitraryBoundedEnum
instance Arbitrary PcbnewLayerT where
arbitrary = arbitraryBoundedEnum
instance Arbitrary PcbnewFpTextTypeT where
arbitrary = arbitraryBoundedEnum
instance Arbitrary PcbnewPadShapeT where
arbitrary = arbitraryBoundedEnum
instance Arbitrary PcbnewPadTypeT where
arbitrary = arbitraryBoundedEnum
instance Arbitrary PcbnewAtT where
arbitrary = do p <- arbitrary
o <- arbitrary
return $ PcbnewAtT p o