{-# LANGUAGE NoImplicitPrelude #-}

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


-- |

-- Module      : OAlg.Structure.Oriented.Orientation

-- Description : defining a orientation on a type.

-- Copyright   : (c) Erich Gut

-- License     : BSD3

-- Maintainer  : zerich.gut@gmail.com

--

-- defining a orientation on a type.

module OAlg.Structure.Oriented.Orientation
  (
    -- * Orientation

    Orientation(..), opposite
  , OS

    -- * Applicative

  , omap
  ) where

import Control.Monad

import Data.Typeable

import OAlg.Prelude

import OAlg.Data.Singleton
import OAlg.Data.Symbol

import OAlg.Structure.Oriented.Point

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

-- Orientation -


infix 5 :>
  
-- | orientation given by the start point as its first component and the end point as its

--   second.

--

--  __Property__ For all @o@ in @'Orientation' __p__@ holds:

--  @o '==' 'OAlg.Structure.Oriented.Definition.start' o

--     ':>' 'OAlg.Structure.Oriented.Definition.end' o@.

--

--  __Note__ As 'Orientation's are instances of almost all algebraic structures

--  defined here, they serve as a /proof/ that this structures are instanceable.

data Orientation p = p :> p deriving (Int -> Orientation p -> ShowS
[Orientation p] -> ShowS
Orientation p -> String
(Int -> Orientation p -> ShowS)
-> (Orientation p -> String)
-> ([Orientation p] -> ShowS)
-> Show (Orientation p)
forall p. Show p => Int -> Orientation p -> ShowS
forall p. Show p => [Orientation p] -> ShowS
forall p. Show p => Orientation p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall p. Show p => Int -> Orientation p -> ShowS
showsPrec :: Int -> Orientation p -> ShowS
$cshow :: forall p. Show p => Orientation p -> String
show :: Orientation p -> String
$cshowList :: forall p. Show p => [Orientation p] -> ShowS
showList :: [Orientation p] -> ShowS
Show,Orientation p -> Orientation p -> Bool
(Orientation p -> Orientation p -> Bool)
-> (Orientation p -> Orientation p -> Bool) -> Eq (Orientation p)
forall p. Eq p => Orientation p -> Orientation p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall p. Eq p => Orientation p -> Orientation p -> Bool
== :: Orientation p -> Orientation p -> Bool
$c/= :: forall p. Eq p => Orientation p -> Orientation p -> Bool
/= :: Orientation p -> Orientation p -> Bool
Eq,Eq (Orientation p)
Eq (Orientation p) =>
(Orientation p -> Orientation p -> Ordering)
-> (Orientation p -> Orientation p -> Bool)
-> (Orientation p -> Orientation p -> Bool)
-> (Orientation p -> Orientation p -> Bool)
-> (Orientation p -> Orientation p -> Bool)
-> (Orientation p -> Orientation p -> Orientation p)
-> (Orientation p -> Orientation p -> Orientation p)
-> Ord (Orientation p)
Orientation p -> Orientation p -> Bool
Orientation p -> Orientation p -> Ordering
Orientation p -> Orientation p -> Orientation p
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
forall p. Ord p => Eq (Orientation p)
forall p. Ord p => Orientation p -> Orientation p -> Bool
forall p. Ord p => Orientation p -> Orientation p -> Ordering
forall p. Ord p => Orientation p -> Orientation p -> Orientation p
$ccompare :: forall p. Ord p => Orientation p -> Orientation p -> Ordering
compare :: Orientation p -> Orientation p -> Ordering
$c< :: forall p. Ord p => Orientation p -> Orientation p -> Bool
< :: Orientation p -> Orientation p -> Bool
$c<= :: forall p. Ord p => Orientation p -> Orientation p -> Bool
<= :: Orientation p -> Orientation p -> Bool
$c> :: forall p. Ord p => Orientation p -> Orientation p -> Bool
> :: Orientation p -> Orientation p -> Bool
$c>= :: forall p. Ord p => Orientation p -> Orientation p -> Bool
>= :: Orientation p -> Orientation p -> Bool
$cmax :: forall p. Ord p => Orientation p -> Orientation p -> Orientation p
max :: Orientation p -> Orientation p -> Orientation p
$cmin :: forall p. Ord p => Orientation p -> Orientation p -> Orientation p
min :: Orientation p -> Orientation p -> Orientation p
Ord)

instance Validable p => Validable (Orientation p) where
  valid :: Orientation p -> Statement
valid (p
s :> p
e) = [Statement] -> Statement
And [p -> Statement
forall a. Validable a => a -> Statement
valid p
s,p -> Statement
forall a. Validable a => a -> Statement
valid p
e]

instance Singleton u => Singleton (Orientation u) where
  unit :: Orientation u
unit = u
forall s. Singleton s => s
unit u -> u -> Orientation u
forall p. p -> p -> Orientation p
:> u
forall s. Singleton s => s
unit

instance ApplicativeG Orientation (->) (->) where
  amapG :: forall x y. (x -> y) -> Orientation x -> Orientation y
amapG x -> y
f (x
a :> x
b) = x -> y
f x
a y -> y -> Orientation y
forall p. p -> p -> Orientation p
:> x -> y
f x
b

instance XStandard p => XStandard (Orientation p) where
  xStandard :: X (Orientation p)
xStandard = X p -> X p -> X (p, p)
forall a b. X a -> X b -> X (a, b)
xTupple2 X p
forall x. XStandard x => X x
xStandard X p
forall x. XStandard x => X x
xStandard X (p, p) -> ((p, p) -> X (Orientation p)) -> X (Orientation p)
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Orientation p -> X (Orientation p)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Orientation p -> X (Orientation p))
-> ((p, p) -> Orientation p) -> (p, p) -> X (Orientation p)
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
. (p -> p -> Orientation p) -> (p, p) -> Orientation p
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry p -> p -> Orientation p
forall p. p -> p -> Orientation p
(:>)

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

