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