{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}

module Test.Tasty.Discover
  ( Tasty(..)
  , TastyInfo
  , SkipTest(..)
  , Flavored(..)
  , flavored
  , name
  , description
  , nameOf
  , descriptionOf
  , skip
  , applySkips
  , platform
  , evaluatePlatformExpression
  ) where

import Data.Maybe
import Data.Monoid
import System.Console.ANSI (Color(..), ColorIntensity(..), ConsoleLayer(..), SGR(..), setSGRCode)
import System.Info (os)
import Test.Tasty.Discover.TastyInfo (TastyInfo)
import Test.Tasty.Discover.Internal.Config (SkipTest(..))

import qualified Test.Tasty as TT
import qualified Test.Tasty.Runners as TR
import qualified Test.Tasty.Providers as TP
import qualified Test.Tasty.Discover.TastyInfo as TI

{- $skipPlatform
Guidelines for using 'skip' and 'platform'
-----------------------------------------

TL;DR:
- For tests exposed via @tasty_@ functions, prefer using the 'Flavored' pattern to apply
  transformations like 'skip' and 'platform' so they take effect at the TestTree level.
- Directly applying 'skip' to an already-constructed 'TT.TestTree' marks the subtree as
  skipped (the test can observe 'SkipTest' via 'TT.askOption'), but the outer 'Tasty'
  instance may not replace it with a top-level "[SKIPPED]" node.

Patterns:
- Skip with 'Flavored':

@
tasty_mySkipped :: Flavored TT.TestTree
tasty_mySkipped = flavored skip $ TT.testCase "will be skipped" $ pure ()
@

-
@
tasty_linuxOnly :: Flavored TT.TestTree
tasty_linuxOnly = flavored (platform "linux") $ TT.testCase "Linux only" $ pure ()
@

Platform expressions:
- Names: @"linux"@, @"darwin"@, @"windows"@ (mapped to @"mingw32"@), @"mingw32"@, and @"unix"@ (matches linux|darwin)
- Operators: NOT @!@, AND @&@, OR @|@
-- Examples:

@
platform "!windows & !darwin"  -- neither Windows nor Darwin
platform "linux | darwin"       -- Linux or Darwin
platform "unix"                 -- Linux or Darwin
@

Combining:
- You can compose transformations: e.g., @flavored (platform "linux") . flavored skip@
  or wrap once with a composed function @flavored (platform "linux" . skip)@.

See 'skip' and 'platform' for function-specific details.
-}

class Tasty a where
  tasty :: TastyInfo -> a -> IO TT.TestTree

instance Tasty TT.TestTree where
  tasty :: TastyInfo -> TestTree -> IO TestTree
tasty TastyInfo
_ TestTree
a = TestTree -> IO TestTree
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestTree
a

instance Tasty [TT.TestTree] where
  tasty :: TastyInfo -> [TestTree] -> IO TestTree
tasty TastyInfo
info [TestTree]
a = TestTree -> IO TestTree
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestTree -> IO TestTree) -> TestTree -> IO TestTree
forall a b. (a -> b) -> a -> b
$ String -> [TestTree] -> TestTree
TT.testGroup (TastyInfo -> String
descriptionOf TastyInfo
info) [TestTree]
a

instance Tasty (IO TT.TestTree) where
  tasty :: TastyInfo -> IO TestTree -> IO TestTree
tasty TastyInfo
_ IO TestTree
a = IO TestTree
a

instance Tasty (IO [TT.TestTree]) where
  tasty :: TastyInfo -> IO [TestTree] -> IO TestTree
tasty TastyInfo
info IO [TestTree]
a = String -> [TestTree] -> TestTree
TT.testGroup (TastyInfo -> String
descriptionOf TastyInfo
info) ([TestTree] -> TestTree) -> IO [TestTree] -> IO TestTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [TestTree]
a

