never executed always true always false
1 {-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DeriveFunctor, DeriveTraversable, DeriveFoldable #-}
2
3 module Conjure.Language.Expression.Op.ToMSet 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 OpToMSet x = OpToMSet x
15 deriving (Eq, Ord, Show, Data, Functor, Traversable, Foldable, Typeable, Generic)
16
17 instance Serialize x => Serialize (OpToMSet x)
18 instance Hashable x => Hashable (OpToMSet x)
19 instance ToJSON x => ToJSON (OpToMSet x) where toJSON = genericToJSON jsonOptions
20 instance FromJSON x => FromJSON (OpToMSet x) where parseJSON = genericParseJSON jsonOptions
21
22 instance (TypeOf x, Pretty x) => TypeOf (OpToMSet x) where
23 typeOf p@(OpToMSet x) = do
24 tx <- typeOf x
25 case tx of
26 TypeRelation is -> return (TypeMSet (TypeTuple is))
27 TypeSet i -> return (TypeMSet i)
28 TypeFunction i j -> return (TypeMSet (TypeTuple [i,j]))
29 TypeList i -> return (TypeMSet i)
30 _ -> raiseTypeError $ vcat [ pretty p
31 , "The argument has type:" <+> pretty tx
32 ]
33
34 instance SimplifyOp OpToMSet x where
35 simplifyOp _ = na "simplifyOp{OpToMSet}"
36
37 instance Pretty x => Pretty (OpToMSet x) where
38 prettyPrec _ (OpToMSet a) = "toMSet" <> prParens (pretty a)
39
40 instance VarSymBreakingDescription x => VarSymBreakingDescription (OpToMSet x) where
41 varSymBreakingDescription (OpToMSet a) = JSON.Object $ KM.fromList
42 [ ("type", JSON.String "OpToMSet")
43 , ("children", JSON.Array $ V.fromList
44 [ varSymBreakingDescription a
45 ])
46 ]