-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- A model for defining boolean expressions for Objective prerequisites.
--
-- This model is intended to be user-facing in the .yaml files, and is
-- distinct from that in 'Data.BoolExpr'.
module Swarm.Game.Scenario.Objective.Logic where

import Control.Applicative ((<|>))
import Data.Aeson
import Data.BoolExpr
import Data.Char (toLower)
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
import GHC.Generics (Generic)

type ObjectiveLabel = Text

-- | In contrast with the "BoolExpr" type,
-- "And" and "Or" can have /one or more/ children
-- instead of /exactly two/.
data Prerequisite a
  = And (NonEmpty (Prerequisite a))
  | Or (NonEmpty (Prerequisite a))
  | Not (Prerequisite a)
  | Id a
  deriving (Prerequisite a -> Prerequisite a -> Bool
(Prerequisite a -> Prerequisite a -> Bool)
-> (Prerequisite a -> Prerequisite a -> Bool)
-> Eq (Prerequisite a)
forall a. Eq a => Prerequisite a -> Prerequisite a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Prerequisite a -> Prerequisite a -> Bool
== :: Prerequisite a -> Prerequisite a -> Bool
$c/= :: forall a. Eq a => Prerequisite a -> Prerequisite a -> Bool
/= :: Prerequisite a -> Prerequisite a -> Bool
Eq, Int -> Prerequisite a -> ShowS
[Prerequisite a] -> ShowS
Prerequisite a -> String
(Int -> Prerequisite a -> ShowS)
-> (Prerequisite a -> String)
-> ([Prerequisite a] -> ShowS)
-> Show (Prerequisite a)
forall a. Show a => Int -> Prerequisite a -> ShowS
forall a. Show a => [Prerequisite a] -> ShowS
forall a. Show a => Prerequisite a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Prerequisite a -> ShowS
showsPrec :: Int -> Prerequisite a -> ShowS
$cshow :: forall a. Show a => Prerequisite a -> String
show :: Prerequisite a -> String
$cshowList :: forall a. Show a => [Prerequisite a] -> ShowS
showList :: [Prerequisite a] -> ShowS
Show, (forall x. Prerequisite a -> Rep (Prerequisite a) x)
-> (forall x. Rep (Prerequisite a) x -> Prerequisite a)
-> Generic (Prerequisite a)
forall x. Rep (Prerequisite a) x -> Prerequisite a
forall x. Prerequisite a -> Rep (Prerequisite a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Prerequisite a) x -> Prerequisite a
forall a x. Prerequisite a -> Rep (Prerequisite a) x
$cfrom :: forall a x. Prerequisite a -> Rep (Prerequisite a) x
from :: forall x. Prerequisite a -> Rep (Prerequisite a) x
$cto :: forall a x. Rep (Prerequisite a) x -> Prerequisite a
to :: forall x. Rep (Prerequisite a) x -> Prerequisite a
Generic, (forall a b. (a -> b) -> Prerequisite a -> Prerequisite b)
-> (forall a b. a -> Prerequisite b -> Prerequisite a)
-> Functor Prerequisite
forall a b. a -> Prerequisite b -> Prerequisite a
forall a b. (a -> b) -> Prerequisite a -> Prerequisite b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Prerequisite a -> Prerequisite b
fmap :: forall a b. (a -> b) -> Prerequisite a -> Prerequisite b
$c<$ :: forall a b. a -> Prerequisite b -> Prerequisite a
<$ :: forall a b. a -> Prerequisite b -> Prerequisite a
Functor, (forall m. Monoid m => Prerequisite m -> m)
-> (forall m a. Monoid m => (a -> m) -> Prerequisite a -> m)
-> (forall m a. Monoid m => (a -> m) -> Prerequisite a -> m)
-> (forall a b. (a -> b -> b) -> b -> Prerequisite a -> b)
-> (forall a b. (a -> b -> b) -> b -> Prerequisite a -> b)
-> (forall b a. (b -> a -> b) -> b -> Prerequisite a -> b)
-> (forall b a. (b -> a -> b) -> b -> Prerequisite a -> b)
-> (forall a. (a -> a -> a) -> Prerequisite a -> a)
-> (forall a. (a -> a -> a) -> Prerequisite a -> a)
-> (forall a. Prerequisite a -> [a])
-> (forall a. Prerequisite a -> Bool)
-> (forall a. Prerequisite a -> Int)
-> (forall a. Eq a => a -> Prerequisite a -> Bool)
-> (forall a. Ord a => Prerequisite a -> a)
-> (forall a. Ord a => Prerequisite a -> a)
-> (forall a. Num a => Prerequisite a -> a)
-> (forall a. Num a => Prerequisite a -> a)
-> Foldable Prerequisite
forall a. Eq a => a -> Prerequisite a -> Bool
forall a. Num a => Prerequisite a -> a
forall a. Ord a => Prerequisite a -> a
forall m. Monoid m => Prerequisite m -> m
forall a. Prerequisite a -> Bool
forall a. Prerequisite a -> Int
forall a. Prerequisite a -> [a]
forall a. (a -> a -> a) -> Prerequisite a -> a
forall m a. Monoid m => (a -> m) -> Prerequisite a -> m
forall b a. (b -> a -> b) -> b -> Prerequisite a -> b
forall a b. (a -> b -> b) -> b -> Prerequisite a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Prerequisite m -> m
fold :: forall m. Monoid m => Prerequisite m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Prerequisite a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Prerequisite a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Prerequisite a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Prerequisite a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Prerequisite a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Prerequisite a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Prerequisite a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Prerequisite a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Prerequisite a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Prerequisite a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Prerequisite a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Prerequisite a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Prerequisite a -> a
foldr1 :: forall a. (a -> a -> a) -> Prerequisite a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Prerequisite a -> a
foldl1 :: forall a. (a -> a -> a) -> Prerequisite a -> a
$ctoList :: forall a. Prerequisite a -> [a]
toList :: forall a. Prerequisite a -> [a]
$cnull :: forall a. Prerequisite a -> Bool
null :: forall a. Prerequisite a -> Bool
$clength :: forall a. Prerequisite a -> Int
length :: forall a. Prerequisite a -> Int
$celem :: forall a. Eq a => a -> Prerequisite a -> Bool
elem :: forall a. Eq a => a -> Prerequisite a -> Bool
$cmaximum :: forall a. Ord a => Prerequisite a -> a
maximum :: forall a. Ord a => Prerequisite a -> a
$cminimum :: forall a. Ord a => Prerequisite a -> a
minimum :: forall a. Ord a => Prerequisite a -> a
$csum :: forall a. Num a => Prerequisite a -> a
sum :: forall a. Num a => Prerequisite a -> a
$cproduct :: forall a. Num a => Prerequisite a -> a
product :: forall a. Num a => Prerequisite a -> a
Foldable)