-- | A general-purpose wrapper for transforming TestTrees generated by tasty_ functions.
--
-- The Flavored type allows you to apply transformations to test trees before they
-- are added to the test suite. This enables applying various options and modifications
-- such as skipping tests, setting timeouts, adding metadata, grouping, etc.
--
-- Example usage:
-- @
-- -- Skip a test
-- tasty_skipThis :: Flavored Property
-- tasty_skipThis = flavored skip $ property $ do
--   -- This test will be skipped
--   H.failure
-- @
data Flavored a = Flavored
  { forall a. Flavored a -> TestTree -> TestTree
flavoring :: TT.TestTree -> TT.TestTree   -- ^ Transformation function to apply
  , forall a. Flavored a -> a
unFlavored :: a                           -- ^ The wrapped test value
  }

-- | Create a Flavored wrapper with a specific transformation function.
--
-- @flavored f a@ applies transformation @f@ to the TestTree generated from @a@.
flavored :: (TT.TestTree -> TT.TestTree) -> a -> Flavored a
flavored :: forall a. (TestTree -> TestTree) -> a -> Flavored a
flavored TestTree -> TestTree
f a
a = (TestTree -> TestTree) -> a -> Flavored a
forall a. (TestTree -> TestTree) -> a -> Flavored a
Flavored TestTree -> TestTree
f a
a

instance Tasty a => Tasty (Flavored a) where
  tasty :: TastyInfo -> Flavored a -> IO TT.TestTree
  tasty :: TastyInfo -> Flavored a -> IO TestTree
tasty TastyInfo
info (Flavored TestTree -> TestTree
f a
a) = do
    TestTree
testTree <- TastyInfo -> a -> IO TestTree
forall a. Tasty a => TastyInfo -> a -> IO TestTree
tasty TastyInfo
info a
a
    TestTree -> IO TestTree
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestTree -> IO TestTree) -> TestTree -> IO TestTree
forall a b. (a -> b) -> a -> b
$ TestTree -> TestTree
f TestTree
testTree

nameOf :: TastyInfo -> String
nameOf :: TastyInfo -> String
nameOf TastyInfo
info =
  String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"<unnamed>" (Last String -> Maybe String
forall a. Last a -> Maybe a
getLast (TastyInfo -> Last String
TI.name TastyInfo
info))

descriptionOf :: TastyInfo -> String
descriptionOf :: TastyInfo -> String
descriptionOf TastyInfo
info =
  String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"<undescribed>" (Last String -> Maybe String
forall a. Last a -> Maybe a
getLast (TastyInfo -> Last String
TI.description TastyInfo
info))

name :: String -> TastyInfo
name :: String -> TastyInfo
name String
n = TastyInfo
forall a. Monoid a => a
mempty
  { TI.name = Last $ Just n
  }

description :: String -> TastyInfo
description :: String -> TastyInfo
description String
n = TastyInfo
forall a. Monoid a => a
mempty
  { TI.description = Last $ Just n
  }

-- | Mark a test tree to be skipped by setting the SkipTest option to True.
--
-- Usage guidelines: see the @Guidelines for using 'skip' and 'platform'@ section ('skipPlatform').
-- In short, for @tasty_@ tests prefer 'flavored' 'skip' to let the outer 'Tasty' instance
-- short-circuit at the TestTree level. Direct 'skip' on a pre-built tree applies the option
-- to the subtree; the test can still observe 'SkipTest' via 'TT.askOption'.
--
-- Examples:
-- @
-- -- Direct usage on a TestTree (the test can read SkipTest via askOption)
-- test_directSkip :: TestTree
-- test_directSkip = skip $ testCase "will be skipped" $ pure ()
--
-- -- Preferred for tasty_ tests: apply at the right stage using Flavored
-- tasty_skipProperty :: Flavored Property
-- tasty_skipProperty = flavored skip $ property $ do
--   -- This property will be skipped
--   H.failure
-- @
skip :: TT.TestTree -> TT.TestTree
skip :: TestTree -> TestTree
skip = (SkipTest -> SkipTest) -> TestTree -> TestTree
forall v. IsOption v => (v -> v) -> TestTree -> TestTree
TT.adjustOption (SkipTest -> SkipTest -> SkipTest
forall a b. a -> b -> a
const (Bool -> SkipTest
SkipTest Bool
True))

