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 _ -> return ty
   30             TypeEnum{} -> return ty
   31             _ -> raiseTypeError $ vcat [ pretty p
   32                                        , "Unexpected type inside min:" <+> pretty ty
   33                                        ]
   34     typeOf p@(OpMin x) = do
   35         ty <- typeOf x
   36         tyInner <- case ty of
   37             TypeList tyInner -> return tyInner
   38             TypeMatrix _ tyInner -> return tyInner
   39             TypeSet tyInner -> return tyInner
   40             TypeMSet tyInner -> return tyInner
   41             _ -> raiseTypeError $ vcat [ pretty p
   42                                        , "Unexpected type inside min:" <+> pretty ty
   43                                        ]
   44         case tyInner of
   45             TypeInt TagInt -> return ()
   46             TypeInt TaggedInt{} -> 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         ]