{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-}


-- |

-- Module      : OAlg.Structure.Oriented.Opposite

-- Description : predicate for the opposite

-- Copyright   : (c) Erich Gut

-- License     : BSD3

-- Maintainer  : zerich.gut@gmail.com

--

-- predicate for the opposite.

module OAlg.Structure.Oriented.Opposite
  (
    -- * Op

    Op(..), fromOp, fromOpOp
  , toOpG

    -- * Transformable

  , TransformableOp, tauOp
  , structOrtOp
  , TransformableGReflOp
  ) where


import OAlg.Prelude

import OAlg.Structure.Oriented.Definition

--------------------------------------------------------------------------------

-- Op -


-- | Predicate for the opposite of a type @__x__@. 

newtype Op x = Op x deriving (Int -> Op x -> ShowS
[Op x] -> ShowS
Op x -> String
(Int -> Op x -> ShowS)
-> (Op x -> String) -> ([Op x] -> ShowS) -> Show (Op x)
forall x. Show x => Int -> Op x -> ShowS
forall x. Show x => [Op x] -> ShowS
forall x. Show x => Op x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall x. Show x => Int -> Op x -> ShowS
showsPrec :: Int -> Op x -> ShowS
$cshow :: forall x. Show x => Op x -> String
show :: Op x -> String
$cshowList :: forall x. Show x => [Op x] -> ShowS
showList :: [Op x] -> ShowS
Show,ReadPrec [Op x]
ReadPrec (Op x)
Int -> ReadS (Op x)
ReadS [Op x]
(Int -> ReadS (Op x))
-> ReadS [Op x]
-> ReadPrec (Op x)
-> ReadPrec [Op x]
-> Read (Op x)
forall x. Read x => ReadPrec [Op x]
forall x. Read x => ReadPrec (Op x)
forall x. Read x => Int -> ReadS (Op x)
forall x. Read x => ReadS [Op x]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall x. Read x => Int -> ReadS (Op x)
readsPrec :: Int -> ReadS (Op x)
$creadList :: forall x. Read x => ReadS [Op x]
readList :: ReadS [Op x]
$creadPrec :: forall x. Read x => ReadPrec (Op x)
readPrec :: ReadPrec (Op x)
$creadListPrec :: forall x. Read x => ReadPrec [Op x]
readListPrec :: ReadPrec [Op x]
Read,Op x -> Op x -> Bool
(Op x -> Op x -> Bool) -> (Op x -> Op x -> Bool) -> Eq (Op x)
forall x. Eq x => Op x -> Op x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall x. Eq x => Op x -> Op x -> Bool
== :: Op x -> Op x -> Bool
$c/= :: forall x. Eq x => Op x -> Op x -> Bool
/= :: Op x -> Op x -> Bool
Eq)

deriving instance Validable x => Validable (Op x)

instance XStandard x => XStandard (Op x) where xStandard :: X (Op x)
xStandard = (x -> Op x) -> X x -> X (Op x)
forall (h :: * -> * -> *) (f :: * -> *) x y.
Applicative1 h f =>
h x y -> f x -> f y
amap1 x -> Op x
forall x. x -> Op x
Op X x
forall x. XStandard x => X x
xStandard

--------------------------------------------------------------------------------

-- Op (x) - Instances -