-- | Transform a TestTree to apply skipping behavior throughout the entire tree.
--
-- This function wraps a TestTree so that when the 'SkipTest' option is set to 'True',
-- all individual tests within the tree are replaced with skipped placeholder tests.
-- This is useful when you want to conditionally skip an entire group of tests while
-- still showing each test as skipped in the output.
--
-- The function works by:
--
-- * Checking the 'SkipTest' option via 'TT.askOption'
-- * If skipping is enabled, using 'TT.foldTestTree' to traverse the tree and rebuild it with:
--
--     * All single tests replaced with test cases showing "[SKIPPED]"
--     * Test groups preserved with their structure intact
--     * Resources skipped (not acquired)
--
-- * If skipping is disabled, returning the tree unchanged
--
-- This is particularly useful in combination with 'platform' for platform-specific test suites:
--
-- @
-- tasty_testTree_no_darwin :: Flavored (IO TestTree)
-- tasty_testTree_no_darwin =
--   flavored (platform "!darwin") $ pure $ applySkips $ testGroup "Non-Darwin group"
--     [ testProperty "Test 1" $ \\(x :: Int) -> x == x
--     , testCase "Test 2" $ pure ()
--     ]
-- @
--
-- On Darwin, this will show:
--
-- @
-- Non-Darwin group
--   Test 1 [SKIPPED]: OK
--   Test 2 [SKIPPED]: OK
-- @
--
-- @since 5.1.0
-- | A simple test type for skipped tests
data SkippedTest = SkippedTest
  deriving stock (Int -> SkippedTest -> ShowS
[SkippedTest] -> ShowS
SkippedTest -> String
(Int -> SkippedTest -> ShowS)
-> (SkippedTest -> String)
-> ([SkippedTest] -> ShowS)
-> Show SkippedTest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SkippedTest -> ShowS
showsPrec :: Int -> SkippedTest -> ShowS
$cshow :: SkippedTest -> String
show :: SkippedTest -> String
$cshowList :: [SkippedTest] -> ShowS
showList :: [SkippedTest] -> ShowS
Show, SkippedTest -> SkippedTest -> Bool
(SkippedTest -> SkippedTest -> Bool)
-> (SkippedTest -> SkippedTest -> Bool) -> Eq SkippedTest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SkippedTest -> SkippedTest -> Bool
== :: SkippedTest -> SkippedTest -> Bool
$c/= :: SkippedTest -> SkippedTest -> Bool
/= :: SkippedTest -> SkippedTest -> Bool
Eq)

instance TP.IsTest SkippedTest where
  run :: OptionSet -> SkippedTest -> (Progress -> IO ()) -> IO Result
run OptionSet
_ SkippedTest
_ Progress -> IO ()
_ = Result -> IO Result
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ String -> Result
TP.testPassed String
""
  testOptions :: Tagged SkippedTest [OptionDescription]
testOptions = [OptionDescription] -> Tagged SkippedTest [OptionDescription]
forall a. a -> Tagged SkippedTest a
forall (m :: * -> *) a. Monad m => a -> m a
return []

applySkips :: TT.TestTree -> TT.TestTree
applySkips :: TestTree -> TestTree
applySkips TestTree
tree = (SkipTest -> TestTree) -> TestTree
forall v. IsOption v => (v -> TestTree) -> TestTree
TT.askOption ((SkipTest -> TestTree) -> TestTree)
-> (SkipTest -> TestTree) -> TestTree
forall a b. (a -> b) -> a -> b
$ \(SkipTest Bool
shouldSkip) ->
  if Bool
shouldSkip
    then TestTree -> TestTree
