{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.OptDir
-- Copyright   :  (c) Masahiro Sakai 2012
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- 
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  stable
-- Portability :  non-portable
--
-- The OptDir type for representing optimization directions.
--
-----------------------------------------------------------------------------

module Data.OptDir
  (
    OptDir (..)
  ) where

import Control.DeepSeq
import Data.Ix
import Data.Typeable
import Data.Generics hiding (Generic)
import Data.Hashable
import GHC.Generics

{-|
The 'OptDir' type represents optimization directions.
-}
data OptDir
  = OptMin -- ^ minimization 
  | OptMax -- ^ maximization
  deriving (OptDir
OptDir -> OptDir -> Bounded OptDir
forall a. a -> a -> Bounded a
$cminBound :: OptDir
minBound :: OptDir
$cmaxBound :: OptDir
maxBound :: OptDir
Bounded, Int -> OptDir
OptDir -> Int
OptDir -> [OptDir]
OptDir -> OptDir
OptDir -> OptDir -> [OptDir]
OptDir -> OptDir -> OptDir -> [OptDir]
(OptDir -> OptDir)
-> (OptDir -> OptDir)
-> (Int -> OptDir)
-> (OptDir -> Int)
-> (OptDir -> [OptDir])
-> (OptDir -> OptDir -> [OptDir])
-> (OptDir -> OptDir -> [OptDir])
-> (OptDir -> OptDir -> OptDir -> [OptDir])
-> Enum OptDir
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: OptDir -> OptDir
succ :: OptDir -> OptDir
$cpred :: OptDir -> OptDir
pred :: OptDir -> OptDir
$ctoEnum :: Int -> OptDir
toEnum :: Int -> OptDir
$cfromEnum :: OptDir -> Int
fromEnum :: OptDir -> Int
$cenumFrom :: OptDir -> [OptDir]
enumFrom :: OptDir -> [OptDir]
$cenumFromThen :: OptDir -> OptDir -> [OptDir]
enumFromThen :: OptDir -> OptDir -> [OptDir]
$cenumFromTo :: OptDir -> OptDir -> [OptDir]
enumFromTo :: OptDir -> OptDir -> [OptDir]
$cenumFromThenTo :: OptDir -> OptDir -> OptDir -> [OptDir]
enumFromThenTo :: OptDir -> OptDir -> OptDir -> [OptDir]
Enum, OptDir -> OptDir -> Bool
(OptDir -> OptDir -> Bool)
-> (OptDir -> OptDir -> Bool) -> Eq OptDir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OptDir -> OptDir -> Bool
== :: OptDir -> OptDir -> Bool
$c/= :: OptDir -> OptDir -> Bool
/= :: OptDir -> OptDir -> Bool
Eq, Typeable OptDir
Typeable OptDir =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> OptDir -> c OptDir)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OptDir)
-> (OptDir -> Constr)
-> (OptDir -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OptDir))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OptDir))
-> ((forall b. Data b => b -> b) -> OptDir -> OptDir)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OptDir -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OptDir -> r)
-> (forall u. (forall d. Data d => d -> u) -> OptDir -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> OptDir -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> OptDir -> m OptDir)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OptDir -> m OptDir)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OptDir -> m OptDir)
-> Data OptDir
OptDir -> Constr
OptDir -> DataType
(forall b. Data b => b -> b) -> OptDir -> OptDir
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OptDir -> u
forall u. (forall d. Data d => d -> u) -> OptDir -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OptDir -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OptDir -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OptDir -> m OptDir
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OptDir -> m OptDir
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OptDir
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OptDir -> c OptDir
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OptDir)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OptDir)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OptDir -> c OptDir
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OptDir -> c OptDir
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OptDir
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OptDir
$ctoConstr :: OptDir -> Constr
toConstr :: OptDir -> Constr
$cdataTypeOf :: OptDir -> DataType
dataTypeOf :: OptDir -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OptDir)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OptDir)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OptDir)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OptDir)
$cgmapT :: (forall b. Data b => b -> b) -> OptDir -> OptDir
gmapT :: (forall b. Data b => b -> b) -> OptDir -> OptDir
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OptDir -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OptDir -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OptDir -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OptDir -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OptDir -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> OptDir -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OptDir -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OptDir -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OptDir -> m OptDir
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OptDir -> m OptDir
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OptDir -> m OptDir
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OptDir -> m OptDir
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OptDir -> m OptDir
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OptDir -> m OptDir
Data, Eq OptDir
Eq OptDir =>
(OptDir -> OptDir -> Ordering)
-> (OptDir -> OptDir -> Bool)
-> (OptDir -> OptDir -> Bool)
-> (OptDir -> OptDir -> Bool)
-> (OptDir -> OptDir -> Bool)
-> (OptDir -> OptDir -> OptDir)
-> (OptDir -> OptDir -> OptDir)
-> Ord OptDir
OptDir -> OptDir -> Bool
OptDir -> OptDir -> Ordering
OptDir -> OptDir -> OptDir
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OptDir -> OptDir -> Ordering
compare :: OptDir -> OptDir -> Ordering
$c< :: OptDir -> OptDir -> Bool
< :: OptDir -> OptDir -> Bool
$c<= :: OptDir -> OptDir -> Bool
<= :: OptDir -> OptDir -> Bool
$c> :: OptDir -> OptDir -> Bool
> :: OptDir -> OptDir -> Bool
$c>= :: OptDir -> OptDir -> Bool
>= :: OptDir -> OptDir -> Bool
$cmax :: OptDir -> OptDir -> OptDir
max :: OptDir -> OptDir -> OptDir
$cmin :: OptDir -> OptDir -> OptDir
min :: OptDir -> OptDir -> OptDir
Ord, ReadPrec [OptDir]
ReadPrec OptDir
Int -> ReadS OptDir
ReadS [OptDir]
(Int -> ReadS OptDir)
-> ReadS [OptDir]
-> ReadPrec OptDir
-> ReadPrec [OptDir]
-> Read OptDir
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OptDir
readsPrec :: Int -> ReadS OptDir
$creadList :: ReadS [OptDir]
readList :: ReadS [OptDir]
$creadPrec :: ReadPrec OptDir
readPrec :: ReadPrec OptDir
$creadListPrec :: ReadPrec [OptDir]
readListPrec :: ReadPrec [OptDir]
Read, Int -> OptDir -> ShowS
[OptDir] -> ShowS
OptDir -> String
(Int -> OptDir -> ShowS)
-> (OptDir -> String) -> ([OptDir] -> ShowS) -> Show OptDir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OptDir -> ShowS
showsPrec :: Int -> OptDir -> ShowS
$cshow :: OptDir -> String
show :: OptDir -> String
$cshowList :: [OptDir] -> ShowS
showList :: [OptDir] -> ShowS
Show, Ord OptDir
Ord OptDir =>
((OptDir, OptDir) -> [OptDir])
-> ((OptDir, OptDir) -> OptDir -> Int)
-> ((OptDir, OptDir) -> OptDir -> Int)
-> ((OptDir, OptDir) -> OptDir -> Bool)
-> ((OptDir, OptDir) -> Int)
-> ((OptDir, OptDir) -> Int)
-> Ix OptDir
(OptDir, OptDir) -> Int
(OptDir, OptDir) -> [OptDir]
(OptDir, OptDir) -> OptDir -> Bool
(OptDir, OptDir) -> OptDir -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (OptDir, OptDir) -> [OptDir]
range :: (OptDir, OptDir) -> [OptDir]
$cindex :: (OptDir, OptDir) -> OptDir -> Int
index :: (OptDir, OptDir) -> OptDir -> Int
$cunsafeIndex :: (OptDir, OptDir) -> OptDir -> Int
unsafeIndex :: (OptDir, OptDir) -> OptDir -> Int
$cinRange :: (OptDir, OptDir) -> OptDir -> Bool
inRange :: (OptDir, OptDir) -> OptDir -> Bool
$crangeSize :: (OptDir, OptDir) -> Int
rangeSize :: (OptDir, OptDir) -> Int
$cunsafeRangeSize :: (OptDir, OptDir) -> Int
unsafeRangeSize :: (OptDir, OptDir) -> Int
Ix, (forall x. OptDir -> Rep OptDir x)
-> (forall x. Rep OptDir x -> OptDir) -> Generic OptDir
forall x. Rep OptDir x -> OptDir
forall x. OptDir -> Rep OptDir x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OptDir -> Rep OptDir x
from :: forall x. OptDir -> Rep OptDir x
$cto :: forall x. Rep OptDir x -> OptDir
to :: forall x. Rep OptDir x -> OptDir
Generic, Typeable)

instance NFData OptDir where rnf :: OptDir -> ()
rnf = OptDir -> ()
forall a. a -> ()
rwhnf

instance Hashable OptDir where hashWithSalt :: Int -> OptDir -> Int
hashWithSalt = (OptDir -> Int) -> Int -> OptDir -> Int
forall b a. Hashable b => (a -> b) -> Int -> a -> Int
hashUsing OptDir -> Int
forall a. Enum a => a -> Int
fromEnum