never executed always true always false
1 {-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DeriveFunctor, DeriveTraversable, DeriveFoldable #-}
2
3 module Conjure.Language.Expression.Op.Pred where
4
5 import Conjure.Prelude
6 import Conjure.Language.Expression.Op.Internal.Common
7
8 import qualified Data.Aeson as JSON -- aeson
9 import qualified Data.Aeson.KeyMap as KM
10
11 import qualified Data.Vector as V -- vector
12
13
14 data OpPred x = OpPred x
15 deriving (Eq, Ord, Show, Data, Functor, Traversable, Foldable, Typeable, Generic)
16
17 instance Serialize x => Serialize (OpPred x)
18 instance Hashable x => Hashable (OpPred x)
19 instance ToJSON x => ToJSON (OpPred x) where toJSON = genericToJSON jsonOptions
20 instance FromJSON x => FromJSON (OpPred x) where parseJSON = genericParseJSON jsonOptions
21
22 instance (TypeOf x, Pretty x) => TypeOf (OpPred x) where
23 typeOf p@(OpPred x) = do
24 ty <- typeOf x
25 case ty of
26 TypeBool{} -> return ty
27 TypeInt TagInt -> return ty
28 TypeInt (TagEnum _) -> return ty
29 TypeEnum{} -> return ty
30 _ -> raiseTypeError p
31
32 instance SimplifyOp OpPred x where
33 simplifyOp _ = na "simplifyOp{OpPred}"
34
35 instance Pretty x => Pretty (OpPred x) where
36 prettyPrec _ (OpPred x) = "pred" <> prParens (pretty x)
37
38 instance VarSymBreakingDescription x => VarSymBreakingDescription (OpPred x) where
39 varSymBreakingDescription (OpPred a) = JSON.Object $ KM.fromList
40 [ ("type", JSON.String "OpPred")
41 , ("children", JSON.Array $ V.fromList
42 [ varSymBreakingDescription a
43 ])
44 ]