transformTree TestTree
tree
    else TestTree
tree
  where
    yellowText :: String -> String
    yellowText :: ShowS
yellowText String
text = [SGR] -> String
setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Yellow] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
text String -> ShowS
forall a. [a] -> [a] -> [a]
++ [SGR] -> String
setSGRCode [SGR
Reset]

    transformTree :: TT.TestTree -> TT.TestTree
    transformTree :: TestTree -> TestTree
transformTree TestTree
t = case TreeFold [TestTree] -> OptionSet -> TestTree -> [TestTree]
forall b. Monoid b => TreeFold b -> OptionSet -> TestTree -> b
TR.foldTestTree
      TR.TreeFold
        { foldSingle :: forall t. IsTest t => OptionSet -> String -> t -> [TestTree]
TR.foldSingle = \OptionSet
_ String
testName t
_ -> [String -> SkippedTest -> TestTree
forall t. IsTest t => String -> t -> TestTree
TP.singleTest (String
testName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
yellowText String
"[SKIPPED]") SkippedTest
SkippedTest]
        , foldGroup :: OptionSet -> String -> [[TestTree]] -> [TestTree]
TR.foldGroup = \OptionSet
_ String
groupName [[TestTree]]
trees -> [String -> [TestTree] -> TestTree
TT.testGroup String
groupName ([[TestTree]] -> [TestTree]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[TestTree]]
trees)]
        , foldResource :: forall a.
OptionSet -> ResourceSpec a -> (IO a -> [TestTree]) -> [TestTree]
TR.foldResource = \OptionSet
_ ResourceSpec a
_ IO a -> [TestTree]
_ -> []
        , foldAfter :: OptionSet -> DependencyType -> Expr -> [TestTree] -> [TestTree]
TR.foldAfter = \OptionSet
_ DependencyType
_ Expr
_ [TestTree]
trees -> [TestTree]
trees
        }
      OptionSet
forall a. Monoid a => a
mempty
      TestTree
t of
        [TestTree
result] -> TestTree
result
        [TestTree]
results -> String -> [TestTree] -> TestTree
TT.testGroup String
"" [TestTree]
results

-- | Conditionally run a test based on a platform expression.
--
-- Usage guidelines, syntax, and examples: see the @Guidelines for using 'skip' and 'platform'@
-- section ('skipPlatform').
--
-- The expression supports logical operations with platform names:
-- - Platform names: "linux", "darwin", "mingw32", "windows", "unix"
-- - Negation: "!platform" (not on platform)  
-- - Conjunction: "platform1 & platform2" (on both platforms)
-- - Disjunction: "platform1 | platform2" (on either platform)
-- - Parentheses: "(platform1 | platform2) & !platform3"
--
-- Examples:
-- @
-- -- Only on Linux
-- test_linuxOnly :: TestTree
-- test_linuxOnly = platform "linux" $ testCase "Linux only" $ pure ()
--
-- -- Not on Windows or macOS
-- test_notWinMac :: TestTree  
-- test_notWinMac = platform "!windows & !darwin" $ testCase "Unix-like only" $ pure ()
--
-- -- On Linux or macOS but not Windows
-- test_unixLike :: TestTree
-- test_unixLike = platform "(linux | darwin) & !windows" $ testCase "Unix-like" $ pure ()
-- @
platform :: String -> TT.TestTree -> TT.TestTree
platform :: String -> TestTree -> TestTree
platform String
expr TestTree
testTree = 
  if String -> String -> Bool
evaluatePlatformExpression String
expr String
os
    then TestTree
testTree
    else TestTree -> TestTree
skip TestTree
testTree

