{-# LANGUAGE PackageImports #-}
module Freckle.App.Test.DocTest
( doctest
, doctestWith
, 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 qualified Test.DocTest as DocTest
import "Glob" System.FilePath.Glob (globDir1)
doctest :: FilePath -> IO ()
doctest :: String -> IO ()
doctest = [String] -> String -> IO ()
doctestWith []
doctestWith :: [String] -> FilePath -> IO ()
doctestWith :: [String] -> String -> IO ()
doctestWith [String]
flags String
dir = do
[String]
packageFlags <- IO [String]
findPackageFlags
[String]
sourceFiles <- String -> IO [String]
findDocTestedFiles String
dir
[String] -> IO ()
DocTest.doctest forall a b. (a -> b) -> a -> b
$ [String]
packageFlags forall a. Semigroup a => a -> a -> a
<> [String]
flags forall a. Semigroup a => a -> a -> a
<> [String]
sourceFiles
data PackageYaml = PackageYaml
{ PackageYaml -> [String]
defaultExtensions :: [String]
, PackageYaml -> String
name :: String
}
instance FromJSON PackageYaml where
parseJSON :: Value -> Parser PackageYaml
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PackageYaml" forall a b. (a -> b) -> a -> b
$
\Object
o -> [String] -> String -> PackageYaml
PackageYaml forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"default-extensions" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
findPackageFlags :: IO [String]
findPackageFlags :: IO [String]
findPackageFlags = do
PackageYaml {String
[String]
name :: String
defaultExtensions :: [String]
name :: PackageYaml -> String
defaultExtensions :: PackageYaml -> [String]
..} <- forall (m :: * -> *) a. (MonadIO m, FromJSON a) => String -> m a
decodeFileThrow String
"package.yaml"
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (String
"-package " forall a. Semigroup a => a -> a -> a
<> String
name) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (String
"-X" forall a. Semigroup a => a -> a -> a
<>) [String]
defaultExtensions
findDocTestedFiles :: FilePath -> IO [FilePath]
findDocTestedFiles :: String -> IO [String]
findDocTestedFiles String
dir = do
[String]
paths <- Pattern -> String -> IO [String]
globDir1 Pattern
"**/*.hs" String
dir
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Bool
hasDocTests forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Text
T.readFile) [String]
paths
hasDocTests :: Text -> Bool
hasDocTests :: Text -> Bool
hasDocTests = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text
"-- >>>" Text -> Text -> Bool
`T.isInfixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines