never executed always true always false

    1 {-# LANGUAGE DeriveDataTypeable #-}
    2 {-# LANGUAGE DeriveGeneric #-}
    3 {-# LANGUAGE DeriveTraversable #-}
    4 {-# LANGUAGE InstanceSigs #-}
    5 
    6 module Conjure.Language.Expression.Op.QuickPermutationOrder where
    7 
    8 import Conjure.Language.Expression.Op.Internal.Common
    9 import Conjure.Prelude
   10 import Data.Aeson qualified as JSON -- aeson
   11 import Data.Aeson.KeyMap qualified as KM
   12 import Data.Vector qualified as V -- vector
   13 
   14 -- first argument: the tuple of permutations to apply (ps)
   15 -- second argument: the value (x)
   16 -- the effect is a subset of: x .<= transform(ps, x)
   17 data OpQuickPermutationOrder x = OpQuickPermutationOrder [x] x
   18   deriving (Eq, Ord, Show, Data, Functor, Traversable, Foldable, Typeable, Generic)
   19 
   20 instance (Serialize x) => Serialize (OpQuickPermutationOrder x)
   21 
   22 instance (Hashable x) => Hashable (OpQuickPermutationOrder x)
   23 
   24 instance (ToJSON x) => ToJSON (OpQuickPermutationOrder x) where
   25   toJSON :: (ToJSON x) => OpQuickPermutationOrder x -> JSON.Value
   26   toJSON = genericToJSON jsonOptions
   27 
   28 instance (FromJSON x) => FromJSON (OpQuickPermutationOrder x) where parseJSON = genericParseJSON jsonOptions
   29 
   30 instance (TypeOf x, Pretty x, ExpressionLike x) => TypeOf (OpQuickPermutationOrder x) where
   31   typeOf p@(OpQuickPermutationOrder perms x) = do
   32     _tyX <- typeOf x
   33     forM_ perms $ \pe -> do
   34       tyP <- typeOf pe
   35       case tyP of
   36         TypePermutation {} -> return ()
   37         _ -> raiseTypeError p
   38     return TypeBool
   39 
   40 instance SimplifyOp OpQuickPermutationOrder x where
   41   simplifyOp _ = na "simplifyOp{OpQuickPermutationOrder}"
   42 
   43 instance (Pretty x) => Pretty (OpQuickPermutationOrder x) where
   44   prettyPrec _ (OpQuickPermutationOrder as b) = "quickPermutationOrder" <> prettyListDoc prParens "," [prettyList prBrackets "," as, pretty b]
   45 
   46 instance (VarSymBreakingDescription x, ExpressionLike x) => VarSymBreakingDescription (OpQuickPermutationOrder x) where
   47   varSymBreakingDescription (OpQuickPermutationOrder xs y) =
   48     JSON.Object
   49       $ KM.fromList
   50         [ ("type", JSON.String "OpQuickPermutationOrder"),
   51           ( "children",
   52             JSON.Array $ V.fromList (map varSymBreakingDescription xs ++ [varSymBreakingDescription y])
   53           )
   54         ]