-- | Evaluate a platform expression against a given platform string.
--
-- Inputs:
-- - The first argument is the platform expression (e.g. @"linux | darwin"@, @"!windows"@).
-- - The second argument is the current platform, typically @System.Info.os@ (e.g. @"linux"@, @"darwin"@, @"mingw32"@).
--
-- Semantics (result is 'True' when the test should run):
-- - Supported platform names: @"linux"@, @"darwin"@, @"mingw32"@, @"windows"@ (alias for @"mingw32"@), and @"unix"@ (alias for @"linux | darwin"@).
-- - Supported operators: NOT @!@, AND @&@, OR @|@.
-- - Unknown simple names evaluate to 'False' (do not run).
-- - Malformed or empty expressions evaluate to 'True' (default to running).
--   Malformed includes the presence of operator characters without a valid parse.
-- - Parentheses characters @(@ and @)@ are tokenized but grouping is not currently implemented;
--   using parentheses in the expression will cause it to be treated as malformed and therefore
--   default to 'True' (run). Prefer composing with @&@ and @|@ without parentheses.
--
-- Examples:
--
-- @
-- evaluatePlatformExpression "linux"        "linux"   == True
-- evaluatePlatformExpression "linux"        "darwin"  == False
-- evaluatePlatformExpression "!windows"     "mingw32" == False
-- evaluatePlatformExpression "linux|darwin" "darwin"  == True
-- evaluatePlatformExpression "unix"         "darwin"  == True   -- alias for linux|darwin
-- evaluatePlatformExpression "unknown"      "linux"   == False  -- unknown simple name
-- evaluatePlatformExpression ""             "linux"   == True   -- empty -> run
-- @
evaluatePlatformExpression :: String -> String -> Bool
evaluatePlatformExpression :: String -> String -> Bool
evaluatePlatformExpression String
expr String
currentPlatform = 
  case String -> Maybe PlatformExpr
parsePlatformExpression String
expr of
    Just PlatformExpr
result -> PlatformExpr -> String -> Bool
evalExpression PlatformExpr
result String
currentPlatform
    Maybe PlatformExpr
Nothing -> 
      -- If it's just a simple unknown platform name, return False
      -- If it's an empty/malformed expression, return True
      let malformedOrEmpty :: Bool
malformedOrEmpty = [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> [String]
words String
expr) Bool -> Bool -> Bool
|| (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'&', Char
'|', Char
'!', Char
'(', Char
')']) String
expr
      in Bool
malformedOrEmpty

-- Parse a platform expression with logical operators
parsePlatformExpression :: String -> Maybe PlatformExpr
parsePlatformExpression :: String -> Maybe PlatformExpr
parsePlatformExpression String
expr = [String] -> Maybe PlatformExpr
parseOr (String -> [String]
tokenize String
expr)

-- Tokenize the expression preserving logical operators
tokenize :: String -> [String]
tokenize :: String -> [String]
tokenize = String -> [String]
words (String -> [String]) -> ShowS -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
tokenizeChar
  where
    tokenizeChar :: Char -> String
tokenizeChar Char
'&' = String
" & "
    tokenizeChar Char
'|' = String
" | "  
    tokenizeChar Char
'(' = String
" ( "
    tokenizeChar Char
')' = String
" ) "
    tokenizeChar Char
c = [Char
c]

-- Parse OR expressions (lowest precedence)
parseOr :: [String] -> Maybe PlatformExpr
parseOr :: [String] -> Maybe PlatformExpr
parseOr [String]
tokens = case (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"|") [String]
tokens of
  ([String]
left, []) -> [String] -> Maybe PlatformExpr
parseAnd [String]
left
  ([String]
left, String
_:[String]
right) -> do
    PlatformExpr
leftExpr <- [String] -> Maybe PlatformExpr
parseAnd [String]
left
    PlatformExpr
rightExpr <- [String] -> Maybe PlatformExpr
parseOr [String]
right
    PlatformExpr -> Maybe PlatformExpr
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (PlatformExpr -> Maybe PlatformExpr)
-> PlatformExpr -> Maybe PlatformExpr
forall a b. (a -> b) -> a -> b
$ PlatformExpr -> PlatformExpr -> PlatformExpr
Or PlatformExpr
leftExpr PlatformExpr
rightExpr

