never executed always true always false

    1 {-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DeriveFunctor, DeriveTraversable, DeriveFoldable #-}
    2 {-# LANGUAGE UndecidableInstances #-}
    3 
    4 module Conjure.Language.Expression.Op.Min where
    5 
    6 import Conjure.Prelude
    7 import Conjure.Language.Expression.Op.Internal.Common
    8 
    9 import qualified Data.Aeson as JSON             -- aeson
   10 import qualified Data.Aeson.KeyMap as KM
   11 
   12 import qualified Data.Vector as V               -- vector
   13 
   14 
   15 data OpMin x = OpMin x
   16     deriving (Eq, Ord, Show, Data, Functor, Traversable, Foldable, Typeable, Generic)
   17 
   18 instance Serialize x => Serialize (OpMin x)
   19 instance Hashable  x => Hashable  (OpMin x)
   20 instance ToJSON    x => ToJSON    (OpMin x) where toJSON = genericToJSON jsonOptions
   21 instance FromJSON  x => FromJSON  (OpMin x) where parseJSON = genericParseJSON jsonOptions
   22 
   23 instance ( TypeOf x, Pretty x
   24          , Domain () x :< x
   25          ) => TypeOf (OpMin x) where
   26     typeOf p@(OpMin x) | Just (dom :: Domain () x) <- project x = do
   27         ty <- typeOfDomain dom
   28         case ty of
   29             TypeInt TagInt -> return ty
   30             TypeInt (TagEnum _) -> return ty
   31             TypeEnum{} -> return ty
   32             _ -> raiseTypeError $ vcat [ pretty p
   33                                        , "Unexpected type inside min:" <+> pretty ty
   34                                        ]
   35     typeOf p@(OpMin x) = do
   36         ty <- typeOf x
   37         tyInner <- case ty of
   38             TypeList tyInner -> return tyInner
   39             TypeMatrix _ tyInner -> return tyInner
   40             TypeSet tyInner -> return tyInner
   41             TypeMSet tyInner -> return tyInner
   42             _ -> raiseTypeError $ vcat [ pretty p
   43                                        , "Unexpected type inside min:" <+> pretty ty
   44                                        ]
   45         case tyInner of
   46             TypeInt TagInt -> return ()
   47             TypeInt (TagEnum _) -> return ()
   48             _ -> raiseTypeError $ vcat [ pretty p
   49                                        , "Unexpected type inside min:" <+> pretty ty
   50                                        ]
   51         return tyInner
   52 
   53 instance SimplifyOp OpMin x where
   54     simplifyOp _ = na "simplifyOp{OpMin}"
   55 
   56 instance Pretty x => Pretty (OpMin x) where
   57     prettyPrec _ (OpMin x) = "min" <> prParens (pretty x)
   58 
   59 instance (VarSymBreakingDescription x, ExpressionLike x) => VarSymBreakingDescription (OpMin x) where
   60     varSymBreakingDescription (OpMin x) | Just xs <- listOut x = JSON.Object $ KM.fromList
   61         [ ("type", JSON.String "OpMin")
   62         , ("children", JSON.Array $ V.fromList $ map varSymBreakingDescription xs)
   63         , ("symmetricChildren", JSON.Bool True)
   64         ]
   65     varSymBreakingDescription (OpMin x) = JSON.Object $ KM.fromList
   66         [ ("type", JSON.String "OpMin")
   67         , ("children", varSymBreakingDescription x)
   68         ]