{-# LANGUAGE TupleSections, RecordWildCards, ScopedTypeVariables #-} module Action.Test(actionTest) where import Query import Action.CmdLine import Action.Search import Action.Server import Action.Generate import General.Util import General.Web import Input.Item import Input.Haddock import System.IO.Extra import Control.Monad import Output.Items import Control.DeepSeq import Control.Exception actionTest :: CmdLine -> IO () actionTest :: CmdLine -> IO () actionTest Test{Bool String Language deep :: Bool disable_network_tests :: Bool database :: String language :: Language database :: CmdLine -> String language :: CmdLine -> Language deep :: CmdLine -> Bool disable_network_tests :: CmdLine -> Bool ..} = Handle -> BufferMode -> IO () -> IO () forall a. Handle -> BufferMode -> IO a -> IO a withBuffering Handle stdout BufferMode NoBuffering (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ (String -> IO ()) -> IO () forall a. (String -> IO a) -> IO a withTempFile ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ \String sample -> do String -> IO () putStrLn String "Code tests" IO () general_util_test IO () general_web_test IO () input_haddock_test IO () query_test IO () action_server_test_ IO () item_test String -> IO () putStrLn String "" String -> IO () putStrLn String "Sample database tests" CmdLine -> IO () actionGenerate CmdLine defaultGenerate{database=sample, local_=["misc/sample-data"]} Bool -> String -> IO () action_search_test Bool True String sample Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless Bool disable_network_tests (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ Bool -> String -> IO () action_server_test Bool True String sample String -> IO () putStrLn String "" Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless Bool disable_network_tests (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ do String -> IO () putStrLn String "Haskell.org database tests" Bool -> String -> IO () action_search_test Bool False String database Bool -> String -> IO () action_server_test Bool False String database Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool deep (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ String -> (StoreRead -> IO ()) -> IO () forall a. NFData a => String -> (StoreRead -> IO a) -> IO a withSearch String database ((StoreRead -> IO ()) -> IO ()) -> (StoreRead -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ \StoreRead store -> do String -> IO () putStrLn String "Deep tests" let xs :: [String] xs = (Target -> String) -> [Target] -> [String] forall a b. (a -> b) -> [a] -> [b] map Target -> String targetItem ([Target] -> [String]) -> [Target] -> [String] forall a b. (a -> b) -> a -> b $ StoreRead -> [Target] listItems StoreRead store () -> IO () forall a. a -> IO a evaluate (() -> IO ()) -> () -> IO () forall a b. (a -> b) -> a -> b $ [String] -> () forall a. NFData a => a -> () rnf [String] xs String -> IO () putStrLn (String -> IO ()) -> String -> IO () forall a b. (a -> b) -> a -> b $ String "Loaded " String -> String -> String forall a. [a] -> [a] -> [a] ++ Int -> String forall a. Show a => a -> String show ([String] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [String] xs) String -> String -> String forall a. [a] -> [a] -> [a] ++ String " items"