-- Parse AND expressions (higher precedence)
parseAnd :: [String] -> Maybe PlatformExpr
parseAnd :: [String] -> Maybe PlatformExpr
parseAnd [String]
tokens = case (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"&") [String]
tokens of
  ([String]
left, []) -> [String] -> Maybe PlatformExpr
parseAtom [String]
left
  ([String]
left, String
_:[String]
right) -> do
    PlatformExpr
leftExpr <- [String] -> Maybe PlatformExpr
parseAtom [String]
left
    PlatformExpr
rightExpr <- [String] -> Maybe PlatformExpr
parseAnd [String]
right
    PlatformExpr -> Maybe PlatformExpr
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (PlatformExpr -> Maybe PlatformExpr)
-> PlatformExpr -> Maybe PlatformExpr
forall a b. (a -> b) -> a -> b
$ PlatformExpr -> PlatformExpr -> PlatformExpr
And PlatformExpr
leftExpr PlatformExpr
rightExpr

-- Parse atomic expressions (platform names and negation)
parseAtom :: [String] -> Maybe PlatformExpr
parseAtom :: [String] -> Maybe PlatformExpr
parseAtom [] = Maybe PlatformExpr
forall a. Maybe a
Nothing
parseAtom [String]
tokens = case [String]
tokens of
  [String
"linux"] -> PlatformExpr -> Maybe PlatformExpr
forall a. a -> Maybe a
Just (PlatformExpr -> Maybe PlatformExpr)
-> PlatformExpr -> Maybe PlatformExpr
forall a b. (a -> b) -> a -> b
$ String -> PlatformExpr
PlatformName String
"linux"
  [String
"darwin"] -> PlatformExpr -> Maybe PlatformExpr
forall a. a -> Maybe a
Just (PlatformExpr -> Maybe PlatformExpr)
-> PlatformExpr -> Maybe PlatformExpr
forall a b. (a -> b) -> a -> b
$ String -> PlatformExpr
PlatformName String
"darwin"
  [String
"windows"] -> PlatformExpr -> Maybe PlatformExpr
forall a. a -> Maybe a
Just (PlatformExpr -> Maybe PlatformExpr)
-> PlatformExpr -> Maybe PlatformExpr
forall a b. (a -> b) -> a -> b
$ String -> PlatformExpr
PlatformName String
"mingw32"
  [String
"mingw32"] -> PlatformExpr -> Maybe PlatformExpr
forall a. a -> Maybe a
Just (PlatformExpr -> Maybe PlatformExpr)
-> PlatformExpr -> Maybe PlatformExpr
forall a b. (a -> b) -> a -> b
$ String -> PlatformExpr
PlatformName String
"mingw32"
  [String
"unix"] -> PlatformExpr -> Maybe PlatformExpr
forall a. a -> Maybe a
Just (PlatformExpr -> Maybe PlatformExpr)
-> PlatformExpr -> Maybe PlatformExpr
forall a b. (a -> b) -> a -> b
$ PlatformExpr -> PlatformExpr -> PlatformExpr
Or (String -> PlatformExpr
PlatformName String
"linux") (String -> PlatformExpr
PlatformName String
"darwin")
  [String
"!linux"] -> PlatformExpr -> Maybe PlatformExpr
forall a. a -> Maybe a
Just (PlatformExpr -> Maybe PlatformExpr)
-> PlatformExpr -> Maybe PlatformExpr
forall a b. (a -> b) -> a -> b
$ PlatformExpr -> PlatformExpr
Not (String -> PlatformExpr
PlatformName String
"linux")
  [String
"!darwin"] -> PlatformExpr -> Maybe PlatformExpr
forall a. a -> Maybe a
Just (PlatformExpr -> Maybe PlatformExpr)
-> PlatformExpr -> Maybe PlatformExpr
forall a b. (a -> b) -> a -> b
$ PlatformExpr -> PlatformExpr
Not (String -> PlatformExpr
PlatformName String
"darwin")
  [String
"!windows"] -> PlatformExpr -> Maybe PlatformExpr
forall a. a -> Maybe a
Just (PlatformExpr -> Maybe PlatformExpr)
-> PlatformExpr -> Maybe PlatformExpr
forall a b. (a -> b) -> a -> b
$ PlatformExpr -> PlatformExpr
Not (String -> PlatformExpr
PlatformName String
"mingw32")
  [String
"!mingw32"] -> PlatformExpr -> Maybe PlatformExpr
forall a. a -> Maybe a
Just (PlatformExpr -> Maybe PlatformExpr)
-> PlatformExpr -> Maybe PlatformExpr
forall a b. (a -> b) -> a -> b
$ PlatformExpr -> PlatformExpr
Not (String -> PlatformExpr
PlatformName String
"mingw32")
  [String
"!unix"] -> PlatformExpr -> Maybe PlatformExpr
forall a. a -> Maybe a
Just (PlatformExpr -> Maybe PlatformExpr)
-> PlatformExpr -> Maybe PlatformExpr
forall a b. (a -> b) -> a -> b
$ PlatformExpr -> PlatformExpr
Not (PlatformExpr -> PlatformExpr -> PlatformExpr
Or (String -> PlatformExpr
PlatformName String
"linux") (String -> PlatformExpr
PlatformName String
"darwin"))
  [String]
