{-
	Copyright (C) 2021 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]

	* Describes the direction of a file of the board.
-}

module BishBosh.Direction.Vertical(
-- * Types
-- ** Data-types
	Vertical(),
-- * Constants
--	verticals,
	nVerticals
) where

import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership
import qualified	BishBosh.Property.Opposable		as Property.Opposable
import qualified	BishBosh.Property.Reflectable		as Property.Reflectable
import qualified	BishBosh.Type.Count			as Type.Count

-- | The sum-type of orientations of all lines of constant file.
data Vertical	= S | N deriving (Int -> Vertical
Vertical -> Int
Vertical -> [Vertical]
Vertical -> Vertical
Vertical -> Vertical -> [Vertical]
Vertical -> Vertical -> Vertical -> [Vertical]
(Vertical -> Vertical)
-> (Vertical -> Vertical)
-> (Int -> Vertical)
-> (Vertical -> Int)
-> (Vertical -> [Vertical])
-> (Vertical -> Vertical -> [Vertical])
-> (Vertical -> Vertical -> [Vertical])
-> (Vertical -> Vertical -> Vertical -> [Vertical])
-> Enum Vertical
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Vertical -> Vertical -> Vertical -> [Vertical]
$cenumFromThenTo :: Vertical -> Vertical -> Vertical -> [Vertical]
enumFromTo :: Vertical -> Vertical -> [Vertical]
$cenumFromTo :: Vertical -> Vertical -> [Vertical]
enumFromThen :: Vertical -> Vertical -> [Vertical]
$cenumFromThen :: Vertical -> Vertical -> [Vertical]
enumFrom :: Vertical -> [Vertical]
$cenumFrom :: Vertical -> [Vertical]
fromEnum :: Vertical -> Int
$cfromEnum :: Vertical -> Int
toEnum :: Int -> Vertical
$ctoEnum :: Int -> Vertical
pred :: Vertical -> Vertical
$cpred :: Vertical -> Vertical
succ :: Vertical -> Vertical
$csucc :: Vertical -> Vertical
Enum, Vertical -> Vertical -> Bool
(Vertical -> Vertical -> Bool)
-> (Vertical -> Vertical -> Bool) -> Eq Vertical
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vertical -> Vertical -> Bool
$c/= :: Vertical -> Vertical -> Bool
== :: Vertical -> Vertical -> Bool
$c== :: Vertical -> Vertical -> Bool
Eq, Eq Vertical
Eq Vertical
-> (Vertical -> Vertical -> Ordering)
-> (Vertical -> Vertical -> Bool)
-> (Vertical -> Vertical -> Bool)
-> (Vertical -> Vertical -> Bool)
-> (Vertical -> Vertical -> Bool)
-> (Vertical -> Vertical -> Vertical)
-> (Vertical -> Vertical -> Vertical)
-> Ord Vertical
Vertical -> Vertical -> Bool
Vertical -> Vertical -> Ordering
Vertical -> Vertical -> Vertical
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
min :: Vertical -> Vertical -> Vertical
$cmin :: Vertical -> Vertical -> Vertical
max :: Vertical -> Vertical -> Vertical
$cmax :: Vertical -> Vertical -> Vertical
>= :: Vertical -> Vertical -> Bool
$c>= :: Vertical -> Vertical -> Bool
> :: Vertical -> Vertical -> Bool
$c> :: Vertical -> Vertical -> Bool
<= :: Vertical -> Vertical -> Bool
$c<= :: Vertical -> Vertical -> Bool
< :: Vertical -> Vertical -> Bool
$c< :: Vertical -> Vertical -> Bool
compare :: Vertical -> Vertical -> Ordering
$ccompare :: Vertical -> Vertical -> Ordering
$cp1Ord :: Eq Vertical
Ord, Int -> Vertical -> ShowS
[Vertical] -> ShowS
Vertical -> String
(Int -> Vertical -> ShowS)
-> (Vertical -> String) -> ([Vertical] -> ShowS) -> Show Vertical
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vertical] -> ShowS
$cshowList :: [Vertical] -> ShowS
show :: Vertical -> String
$cshow :: Vertical -> String
showsPrec :: Int -> Vertical -> ShowS
$cshowsPrec :: Int -> Vertical -> ShowS
Show)

instance Read Vertical where
	readsPrec :: Int -> ReadS Vertical
readsPrec Int
_ (Char
'S' : String
s)	= [(Vertical
S, String
s)]
	readsPrec Int
_ (Char
'N' : String
s)	= [(Vertical
N, String
s)]
	readsPrec Int
_ String
_		= []	-- No parse.

instance Property.FixedMembership.FixedMembership Vertical where
	members :: [Vertical]
members	= [Vertical]
verticals

instance Property.Opposable.Opposable Vertical where
	getOpposite :: Vertical -> Vertical
getOpposite Vertical
S	= Vertical
N
	getOpposite Vertical
N	= Vertical
S

instance Property.Reflectable.ReflectableOnX Vertical where
	reflectOnX :: Vertical -> Vertical
reflectOnX	= Vertical -> Vertical
forall a. Opposable a => a -> a
Property.Opposable.getOpposite

-- | Constant range of values.
verticals :: [Vertical]
verticals :: [Vertical]
verticals	= [ Int -> Vertical
forall a. Enum a => Int -> a
toEnum Int
0 .. ]

-- | The number of verticals directions.
nVerticals :: Type.Count.NDirections
nVerticals :: Int
nVerticals	= Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Vertical] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Vertical]
verticals