{-# 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"