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