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