never executed always true always false
1 {-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DeriveFunctor, DeriveTraversable, DeriveFoldable, ViewPatterns #-}
2
3 module Conjure.Language.Expression.Op.Compose 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 import qualified Data.Vector as V -- vector
11
12
13
14 data OpCompose x = OpCompose x x
15 deriving (Eq, Ord, Show, Data, Functor, Traversable, Foldable, Typeable, Generic)
16
17 instance Serialize x => Serialize (OpCompose x)
18 instance Hashable x => Hashable (OpCompose x)
19 instance ToJSON x => ToJSON (OpCompose x) where toJSON = genericToJSON jsonOptions
20 instance FromJSON x => FromJSON (OpCompose x) where parseJSON = genericParseJSON jsonOptions
21
22 instance (TypeOf x, Pretty x) => TypeOf (OpCompose x) where
23 typeOf inp@(OpCompose p q) = do
24 pTy <- typeOf p
25 qTy <- typeOf q
26 case (pTy, qTy) of
27 (TypePermutation pTyInner, TypePermutation qTyInner) ->
28 if typesUnify [pTyInner, qTyInner]
29 then return pTy
30 else raiseTypeError inp
31 _ -> raiseTypeError inp
32
33 instance SimplifyOp OpCompose x where
34 simplifyOp _ = na "simplifyOp{OpCompose}"
35
36 instance Pretty x => Pretty (OpCompose x) where
37 prettyPrec _ (OpCompose a i) = "compose" <> prettyList prParens "," [a,i]
38
39
40 instance VarSymBreakingDescription x => VarSymBreakingDescription (OpCompose x) where
41 varSymBreakingDescription (OpCompose a i) = JSON.Object $ KM.fromList
42 [ ("type", JSON.String "OpCompose")
43 , ("children", JSON.Array $ V.fromList
44 [ varSymBreakingDescription a
45 , varSymBreakingDescription i
46 ])
47 ]