{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Test.Utils ( cli , describeCmd , validateJSON , SchemaRef ) where import Prelude import Data.String ( IsString ) import Data.Text ( Text ) #ifdef HJSONSCHEMA import JSONSchema.Draft4 ( Schema (..) , SchemaWithURI (..) , checkSchema , emptySchema , referencesViaFilesystem ) #endif import System.Environment ( lookupEnv ) import System.Process ( readProcess, readProcessWithExitCode ) import Test.Hspec ( Spec, SpecWith, describe, runIO ) import qualified Data.Aeson as Json -- -- cli -- class CommandLine output where cli :: [String] -- ^ arguments -> String -- ^ stdin -> IO output -- ^ output, either stdout or (stdout, stderr) instance CommandLine String where cli args input = do (exe', args') <- getWrappedCLI args readProcess exe' args' input instance CommandLine (String, String) where cli args input = do (exe', args') <- getWrappedCLI args dropFirst <$> readProcessWithExitCode exe' args' input where dropFirst (_,b,c) = (b, c) exe :: String exe = "cardano-address" -- | Return the exe name and args for a CLI invocation. -- For ghcjs, the cardano-address CLI must be executed under nodejs. getWrappedCLI :: [String] -> IO (FilePath, [String]) getWrappedCLI args = maybe (exe, args) wrap <$> lookupJsExe where lookupJsExe = fmap allJs <$> lookupEnv "CARDANO_ADDRESSES_CLI" allJs = (<> ("/" <> exe <> ".jsexe/all.js")) wrap jsExe = ("node", (jsExe:args)) -- -- describeCmd -- -- | Wrap HSpec 'describe' into a friendly command description. So that, we get -- a very satisfying result visually from running the tests, and can inspect -- what each command help text looks like. describeCmd :: [String] -> SpecWith () -> Spec describeCmd cmd spec = do title <- runIO $ cli (cmd ++ ["--help"]) "" describe title spec -- -- JSON Schema Validation -- newtype SchemaRef = SchemaRef { getSchemaRef :: Text } deriving (Show, IsString) validateJSON :: SchemaRef -> Json.Value -> IO [String] validateJSON _ _ = pure []