never executed always true always false
1 {-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DeriveFunctor, DeriveTraversable, DeriveFoldable #-}
2
3 module Conjure.Language.Expression.Op.AllDiff 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 OpAllDiff x = OpAllDiff x
15 deriving (Eq, Ord, Show, Data, Functor, Traversable, Foldable, Typeable, Generic)
16
17 instance Serialize x => Serialize (OpAllDiff x)
18 instance Hashable x => Hashable (OpAllDiff x)
19 instance ToJSON x => ToJSON (OpAllDiff x) where toJSON = genericToJSON jsonOptions
20 instance FromJSON x => FromJSON (OpAllDiff x) where parseJSON = genericParseJSON jsonOptions
21
22 instance (TypeOf x, Pretty x) => TypeOf (OpAllDiff x) where
23 typeOf p@(OpAllDiff x) = do
24 ty <- typeOf x
25 case ty of
26 TypeList{} -> return TypeBool
27 TypeMatrix{} -> return TypeBool
28 _ -> raiseTypeError p
29
30 instance SimplifyOp OpAllDiff x where
31 simplifyOp (OpAllDiff x)
32 | Just xs <- listOut x
33 , length xs == 1
34 = return $ fromBool True
35 simplifyOp _ = na "simplifyOp{OpAllDiff}"
36
37 instance Pretty x => Pretty (OpAllDiff x) where
38 prettyPrec _ (OpAllDiff a) = "allDiff" <> prParens (pretty a)
39
40 instance (VarSymBreakingDescription x, ExpressionLike x) => VarSymBreakingDescription (OpAllDiff x) where
41 varSymBreakingDescription (OpAllDiff x) | Just xs <- listOut x = JSON.Object $ KM.fromList
42 [ ("type", JSON.String "OpAllDiff")
43 , ("children", JSON.Array $ V.fromList $ map varSymBreakingDescription xs)
44 , ("symmetricChildren", JSON.Bool True)
45 ]
46 varSymBreakingDescription (OpAllDiff x) = JSON.Object $ KM.fromList
47 [ ("type", JSON.String "OpAllDiff")
48 , ("children", varSymBreakingDescription x)
49 ]