{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}
module Swarm.Language.Capability (
Capability (..),
capabilityName,
parseCapability,
constCaps,
constByCaps,
) where
import Control.Arrow ((&&&))
import Data.Aeson (FromJSONKey, ToJSONKey)
import Data.Char (toLower)
import Data.Data (Data)
import Data.Foldable (find)
import Data.Hashable (Hashable)
import Data.List.Extra (enumerate)
import Data.List.NonEmpty qualified as NE
import Data.Map (Map)
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Tuple (swap)
import Data.Yaml
import GHC.Generics (Generic)
import Generic.Data (FiniteEnumeration (..))
import Prettyprinter (pretty)
import Swarm.Language.Syntax.Constants (Const (..), allConst, constInfo, syntax)
import Swarm.Pretty (PrettyPrec (..))
import Swarm.Util (binTuples, failT, showEnum)
import Witch (from)
import Prelude hiding (lookup)
data Capability
=
CExecute Const
|
CPower
|
CMoveHeavy
|
CFloat
|
COrient
|
CEnv
|
CLambda
|
CRecursion
|
CSum
|
CProd
|
CRecord
|
CDebug
|
CRectype
|
CGod
deriving (Capability -> Capability -> Bool
(Capability -> Capability -> Bool)
-> (Capability -> Capability -> Bool) -> Eq Capability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Capability -> Capability -> Bool
== :: Capability -> Capability -> Bool
$c/= :: Capability -> Capability -> Bool
/= :: Capability -> Capability -> Bool
Eq, Eq Capability
Eq Capability =>
(Capability -> Capability -> Ordering)
-> (Capability -> Capability -> Bool)
-> (Capability -> Capability -> Bool)
-> (Capability -> Capability -> Bool)
-> (Capability -> Capability -> Bool)
-> (Capability -> Capability -> Capability)
-> (Capability -> Capability -> Capability)
-> Ord Capability
Capability -> Capability -> Bool
Capability -> Capability -> Ordering
Capability -> Capability -> Capability
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Capability -> Capability -> Ordering
compare :: Capability -> Capability -> Ordering
$c< :: Capability -> Capability -> Bool
< :: Capability -> Capability -> Bool
$c<= :: Capability -> Capability -> Bool
<= :: Capability -> Capability -> Bool
$c> :: Capability -> Capability -> Bool
> :: Capability -> Capability -> Bool
$c>= :: Capability -> Capability -> Bool
>= :: Capability -> Capability -> Bool
$cmax :: Capability -> Capability -> Capability
max :: Capability -> Capability -> Capability
$cmin :: Capability -> Capability -> Capability
min :: Capability -> Capability -> Capability
Ord, Int -> Capability -> ShowS
[Capability] -> ShowS
Capability -> String
(Int -> Capability -> ShowS)
-> (Capability -> String)
-> ([Capability] -> ShowS)
-> Show Capability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Capability -> ShowS
showsPrec :: Int -> Capability -> ShowS
$cshow :: Capability -> String
show :: Capability -> String
$cshowList :: [Capability] -> ShowS
showList :: [Capability] -> ShowS
Show, (forall x. Capability -> Rep Capability x)
-> (forall x. Rep Capability x -> Capability) -> Generic Capability
forall x. Rep Capability x -> Capability
forall x. Capability -> Rep Capability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Capability -> Rep Capability x
from :: forall x. Capability -> Rep Capability x
$cto :: forall x. Rep Capability x -> Capability
to :: forall x. Rep Capability x -> Capability
Generic, Eq Capability
Eq Capability =>
(Int -> Capability -> Int)
-> (Capability -> Int) -> Hashable Capability
Int -> Capability -> Int
Capability -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Capability -> Int
hashWithSalt :: Int -> Capability -> Int
$chash :: Capability -> Int
hash :: Capability -> Int
Hashable, Typeable Capability
Typeable Capability =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Capability -> c Capability)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Capability)
-> (Capability -> Constr)
-> (Capability -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Capability))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Capability))
-> ((forall b. Data b => b -> b) -> Capability -> Capability)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Capability -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Capability -> r)
-> (forall u. (forall d. Data d => d -> u) -> Capability -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> Capability -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Capability -> m Capability)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Capability -> m Capability)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Capability -> m Capability)
-> Data Capability
Capability -> Constr
Capability -> DataType
(forall b. Data b => b -> b) -> Capability -> Capability
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Capability -> u
forall u. (forall d. Data d => d -> u) -> Capability -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Capability -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Capability -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Capability -> m Capability
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Capability -> m Capability
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Capability
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Capability -> c Capability
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Capability)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Capability)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Capability -> c Capability
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Capability -> c Capability
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Capability
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Capability
$ctoConstr :: Capability -> Constr
toConstr :: Capability -> Constr
$cdataTypeOf :: Capability -> DataType
dataTypeOf :: Capability -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Capability)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Capability)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Capability)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Capability)
$cgmapT :: (forall b. Data b => b -> b) -> Capability -> Capability
gmapT :: (forall b. Data b => b -> b) -> Capability -> Capability
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Capability -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Capability -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Capability -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Capability -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Capability -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Capability -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Capability -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Capability -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Capability -> m Capability
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Capability -> m Capability
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Capability -> m Capability
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Capability -> m Capability
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Capability -> m Capability
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Capability -> m Capability
Data, FromJSONKeyFunction [Capability]
FromJSONKeyFunction Capability
FromJSONKeyFunction Capability
-> FromJSONKeyFunction [Capability] -> FromJSONKey Capability
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction Capability
fromJSONKey :: FromJSONKeyFunction Capability
$cfromJSONKeyList :: FromJSONKeyFunction [Capability]
fromJSONKeyList :: FromJSONKeyFunction [Capability]
FromJSONKey, ToJSONKeyFunction [Capability]
ToJSONKeyFunction Capability
ToJSONKeyFunction Capability
-> ToJSONKeyFunction [Capability] -> ToJSONKey Capability
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction Capability
toJSONKey :: ToJSONKeyFunction Capability
$ctoJSONKeyList :: ToJSONKeyFunction [Capability]
toJSONKeyList :: ToJSONKeyFunction [Capability]
ToJSONKey)
deriving (Int -> Capability
Capability -> Int
Capability -> [Capability]
Capability -> Capability
Capability -> Capability -> [Capability]
Capability -> Capability -> Capability -> [Capability]
(Capability -> Capability)
-> (Capability -> Capability)
-> (Int -> Capability)
-> (Capability -> Int)
-> (Capability -> [Capability])
-> (Capability -> Capability -> [Capability])
-> (Capability -> Capability -> [Capability])
-> (Capability -> Capability -> Capability -> [Capability])
-> Enum Capability
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Capability -> Capability
succ :: Capability -> Capability
$cpred :: Capability -> Capability
pred :: Capability -> Capability
$ctoEnum :: Int -> Capability
toEnum :: Int -> Capability
$cfromEnum :: Capability -> Int
fromEnum :: Capability -> Int
$cenumFrom :: Capability -> [Capability]
enumFrom :: Capability -> [Capability]
$cenumFromThen :: Capability -> Capability -> [Capability]
enumFromThen :: Capability -> Capability -> [Capability]
$cenumFromTo :: Capability -> Capability -> [Capability]
enumFromTo :: Capability -> Capability -> [Capability]
$cenumFromThenTo :: Capability -> Capability -> Capability -> [Capability]
enumFromThenTo :: Capability -> Capability -> Capability -> [Capability]
Enum, Capability
Capability -> Capability -> Bounded Capability
forall a. a -> a -> Bounded a
$cminBound :: Capability
minBound :: Capability
$cmaxBound :: Capability
maxBound :: Capability
Bounded) via (FiniteEnumeration Capability)
instance PrettyPrec Capability where
prettyPrec :: forall ann. Int -> Capability -> Doc ann
prettyPrec Int
_ Capability
c = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> Text -> Doc ann
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower (String -> Text
forall source target. From source target => source -> target
from (NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NE.tail (NonEmpty Char -> String) -> NonEmpty Char -> String
forall a b. (a -> b) -> a -> b
$ Capability -> NonEmpty Char
forall e. (Show e, Enum e) => e -> NonEmpty Char
showEnum Capability
c))
capabilityName :: Capability -> Text
capabilityName :: Capability -> Text
capabilityName = \case
CExecute Const
con -> case Const
con of
Const
Neg -> Text
"neg"
Const
_ -> ConstInfo -> Text
syntax (ConstInfo -> Text) -> ConstInfo -> Text
forall a b. (a -> b) -> a -> b
$ Const -> ConstInfo
constInfo Const
con
Capability
CMoveHeavy -> Text
"move heavy robot"
Capability
cap -> forall source target. From source target => source -> target
from @String (String -> Text) -> ShowS -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Capability -> String
forall a. Show a => a -> String
show Capability
cap
parseCapability :: Text -> Maybe Capability
parseCapability :: Text -> Maybe Capability
parseCapability Text
t = (Capability -> Bool) -> [Capability] -> Maybe Capability
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Capability
c -> Capability -> Text
capabilityName Capability
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
T.toLower Text
t) [Capability]
forall a. (Enum a, Bounded a) => [a]
enumerate
instance ToJSON Capability where
toJSON :: Capability -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Capability -> Text) -> Capability -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capability -> Text
capabilityName
instance FromJSON Capability where
parseJSON :: Value -> Parser Capability
parseJSON = String -> (Text -> Parser Capability) -> Value -> Parser Capability
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Capability" Text -> Parser Capability
tryRead
where
tryRead :: Text -> Parser Capability
tryRead :: Text -> Parser Capability
tryRead Text
t = case Text -> Maybe Capability
parseCapability Text
t of
Just Capability
c -> Capability -> Parser Capability
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Capability
c
Maybe Capability
Nothing -> [Text] -> Parser Capability
forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"Unknown capability", Text
t]
constCaps :: Const -> Maybe Capability
constCaps :: Const -> Maybe Capability
constCaps = \case
Const
AppF -> Maybe Capability
forall a. Maybe a
Nothing
Const
Base -> Maybe Capability
forall a. Maybe a
Nothing
Const
Equipped -> Maybe Capability
forall a. Maybe a
Nothing
Const
Fail -> Maybe Capability
forall a. Maybe a
Nothing
Const
Force -> Maybe Capability
forall a. Maybe a
Nothing
Const
Has -> Maybe Capability
forall a. Maybe a
Nothing
Const
Knows -> Maybe Capability
forall a. Maybe a
Nothing
Const
Noop -> Maybe Capability
forall a. Maybe a
Nothing
Const
Parent -> Maybe Capability
forall a. Maybe a
Nothing
Const
Pure -> Maybe Capability
forall a. Maybe a
Nothing
Const
Say -> Maybe Capability
forall a. Maybe a
Nothing
Const
Setname -> Maybe Capability
forall a. Maybe a
Nothing
Const
Undefined -> Maybe Capability
forall a. Maybe a
Nothing
Const
Use -> Maybe Capability
forall a. Maybe a
Nothing
Const
View -> Maybe Capability
forall a. Maybe a
Nothing
Const
Run -> Maybe Capability
forall a. Maybe a
Nothing
Const
As -> Capability -> Maybe Capability
forall a. a -> Maybe a
Just Capability
CGod
Const
Create -> Capability -> Maybe Capability
forall a. a -> Maybe a
Just Capability
CGod
Const
Instant -> Capability -> Maybe Capability
forall a. a -> Maybe a
Just Capability
CGod
Const
RobotNamed -> Capability -> Maybe Capability
forall a. a -> Maybe a
Just Capability
CGod
Const
RobotNumbered -> Capability -> Maybe Capability
forall a. a -> Maybe a
Just Capability
CGod
Const
Surveil -> Capability -> Maybe Capability
forall a. a -> Maybe a
Just Capability
CGod
Const
Inl -> Capability -> Maybe Capability
forall a. a -> Maybe a
Just Capability
CSum
Const
Inr -> Capability -> Maybe Capability
forall a. a -> Maybe a
Just Capability
CSum
Const
Case -> Capability -> Maybe Capability
forall a. a -> Maybe a
Just Capability
CSum
Const
Match -> Capability -> Maybe Capability
forall a. a -> Maybe a
Just Capability
CProd
Const
c -> Capability -> Maybe Capability
forall a. a -> Maybe a
Just (Const -> Capability
CExecute Const
c)
constByCaps :: Map Capability (NE.NonEmpty Const)
constByCaps :: Map Capability (NonEmpty Const)
constByCaps =
[(Capability, Const)] -> Map Capability (NonEmpty Const)
forall (t :: * -> *) a b.
(Foldable t, Ord a) =>
t (a, b) -> Map a (NonEmpty b)
binTuples ([(Capability, Const)] -> Map Capability (NonEmpty Const))
-> [(Capability, Const)] -> Map Capability (NonEmpty Const)
forall a b. (a -> b) -> a -> b
$
((Const, Capability) -> (Capability, Const))
-> [(Const, Capability)] -> [(Capability, Const)]
forall a b. (a -> b) -> [a] -> [b]
map (Const, Capability) -> (Capability, Const)
forall a b. (a, b) -> (b, a)
swap ([(Const, Capability)] -> [(Capability, Const)])
-> [(Const, Capability)] -> [(Capability, Const)]
forall a b. (a -> b) -> a -> b
$
(Const -> Maybe (Const, Capability))
-> [Const] -> [(Const, Capability)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Const, Maybe Capability) -> Maybe (Const, Capability)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
(Const, f a) -> f (Const, a)
sequenceA ((Const, Maybe Capability) -> Maybe (Const, Capability))
-> (Const -> (Const, Maybe Capability))
-> Const
-> Maybe (Const, Capability)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Const -> Const
forall a. a -> a
id (Const -> Const)
-> (Const -> Maybe Capability)
-> Const
-> (Const, Maybe Capability)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Const -> Maybe Capability
constCaps)) [Const]
allConst