never executed always true always false

    1 {-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DeriveFunctor, DeriveTraversable, DeriveFoldable #-}
    2 {-# LANGUAGE UndecidableInstances #-}
    3 {-# LANGUAGE InstanceSigs #-}
    4 
    5 module Conjure.Language.Expression.Op.Restrict where
    6 
    7 import Conjure.Prelude
    8 import Conjure.Language.Expression.Op.Internal.Common
    9 -- import {-# SOURCE #-} Conjure.Process.ValidateConstantForDomain ( validateConstantForDomain )
   10 
   11 import qualified Data.Aeson as JSON             -- aeson
   12 import qualified Data.Aeson.KeyMap as KM
   13 
   14 import qualified Data.Vector as V               -- vector
   15 
   16 
   17 data OpRestrict x = OpRestrict x {- the function -} x {- the domain -}
   18     deriving (Eq, Ord, Show, Data, Functor, Traversable, Foldable, Typeable, Generic)
   19 
   20 instance Serialize x => Serialize (OpRestrict x)
   21 instance Hashable  x => Hashable  (OpRestrict x)
   22 instance ToJSON    x => ToJSON    (OpRestrict x) where toJSON = genericToJSON jsonOptions
   23 instance FromJSON  x => FromJSON  (OpRestrict x) where parseJSON = genericParseJSON jsonOptions
   24 
   25 instance (TypeOf x, Pretty x, Domain () x :< x) => TypeOf (OpRestrict x) where
   26     typeOf p@(OpRestrict f domX) = do
   27         dom :: Domain () x   <- project domX
   28         TypeFunction from to <- typeOf f
   29         from'                <- typeOfDomain dom
   30         if typesUnify [from, from']
   31             then return (TypeFunction (mostDefined [from', from]) to)
   32             else raiseTypeError p
   33         
   34 
   35 instance SimplifyOp OpRestrict x where
   36     simplifyOp _ = na "simplifyOp{OpRestrict}"
   37 
   38 instance Pretty x => Pretty (OpRestrict x) where
   39     prettyPrec _ (OpRestrict a b) = "restrict" <> prettyList prParens "," [a,b]
   40 
   41 instance VarSymBreakingDescription x => VarSymBreakingDescription (OpRestrict x) where
   42     varSymBreakingDescription (OpRestrict a b) = JSON.Object $ KM.fromList
   43         [ ("type", JSON.String "OpRestrict")
   44         , ("children", JSON.Array $ V.fromList
   45             [ varSymBreakingDescription a
   46             , varSymBreakingDescription b
   47             ])
   48         ]