-- opposite -


-- | the opposite orientation.

opposite :: Orientation p -> Orientation p
opposite :: forall p. Orientation p -> Orientation p
opposite (p
s:>p
e) = p
ep -> p -> Orientation p
forall p. p -> p -> Orientation p
:>p
s

instance Transposable (Orientation p) where
  transpose :: Orientation p -> Orientation p
transpose = Orientation p -> Orientation p
forall p. Orientation p -> Orientation p
opposite

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

-- OS -


-- | as @'Orientation' p@ is an instance of almost every structured class it

--   serves as a standard type for validating.

type OS = Orientation Symbol

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

-- Point - Orientation -


type instance Point (Orientation x) = x

instance Show x => ShowPoint (Orientation x)
instance Eq x => EqPoint (Orientation x)
instance Ord x => OrdPoint (Orientation x)
instance Singleton x => SingletonPoint (Orientation x)
instance Validable x => ValidablePoint (Orientation x)
instance Typeable x => TypeablePoint (Orientation x)
instance XStandard p => XStandardPoint (Orientation p)

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

-- omap -


-- | the induced mapping of 'Orientation'.

omap :: ApplicativePoint h => h a b -> Orientation (Point a) -> Orientation (Point b)
omap :: forall (h :: * -> * -> *) a b.
ApplicativePoint h =>
h a b -> Orientation (Point a) -> Orientation (Point b)
omap = (Point a -> Point b)
-> Orientation (Point a) -> Orientation (Point b)
forall x y. (x -> y) -> Orientation x -> Orientation y
forall (t :: * -> *) (a :: * -> * -> *) (b :: * -> * -> *) x y.
ApplicativeG t a b =>
a x y -> b (t x) (t y)
amapG ((Point a -> Point b)
 -> Orientation (Point a) -> Orientation (Point b))
-> (h a b -> Point a -> Point b)
-> h a b
-> Orientation (Point a)
-> Orientation (Point b)
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
. h a b -> Point a -> Point b
forall (h :: * -> * -> *) x y.
ApplicativePoint h =>
h x y -> Point x -> Point y
pmap