{-# LANGUAGE PackageImports #-}

module Freckle.App.Test.DocTest
  ( doctest
  , doctestWith

  -- * Lower-level, for site-specific use
  , findPackageFlags
  , findDocTestedFiles
  ) where

import Freckle.App.Prelude

import Control.Monad (filterM)
import Data.Aeson
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Yaml (decodeFileThrow)
import "Glob" System.FilePath.Glob (globDir1)
import qualified Test.DocTest as DocTest

-- | Run doctest on files in the given directory
doctest :: FilePath -> IO ()
doctest :: FilePath -> IO ()
doctest = [FilePath] -> FilePath -> IO ()
doctestWith []

-- | Run doctest on files in the given directory and with additional flags
doctestWith :: [String] -> FilePath -> IO ()
doctestWith :: [FilePath] -> FilePath -> IO ()
doctestWith [FilePath]
flags FilePath
dir = do
  [FilePath]
packageFlags <- IO [FilePath]
findPackageFlags
  [FilePath]
sourceFiles <- FilePath -> IO [FilePath]
findDocTestedFiles FilePath
dir
  [FilePath] -> IO ()
DocTest.doctest ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath]
packageFlags [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
flags [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
sourceFiles

-- | Representation of only the information we need in a @package.yaml@
data PackageYaml = PackageYaml
  { PackageYaml -> [FilePath]
defaultExtensions :: [String]
  , PackageYaml -> FilePath
name :: String
  }

instance FromJSON PackageYaml where
  parseJSON :: Value -> Parser PackageYaml
parseJSON = FilePath
-> (Object -> Parser PackageYaml) -> Value -> Parser PackageYaml
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"PackageYaml"
    ((Object -> Parser PackageYaml) -> Value -> Parser PackageYaml)
-> (Object -> Parser PackageYaml) -> Value -> Parser PackageYaml
forall a b. (a -> b) -> a -> b
$ \Object
o -> [FilePath] -> FilePath -> PackageYaml
PackageYaml ([FilePath] -> FilePath -> PackageYaml)
-> Parser [FilePath] -> Parser (FilePath -> PackageYaml)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [FilePath]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"default-extensions" Parser (FilePath -> PackageYaml)
-> Parser FilePath -> Parser PackageYaml
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser FilePath
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"

-- Parse @default-extensions@ and @name& out of @package.yaml@
--
-- NB. This won't find target-specific extensions. If your package does this
-- (consider not, then) add them via the direct argument to @'doctestWith'@.
--
findPackageFlags :: IO [String]
findPackageFlags :: IO [FilePath]
findPackageFlags = do
  PackageYaml {FilePath
[FilePath]
name :: FilePath
defaultExtensions :: [FilePath]
name :: PackageYaml -> FilePath
defaultExtensions :: PackageYaml -> [FilePath]
..} <- FilePath -> IO PackageYaml
forall (m :: * -> *) a. (MonadIO m, FromJSON a) => FilePath -> m a
decodeFileThrow FilePath
"package.yaml"
  [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath
"-package " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
name) FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"-X" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) [FilePath]
defaultExtensions

-- | Find any source files with doctest comments
--
-- Doctest with a lot of files is really slow. Like /really/ slow:
--
-- <https://github.com/sol/doctest/issues/141>
--
-- Also, some suites won't actually work on a lot of our files because of some
-- instance-import-related debt that we don't have the time to clean up at this
-- time:
--
-- <https://freckleinc.slack.com/archives/C459XJBGR/p1519220418000125>
--
-- So we want to only run doctest for files that need it. This function finds
-- such files by /naively/ looking for the @^-- >>>@ pattern.
--
findDocTestedFiles :: FilePath -> IO [FilePath]
findDocTestedFiles :: FilePath -> IO [FilePath]
findDocTestedFiles FilePath
dir = do
  [FilePath]
paths <- Pattern -> FilePath -> IO [FilePath]
globDir1 Pattern
"**/*.hs" FilePath
dir
  (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Text -> Bool) -> IO Text -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Bool
hasDocTests (IO Text -> IO Bool)
-> (FilePath -> IO Text) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Text
T.readFile) [FilePath]
paths

hasDocTests :: Text -> Bool
hasDocTests :: Text -> Bool
hasDocTests = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text
"-- >>>" Text -> Text -> Bool
`T.isInfixOf`) ([Text] -> Bool) -> (Text -> [Text]) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines