module Devtools.Dependencies
  ( getFilename
  , testTree
  )
where

import Data.Tuple (fst)
import Devtools.Config
import Devtools.Prelude
import System.FilePath (FilePath, (</>))

import qualified Data.ByteString.Lazy  as LBS
import qualified Data.Text.Encoding    as Text
import qualified System.Environment    as Environment
import qualified System.FilePath       as FilePath
import qualified System.Process.Typed  as Process
import qualified Test.Tasty            as Tasty
import qualified Test.Tasty.MGolden    as Tasty

testTree :: FilePath -> [Target] -> Tasty.TestTree
testTree :: FilePath -> [Target] -> TestTree
testTree FilePath
filename [Target]
targets =
  FilePath -> FilePath -> IO Text -> TestTree
Tasty.goldenTest FilePath
"dependencies" FilePath
filename IO Text
readDependenciesText
  where
    readDependenciesText :: IO Text
    readDependenciesText :: IO Text
readDependenciesText
      = ByteString -> Text
Text.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
readDependencies

    readDependencies :: IO LBS.ByteString
    readDependencies :: IO ByteString
readDependencies
      = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> IO (ByteString, ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessConfig () () () -> IO (ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ByteString, ByteString)
Process.readProcess_ (FilePath -> [FilePath] -> ProcessConfig () () ()
Process.proc FilePath
"stack" [FilePath]
arguments)

    arguments :: [String]
    arguments :: [FilePath]
arguments =
      [ FilePath
"ls"
      , FilePath
"dependencies"
      , FilePath
"--test"
      ] [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> (Target -> FilePath
targetString (Target -> FilePath) -> [Target] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Target]
targets)

getFilename :: IO FilePath
getFilename :: IO FilePath
getFilename = do
  FilePath
prefix <- IO FilePath
getPrefix
  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
"test" FilePath -> FilePath -> FilePath
</> FilePath
prefix FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-dependencies.txt"
  where
    getPrefix :: IO FilePath
getPrefix
      =   FilePath -> (FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"stack" (FilePath -> FilePath
FilePath.dropExtension (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
FilePath.takeFileName)
      (Maybe FilePath -> FilePath) -> IO (Maybe FilePath) -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
Environment.lookupEnv FilePath
"STACK_YAML"