prerequisiteOptions :: Options
prerequisiteOptions :: Options
prerequisiteOptions =
  Options
defaultOptions
    { sumEncoding = ObjectWithSingleField
    , constructorTagModifier = map toLower
    }

instance ToJSON (Prerequisite ObjectiveLabel) where
  toJSON :: Prerequisite ObjectiveLabel -> Value
toJSON = Options -> Prerequisite ObjectiveLabel -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
prerequisiteOptions

instance FromJSON (Prerequisite ObjectiveLabel) where
  parseJSON :: Value -> Parser (Prerequisite ObjectiveLabel)
parseJSON Value
x = Value -> Parser (Prerequisite ObjectiveLabel)
preString Value
x Parser (Prerequisite ObjectiveLabel)
-> Parser (Prerequisite ObjectiveLabel)
-> Parser (Prerequisite ObjectiveLabel)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Options -> Value -> Parser (Prerequisite ObjectiveLabel)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
prerequisiteOptions Value
x
   where
    preString :: Value -> Parser (Prerequisite ObjectiveLabel)
preString = String
-> (ObjectiveLabel -> Parser (Prerequisite ObjectiveLabel))
-> Value
-> Parser (Prerequisite ObjectiveLabel)
forall a.
String -> (ObjectiveLabel -> Parser a) -> Value -> Parser a
withText String
"prerequisite" ((ObjectiveLabel -> Parser (Prerequisite ObjectiveLabel))
 -> Value -> Parser (Prerequisite ObjectiveLabel))
-> (ObjectiveLabel -> Parser (Prerequisite ObjectiveLabel))
-> Value
-> Parser (Prerequisite ObjectiveLabel)
forall a b. (a -> b) -> a -> b
$ Prerequisite ObjectiveLabel -> Parser (Prerequisite ObjectiveLabel)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Prerequisite ObjectiveLabel
 -> Parser (Prerequisite ObjectiveLabel))
-> (ObjectiveLabel -> Prerequisite ObjectiveLabel)
-> ObjectiveLabel
-> Parser (Prerequisite ObjectiveLabel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectiveLabel -> Prerequisite ObjectiveLabel
forall a. a -> Prerequisite a
Id

toBoolExpr :: Prerequisite a -> BoolExpr a
toBoolExpr :: forall a. Prerequisite a -> BoolExpr a
toBoolExpr (And NonEmpty (Prerequisite a)
xs) = (BoolExpr a -> BoolExpr a -> BoolExpr a)
-> NonEmpty (BoolExpr a) -> BoolExpr a
forall a. (a -> a -> a) -> NonEmpty a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 BoolExpr a -> BoolExpr a -> BoolExpr a
forall a. BoolExpr a -> BoolExpr a -> BoolExpr a
BAnd ((Prerequisite a -> BoolExpr a)
-> NonEmpty (Prerequisite a) -> NonEmpty (BoolExpr a)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prerequisite a -> BoolExpr a
forall a. Prerequisite a -> BoolExpr a
toBoolExpr NonEmpty (Prerequisite a)
xs)
toBoolExpr (Or NonEmpty (Prerequisite a)
xs) = (BoolExpr a -> BoolExpr a -> BoolExpr a)
-> NonEmpty (BoolExpr a) -> BoolExpr a
forall a. (a -> a -> a) -> NonEmpty a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 BoolExpr a -> BoolExpr a -> BoolExpr a
forall a. BoolExpr a -> BoolExpr a -> BoolExpr a
BOr ((Prerequisite a -> BoolExpr a)
-> NonEmpty (Prerequisite a) -> NonEmpty (BoolExpr a)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prerequisite a -> BoolExpr a
forall a. Prerequisite a -> BoolExpr a
toBoolExpr NonEmpty (Prerequisite a)
xs)
toBoolExpr (Not Prerequisite a
x) = BoolExpr a -> BoolExpr a
forall a. BoolExpr a -> BoolExpr a
BNot (BoolExpr a -> BoolExpr a) -> BoolExpr a -> BoolExpr a
forall a b. (a -> b) -> a -> b
$ Prerequisite a -> BoolExpr a
forall a. Prerequisite a -> BoolExpr a
toBoolExpr Prerequisite a
x
toBoolExpr (Id a
x) = Signed a -> BoolExpr a
forall a. Signed a -> BoolExpr a
BConst (Signed a -> BoolExpr a) -> Signed a -> BoolExpr a
forall a b. (a -> b) -> a -> b
$ a -> Signed a
forall a. a -> Signed a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x