Remove TESTING flag

ethercrow · Aug 21, 2017 · b93a3a7 · b93a3a7
1 parent 9df51b8
commit b93a3a7
Show file tree

Hide file tree

Showing 3 changed files with 0 additions and 143 deletions.
diff --git a/yi-core/package.yaml b/yi-core/package.yaml
@@ -89,12 +89,6 @@ library:
         dependencies:
           - hint > 0.3.1
 
-      - condition: flag(testing)
-        cpp-options: -DTESTING
-        dependencies:
-          - QuickCheck >= 2.7
-          - random
-
     ghc-options: -Wall -fno-warn-orphans -ferror-spans
 
     exposed-modules:

diff --git a/yi-core/src/Yi/Syntax/Tree.hs b/yi-core/src/Yi/Syntax/Tree.hs
@@ -46,11 +46,6 @@ import           Yi.Lexer.Alex       (posnLine, posnOfs,
 import           Yi.Region           (Region (regionEnd, regionStart), mkRegion)
 import           Yi.String           (showT)
 
-#ifdef TESTING
-import           Test.QuickCheck
-import           Test.QuickCheck.Property (unProperty)
-#endif
-
 -- Fundamental types
 type Path = [Int]
 type Node t = (Path, t)
@@ -301,123 +296,3 @@ sepBy p s   = sepBy1 p s <|> pure []
 
 sepBy1 :: (Alternative f) => f a -> f v -> f [a]
 sepBy1 p s  = (:) <$> p <*> many (s *> p)
-
-
-----------------------------------------------------
--- Testing code.
-
-#ifdef TESTING
-
-nodeRegion :: IsTree tree => Node (tree (Tok a)) -> Region
-nodeRegion n = subtreeRegion t
-    where Just t = walkDown n
-
-data Test a = Empty | Leaf a | Bin (Test a) (Test a) deriving (Show, Eq, Foldable)
-
-instance IsTree Test where
-    uniplate (Bin l r) = ([l,r],\[l',r'] -> Bin l' r')
-    uniplate t = ([],\[] -> t)
-    emptyNode = Empty
-
-type TT = Tok ()
-
-instance Arbitrary (Test TT) where
-    arbitrary = sized $ \size -> do
-      arbitraryFromList [1..size+1]
-    shrink (Leaf _) = []
-    shrink (Bin l r) = [l,r] <>  (Bin <$> shrink l <*> pure r) <>  (Bin <$> pure l <*> shrink r)
-
-tAt :: Point -> TT
-tAt idx =  Tok () 1 (Posn (idx * 2) 0 0)
-
-arbitraryFromList :: [Int] -> Gen (Test TT)
-arbitraryFromList [] = error "arbitraryFromList expects non empty lists"
-arbitraryFromList [x] = pure (Leaf (tAt (fromIntegral x)))
-arbitraryFromList xs = do
-  m <- choose (1,length xs - 1)
-  let (l,r) = splitAt m xs
-  Bin <$> arbitraryFromList l <*> arbitraryFromList r
-
-newtype NTTT = N (Node (Test TT)) deriving Show
-
-instance Arbitrary NTTT where
-    arbitrary = do
-      t <- arbitrary
-      p <- arbitraryPath t
-      return $ N (p,t)
-
-arbitraryPath :: Test t -> Gen Path
-arbitraryPath (Leaf _) = return []
-arbitraryPath (Bin l r) = do
-  c <- choose (0,1)
-  let Just n' = index c [l,r]
-  (c :) <$> arbitraryPath n'
-
-regionInside :: Region -> Gen Region
-regionInside r = do
-  b :: Int <- choose (fromIntegral $ regionStart r, fromIntegral $ regionEnd r)
-  e :: Int <- choose (b, fromIntegral $ regionEnd r)
-  return $ mkRegion (fromIntegral b) (fromIntegral e)
-
-pointInside :: Region -> Gen Point
-pointInside r = do
-  p :: Int <- choose (fromIntegral $ regionStart r, fromIntegral $ regionEnd r)
-  return (fromIntegral p)
-
-prop_fromLeafAfterToFinal :: NTTT -> Property
-prop_fromLeafAfterToFinal (N n) = let
-    fullRegion = subtreeRegion $ snd n
- in forAll (pointInside fullRegion) $ \p -> do
-   let final@(_, (_, finalSubtree)) = fromLeafAfterToFinal p n
-       finalRegion = subtreeRegion finalSubtree
-       initialRegion = nodeRegion n
-
-   whenFail (do putStrLn $ "final = " <> show final
-                putStrLn $ "final reg = " <> show finalRegion
-                putStrLn $ "initialReg = " <> show initialRegion
-                putStrLn $ "p = " <> show p
-            )
-     ((regionStart finalRegion <= p) && (initialRegion `includedRegion` finalRegion))
-
-prop_allLeavesAfter :: NTTT -> Property
-prop_allLeavesAfter (N n@(xs,t)) = property $ do
-  let after = allLeavesRelative afterChild n
-  (xs',t') <- elements after
-  let t'' = walkDown (xs',t)
-  unProperty $ whenFail (do
-      putStrLn $ "t' = " <> show t'
-      putStrLn $ "t'' = " <> show t''
-      putStrLn $ "xs' = " <> show xs'
-    ) (Just t' == t'' && xs <= xs')
-
-prop_allLeavesBefore :: NTTT -> Property
-prop_allLeavesBefore (N n@(xs,t)) = property $ do
-  let after = allLeavesRelative beforeChild n
-  (xs',t') <- elements after
-  let t'' = walkDown (xs',t)
-  unProperty $ whenFail (do
-      putStrLn $ "t' = " <> show t'
-      putStrLn $ "t'' = " <> show t''
-      putStrLn $ "xs' = " <> show xs'
-    ) (Just t' == t'' && xs' <= xs)
-
-prop_fromNodeToLeafAfter :: NTTT -> Property
-prop_fromNodeToLeafAfter (N n) = forAll (pointInside (subtreeRegion $ snd n)) $ \p -> do
-   let after = fromLeafToLeafAfter p n
-       afterRegion = nodeRegion after
-   whenFail (do putStrLn $ "after = " <> show after
-                putStrLn $ "after reg = " <> show afterRegion
-            )
-     (regionStart afterRegion >= p)
-
-prop_fromNodeToFinal :: NTTT -> Property
-prop_fromNodeToFinal  (N t) = forAll (regionInside (subtreeRegion $ snd t)) $ \r -> do
-   let final@(_, finalSubtree) = fromNodeToFinal r t
-       finalRegion = subtreeRegion finalSubtree
-   whenFail (do putStrLn $ "final = " <> show final
-                putStrLn $ "final reg = " <> show finalRegion
-                putStrLn $ "leaf after = " <> show (fromLeafToLeafAfter (regionEnd r) t)
-            ) $ do
-     r `includedRegion` finalRegion
-
-#endif
diff --git a/yi-language/src/Yi/Region.hs b/yi-language/src/Yi/Region.hs
@@ -31,10 +31,6 @@ import Data.Typeable
 import Data.Binary
 import GHC.Generics (Generic)
 
-#ifdef TESTING
-import Test.QuickCheck
-#endif
-
 -- | The region data type.
 -- The region is semi open: it includes the start but not the end bound.
 -- This allows simpler region-manipulation algorithms.
@@ -46,14 +42,6 @@ data Region = Region
 
 instance Binary Region
 
-#ifdef TESTING
-instance Arbitrary Region where
-    arbitrary = sized $ \size -> do
-        x0 :: Int <- arbitrary
-        return $ mkRegion (fromIntegral x0) (fromIntegral (x0 + size))
-#endif
-
-
 instance Show Region where
     show r = show (regionStart r) ++
              (case regionDirection r of