_ -> Maybe PlatformExpr
forall a. Maybe a
Nothing

-- Simple expression data type
data PlatformExpr 
  = PlatformName String
  | Not PlatformExpr
  | And PlatformExpr PlatformExpr  
  | Or PlatformExpr PlatformExpr
  deriving stock (Int -> PlatformExpr -> ShowS
[PlatformExpr] -> ShowS
PlatformExpr -> String
(Int -> PlatformExpr -> ShowS)
-> (PlatformExpr -> String)
-> ([PlatformExpr] -> ShowS)
-> Show PlatformExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlatformExpr -> ShowS
showsPrec :: Int -> PlatformExpr -> ShowS
$cshow :: PlatformExpr -> String
show :: PlatformExpr -> String
$cshowList :: [PlatformExpr] -> ShowS
showList :: [PlatformExpr] -> ShowS
Show, PlatformExpr -> PlatformExpr -> Bool
(PlatformExpr -> PlatformExpr -> Bool)
-> (PlatformExpr -> PlatformExpr -> Bool) -> Eq PlatformExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PlatformExpr -> PlatformExpr -> Bool
== :: PlatformExpr -> PlatformExpr -> Bool
$c/= :: PlatformExpr -> PlatformExpr -> Bool
/= :: PlatformExpr -> PlatformExpr -> Bool
Eq)

-- Evaluate the expression against the current platform
evalExpression :: PlatformExpr -> String -> Bool
evalExpression :: PlatformExpr -> String -> Bool
evalExpression PlatformExpr
expr String
currentPlatform = case PlatformExpr
expr of
  PlatformName String
platformName -> String
currentPlatform String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
platformName
  Not PlatformExpr
e -> Bool -> Bool
not (PlatformExpr -> String -> Bool
evalExpression PlatformExpr
e String
currentPlatform)
  And PlatformExpr
e1 PlatformExpr
e2 -> PlatformExpr -> String -> Bool
evalExpression PlatformExpr
e1 String
currentPlatform Bool -> Bool -> Bool
&& PlatformExpr -> String -> Bool
evalExpression PlatformExpr
e2 String
currentPlatform
  Or PlatformExpr
e1 PlatformExpr
e2 -> PlatformExpr -> String -> Bool
evalExpression PlatformExpr
e1 String
currentPlatform Bool -> Bool -> Bool
|| PlatformExpr -> String -> Bool
evalExpression PlatformExpr
e2 String
currentPlatform