never executed always true always false
1 {-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DeriveFunctor, DeriveTraversable, DeriveFoldable #-}
2
3 module Conjure.Language.Expression.Op.Freq 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 OpFreq x = OpFreq x x
15 deriving (Eq, Ord, Show, Data, Functor, Traversable, Foldable, Typeable, Generic)
16
17 instance Serialize x => Serialize (OpFreq x)
18 instance Hashable x => Hashable (OpFreq x)
19 instance ToJSON x => ToJSON (OpFreq x) where toJSON = genericToJSON jsonOptions
20 instance FromJSON x => FromJSON (OpFreq x) where parseJSON = genericParseJSON jsonOptions
21
22 instance (TypeOf x, Pretty x) => TypeOf (OpFreq x) where
23 typeOf p@(OpFreq m e) = do
24 tyM <- typeOf m
25 tyE <- typeOf e
26 case tyM of
27 TypeMatrix _ tyE'
28 | tyE `typeUnify` tyE' -> return $ TypeInt TagInt
29 | otherwise -> raiseTypeError $ vcat
30 [ "The first argument of freq is expected to be a matrix or a multi-set."
31 , "We got:" <+> pretty tyM
32 , "In expression:" <+> pretty p
33 ]
34 TypeMSet tyE'
35 | tyE `typeUnify` tyE' -> return $ TypeInt TagInt
36 | otherwise -> raiseTypeError $ vcat
37 [ "The first argument of freq is expected to be a matrix or a multi-set."
38 , "We got:" <+> pretty tyM
39 , "In expression:" <+> pretty p
40 ]
41 _ -> raiseTypeError $ vcat
42 [ "The first argument of freq is expected to be a matrix or a multi-set."
43 , "We got:" <+> pretty tyM
44 , "In expression:" <+> pretty p
45 ]
46
47 instance SimplifyOp OpFreq x where
48 simplifyOp _ = na "simplifyOp{OpFreq}"
49
50 instance Pretty x => Pretty (OpFreq x) where
51 prettyPrec _ (OpFreq a b) = "freq" <> prettyList prParens "," [a,b]
52
53 instance VarSymBreakingDescription x => VarSymBreakingDescription (OpFreq x) where
54 varSymBreakingDescription (OpFreq a b) = JSON.Object $ KM.fromList
55 [ ("type", JSON.String "OpFreq")
56 , ("children", JSON.Array $ V.fromList
57 [ varSymBreakingDescription a
58 , varSymBreakingDescription b
59 ])
60 ]