instance Ord x => Ord (Op x) where Op x
x compare :: Op x -> Op x -> Ordering
`compare` Op x
y = x
y x -> x -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` x
x

instance Logical a => Logical (Op a) where
  Op a
a || :: Op a -> Op a -> Op a
|| Op a
b = a -> Op a
forall x. x -> Op x
Op (a
b a -> a -> a
forall a. Logical a => a -> a -> a
&& a
a)
  Op a
a && :: Op a -> Op a -> Op a
&& Op a
b = a -> Op a
forall x. x -> Op x
Op (a
b a -> a -> a
forall a. Logical a => a -> a -> a
|| a
a)

--------------------------------------------------------------------------------

-- Point - Op -


type instance Point (Op x) = Point x

instance ShowPoint x => ShowPoint (Op x)
instance EqPoint x => EqPoint (Op x)
instance OrdPoint x => OrdPoint (Op x)
instance SingletonPoint x => SingletonPoint (Op x)
instance ValidablePoint x => ValidablePoint (Op x)
instance TypeablePoint x => TypeablePoint (Op x)
instance XStandardPoint x => XStandardPoint (Op x)

instance Oriented q => Oriented (Op q) where
  orientation :: Op q -> Orientation (Point (Op q))
orientation (Op q
a) = Orientation (Point q) -> Orientation (Point q)
forall p. Orientation p -> Orientation p
opposite (q -> Orientation (Point q)
forall q. Oriented q => q -> Orientation (Point q)
orientation q
a)

instance TransformableG Op Ort Ort where tauG :: forall x. Struct Ort x -> Struct Ort (Op x)
tauG Struct Ort x
Struct = Struct Ort (Op x)
forall s x. Structure s x => Struct s x
Struct
instance TransformableG Op (Ort,t) Ort where tauG :: forall x. Struct (Ort, t) x -> Struct Ort (Op x)
tauG = Struct Ort x -> Struct Ort (Op x)
forall x. Struct Ort x -> Struct Ort (Op x)
forall (t :: * -> *) u v x.
TransformableG t u v =>
Struct u x -> Struct v (t x)
tauG (Struct Ort x -> Struct Ort (Op x))
-> (Struct (Ort, t) x -> Struct Ort x)
-> Struct (Ort, t) x
-> Struct Ort (Op x)
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. Struct (Ort, t) x -> Struct Ort x
forall s t x. Struct (s, t) x -> Struct s x
tauFst

instance TransformableGRefl Op Ort
instance TransformableOp Ort

instance TransformableG Op OrtX OrtX where tauG :: forall x. Struct OrtX x -> Struct OrtX (Op x)
tauG Struct OrtX x
Struct = Struct OrtX (Op x)
forall s x. Structure s x => Struct s x
Struct
instance TransformableOp OrtX
instance TransformableGRefl Op OrtX

instance TransformableG Op EqEOrt EqEOrt where tauG :: forall x. Struct EqEOrt x -> Struct EqEOrt (Op x)
tauG Struct EqEOrt x
Struct = Struct EqEOrt (Op x)
forall s x. Structure s x => Struct s x
Struct

--------------------------------------------------------------------------------

-- structOrtOp -


-- | attest that if @__x__@ is 'Oriented' then also @'Op' __x__@ is 'Oriented'.

structOrtOp :: Struct Ort x -> Struct Ort (Op x)
structOrtOp :: forall x. Struct Ort x -> Struct Ort (Op x)
structOrtOp Struct Ort x
Struct = Struct Ort (Op x)
forall s x. Structure s x => Struct s x
Struct

--------------------------------------------------------------------------------

-- fromOp -

-- | from @'Op' x@.

fromOp :: Op x -> x
fromOp :: forall x. Op x -> x
fromOp (Op x
x) = x
x

--------------------------------------------------------------------------------

-- toOpG -


-- | the induced mapping. 

toOpG :: (x -> y) -> Op x -> Op y
toOpG :: forall x y. (x -> y) -> Op x -> Op y
toOpG x -> y
f (Op x
x) = y -> Op y
forall x. x -> Op x
Op (x -> y
f x
x)

--------------------------------------------------------------------------------

-- fromOpOp -


-- | from @'Op' ('Op' x)@.

fromOpOp :: Op (Op x) -> x
fromOpOp :: forall x. Op (Op x) -> x
fromOpOp (Op (Op x
x)) = x
x

--------------------------------------------------------------------------------

-- TransformableOp -


-- | helper class to avoid undecidable instances.

class TransformableG Op s s => TransformableOp s

--------------------------------------------------------------------------------

-- tauOp -


-- | 'tau' for 'Op'.

tauOp :: Transformable1 Op s => Struct s x -> Struct s (Op x)
tauOp :: forall s x. Transformable1 Op s => Struct s x -> Struct s (Op x)
tauOp = Struct s x -> Struct s (Op x)
forall x. Struct s x -> Struct s (Op x)
forall (t :: * -> *) u v x.
TransformableG t u v =>
Struct u x -> Struct v (t x)
tauG

--------------------------------------------------------------------------------

-- TransformableGReflOp -


-- | helper class to avoid undecidable instances.

class TransformableGRefl Op s => TransformableGReflOp s


{-
--------------------------------------------------------------------------------
-- Op2 -

-- | Predicat for the opposite of a two parametrized type @__h__@ where
--   the two parameters @__x__@ and @__y__@ are switched
newtype Op2 h x y = Op2 (h y x)

instance Show2 h => Show2 (Op2 h) where
  show2 (Op2 h) = "Op2[" ++ show2 h ++ "]"

instance Eq2 h => Eq2 (Op2 h) where
  eq2 (Op2 f) (Op2 g) = eq2 f g 

--------------------------------------------------------------------------------
-- toOp2Struct -

-- | transforming a 'Struct' where __@p@__ serves only as a proxy for __@m@__ and will not
--   be evaluated.
toOp2Struct :: p m -> Struct (ObjectClass m) x -> Struct (ObjectClass (Op2 m)) x
toOp2Struct _ = id

--------------------------------------------------------------------------------
-- Op2 - Instance -

instance Morphism h => Morphism (Op2 h) where
  type ObjectClass (Op2 h) = ObjectClass h
  domain (Op2 h) = range h
  range (Op2 h) = domain h
  
instance Category c => Category (Op2 c) where
  cOne s = Op2 (cOne s)
  Op2 f . Op2 g = Op2 (g . f)

instance Cayleyan2 c => Cayleyan2 (Op2 c) where
  invert2 (Op2 f) = Op2 (invert2 f)
  
instance Validable2 h => Validable2 (Op2 h) where
  valid2 (Op2 h) = valid2 h
-}