TransformeR-0.1.0.0: test/Spec.hs

{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-} 

import Syntax
import Parse
import Types

import Test.QuickCheck
import Test.QuickCheck.Arbitrary
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List

import GHC.Generics
import Data.Typeable

main = checkTysys

-- checks for tysys

checkTysys :: IO ()
checkTysys = do
 fc <- readFile "/home/rem/TransformeR/test/t.R"
 let res = parse prog "/home/rem/TransformeR/test/t.R" fc
 case res of 
   Left e -> putStrLn $ show e
   Right r -> putStrLn $ show (tyTrans r)

-- checks for parser

checkParse :: IO ()
checkParse = do
  quickCheck parseTranOK
-- fc <- readFile "/home/rem/TransformeR/test/t.R"
-- let res = parse prog "/home/rem/TransformeR/test/t.R" fc
-- case res of 
--   Left e -> putStrLn $ show e
--   Right r -> putStrLn $ show r

parseTySigOK :: Descriptor -> Bool
parseTySigOK t = Right t == parse tysig "source" (show t) 
  
parseRecSigOK :: Sig -> Bool
parseRecSigOK r = show r == let Right res = parse recsig "source" (show r) in show res

parseOpOK :: OPR -> Bool
parseOpOK o = Right o == parse opr "source" (show o)

parseValOK :: Value -> Bool
parseValOK v = Right v == parse value "source" (show v)

parseExpOK :: Expression -> Bool
parseExpOK e = show e == let Right res = parse expr "source" (show e) in show res

parseTranOK :: Transformation -> Bool
parseTranOK t = Right t == parse prog "source" (show t)

eps :: Double
eps = 0.00001

deriving instance Eq Transformation
deriving instance Eq Expression
deriving instance Eq Value
instance Eq Range where
  SET xs == SET ys = xs == ys
  INTERVAL n1 n2 == INTERVAL n3 n4 = 
    (n1 <= n3 + eps || n1 >= n3 - eps)
    && (n2 <= n4 + eps || n2 >= n4 - eps)
deriving instance Eq Sig
deriving instance Eq OPR

deriving instance Generic Transformation
deriving instance Generic Expression
deriving instance Generic Value
deriving instance Generic Range
deriving instance Generic Sig
deriving instance Generic OPR

deriving instance Typeable Transformation
deriving instance Typeable Expression
deriving instance Typeable Value
deriving instance Typeable Range
deriving instance Typeable Sig
deriving instance Typeable OPR

-- Default values
dn = "x"
dsig = Sig [(dn, ddes)]
ddes = INTERVAL 1 2
de = LIT $ NUM 1

arbitraryNum :: Gen Double
arbitraryNum = elements [1.0, 99.45, 2.34]

arbitraryName = suchThat arbitrary (\s -> (all isEnglish) s && s /= "")
  where isEnglish x = elem x ['a'..'z']

instance Arbitrary Transformation where
  arbitrary = TRANS <$> arbitraryName <*> arbitrary <*> arbitrary <*> arbitrary
  -- shrink = genericShrink
--  shrink (TRANS n sig1 sig2 e) = [ TRANS dn dsig dsig de
--                                 , TRANS dn sig1 dsig de
--                                 , TRANS dn dsig sig2 de
--                                 , TRANS dn dsig dsig e
--                                 ]
  shrink (TRANS n sig1 sig2 e) = [TRANS dn sig1' sig2' e' | (sig1', sig2', e') <- shrink (sig1, sig2, e)]

instance Arbitrary Sig where
  -- arbitrary = Sig <$> sized (\n -> vectorOf n ((,) <$> arbitraryName <*> arbitrary))
  arbitrary = Sig <$> vectorOf 3 ((,) <$> arbitraryName <*> arbitrary)
  shrink = genericShrink

instance Arbitrary Expression where
  arbitrary = oneof [ LIT <$> arbitrary
                    , PROJ <$> arbitrary <*> arbitraryName
                    -- , OP <$> arbitrary <*> sized (\n -> vectorOf n arbitrary)
                    , OP <$> arbitrary <*> vectorOf 3 arbitrary
                    , REC <$> vectorOf 3 ((,) <$> arbitraryName <*> arbitrary)
                    , VAR <$> arbitraryName
                    , MUTATE <$> arbitraryName <*> arbitraryName <*> arbitrary
                    , SEQ <$> arbitrary <*> arbitrary
                    , ASSIGN <$> arbitraryName <*> arbitrary 
                    ]
  shrink (LIT x) = []
  shrink (PROJ e f) = [e]
  shrink (OP opr [e1, e2, e3]) = [e1, e2, e3]
  shrink (REC [(f1, e1), (f2, e2), (f3, e3)]) = [e1, e2, e3]
  shrink (VAR x) = []
  shrink (MUTATE n l e) = [e]
  shrink (SEQ e1 e2) = [e1, e2]
  shrink (ASSIGN n e) = [e]

instance Arbitrary Value where
  arbitrary = oneof [ NUM <$> arbitraryNum
                    , CAT <$> arbitraryName
                    , MAP <$> vectorOf 3 ((,) <$> arbitraryName <*> arbitrary)
                    ]
  shrink = genericShrink

instance Arbitrary OPR where
  arbitrary = elements [SUM, CONCAT]
  shrink = genericShrink

instance Arbitrary Range where
  arbitrary = oneof [ INTERVAL <$> arbitraryNum <*> arbitraryNum
                    -- , SET <$> sized (\n -> vectorOf n arbitraryName)
                    , SET <$> vectorOf 3 arbitraryName
                    ]
  shrink = genericShrink

-- silly checks for parser

-- main = do
--   fc <- readFile "/home/rem/TransformeR/test/t.R"
--   let res = parse prog "/home/rem/TransformeR/test/t.R" fc
--   case res of 
--     Left e -> putStrLn $ show e
--     Right r -> putStrLn $ show r
--   -- (putStrLn . show) <$> res
-- 
-- p1 = "transform (y : haha) : yolo { \"a\" }"
-- 
-- s = "haha"

-- OLD checks for tysys

-- main :: IO()
-- main = do 
--   print $ c1
--   print $ c2
--   print $ c3
--   print $ c4
--   quickCheck ((\s -> s == s) :: [Char] -> Bool)
--   quickCheck numberForm
--   quickCheck catForm
-- 
-- numberForm :: Number -> Number -> Bool
-- numberForm n1 n2 
--   | n1 <= n2 = tyOK $ NumTy (n1, n2)
--   | otherwise = not . tyOK $ NumTy (n1, n2)
-- 
-- catForm :: [Category] -> Bool
-- catForm cs
--   | isSet cs = tyOK $ CatTy cs
--   | otherwise = not . tyOK $ CatTy cs