module BishBosh.Attribute.Direction(
NDirections,
ByDirection,
Direction(
getXDirection,
getYDirection
),
nw,
n,
ne,
w,
e,
sw,
s,
se,
tag,
nDistinctDirections,
parallels,
diagonals,
range,
opposites,
advanceDirection,
attackDirectionsForPawn,
listArrayByDirection,
mkDirection,
areAligned
) where
import Control.Arrow((&&&))
import qualified BishBosh.Attribute.LogicalColour as Attribute.LogicalColour
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified BishBosh.Property.Orientated as Property.Orientated
import qualified BishBosh.Property.Reflectable as Property.Reflectable
import qualified Control.Exception
import qualified Data.Array.IArray
import qualified Data.List.Extra
import qualified Text.XML.HXT.Arrow.Pickle as HXT
import qualified Text.XML.HXT.Arrow.Pickle.Schema
tag :: String
tag :: String
tag = String
"direction"
nw :: Direction
nw :: Direction
nw = Ordering -> Ordering -> Direction
MkDirection Ordering
LT Ordering
GT
n :: Direction
n :: Direction
n = Ordering -> Ordering -> Direction
MkDirection Ordering
EQ Ordering
GT
ne :: Direction
ne :: Direction
ne = Ordering -> Ordering -> Direction
MkDirection Ordering
GT Ordering
GT
w :: Direction
w :: Direction
w = Ordering -> Ordering -> Direction
MkDirection Ordering
LT Ordering
EQ
e :: Direction
e :: Direction
e = Ordering -> Ordering -> Direction
MkDirection Ordering
GT Ordering
EQ
sw :: Direction
sw :: Direction
sw = Ordering -> Ordering -> Direction
MkDirection Ordering
LT Ordering
LT
s :: Direction
s :: Direction
s = Ordering -> Ordering -> Direction
MkDirection Ordering
EQ Ordering
LT
se :: Direction
se :: Direction
se = Ordering -> Ordering -> Direction
MkDirection Ordering
GT Ordering
LT
type NDirections = Int
data Direction = MkDirection {
Direction -> Ordering
getXDirection :: Ordering,
Direction -> Ordering
getYDirection :: Ordering
} deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, Eq Direction
Eq Direction
-> (Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
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 :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmax :: Direction -> Direction -> Direction
>= :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c< :: Direction -> Direction -> Bool
compare :: Direction -> Direction -> Ordering
$ccompare :: Direction -> Direction -> Ordering
$cp1Ord :: Eq Direction
Ord)
instance Bounded Direction where
minBound :: Direction
minBound = Direction
sw
maxBound :: Direction
maxBound = Direction
ne
instance Show Direction where
showsPrec :: Int -> Direction -> ShowS
showsPrec Int
_ MkDirection {
getXDirection :: Direction -> Ordering
getXDirection = Ordering
xDirection,
getYDirection :: Direction -> Ordering
getYDirection = Ordering
yDirection
} = (
case Ordering
yDirection of
Ordering
LT -> Char -> ShowS
showChar Char
'S'
Ordering
EQ -> ShowS
forall a. a -> a
id
Ordering
GT -> Char -> ShowS
showChar Char
'N'
) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
case Ordering
xDirection of
Ordering
LT -> Char -> ShowS
showChar Char
'W'
Ordering
EQ -> ShowS
forall a. a -> a
id
Ordering
GT -> Char -> ShowS
showChar Char
'E'
)
instance Read Direction where
readsPrec :: Int -> ReadS Direction
readsPrec Int
_ String
ss = let
s' :: String
s' = ShowS
Data.List.Extra.trimStart String
ss
in case ShowS
Data.List.Extra.upper String
s' of
Char
'S' : String
remainder -> case String
remainder of
Char
'W' : String
_ -> [(Direction
sw, Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 String
s')]
Char
'E' : String
_ -> [(Direction
se, Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 String
s')]
String
_ -> [(Direction
s, ShowS
forall a. [a] -> [a]
tail String
s')]
Char
'N' : String
remainder -> case String
remainder of
Char
'W' : String
_ -> [(Direction
nw, Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 String
s')]
Char
'E' : String
_ -> [(Direction
ne, Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 String
s')]
String
_ -> [(Direction
n, ShowS
forall a. [a] -> [a]
tail String
s')]
Char
'W' : String
_ -> [(Direction
w, ShowS
forall a. [a] -> [a]
tail String
s')]
Char
'E' : String
_ -> [(Direction
e, ShowS
forall a. [a] -> [a]
tail String
s')]
String
_ -> []
reverseOrdering :: Ordering -> Ordering
reverseOrdering :: Ordering -> Ordering
reverseOrdering Ordering
LT = Ordering
GT
reverseOrdering Ordering
GT = Ordering
LT
reverseOrdering Ordering
_ = Ordering
EQ
instance Property.Opposable.Opposable Direction where
getOpposite :: Direction -> Direction
getOpposite MkDirection {
getXDirection :: Direction -> Ordering
getXDirection = Ordering
xDirection,
getYDirection :: Direction -> Ordering
getYDirection = Ordering
yDirection
} = MkDirection :: Ordering -> Ordering -> Direction
MkDirection {
getXDirection :: Ordering
getXDirection = Ordering -> Ordering
reverseOrdering Ordering
xDirection,
getYDirection :: Ordering
getYDirection = Ordering -> Ordering
reverseOrdering Ordering
yDirection
}
instance Property.Orientated.Orientated Direction where
isDiagonal :: Direction -> Bool
isDiagonal MkDirection { getXDirection :: Direction -> Ordering
getXDirection = Ordering
xDirection, getYDirection :: Direction -> Ordering
getYDirection = Ordering
yDirection } = Ordering
xDirection Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
EQ Bool -> Bool -> Bool
&& Ordering
yDirection Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
EQ
isParallel :: Direction -> Bool
isParallel MkDirection { getXDirection :: Direction -> Ordering
getXDirection = Ordering
xDirection, getYDirection :: Direction -> Ordering
getYDirection = Ordering
yDirection } = Ordering
xDirection Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ Bool -> Bool -> Bool
|| Ordering
yDirection Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
isStraight :: Direction -> Bool
isStraight = Bool -> Direction -> Bool
forall a b. a -> b -> a
const Bool
True
instance Property.Reflectable.ReflectableOnX Direction where
reflectOnX :: Direction -> Direction
reflectOnX direction :: Direction
direction@MkDirection { getYDirection :: Direction -> Ordering
getYDirection = Ordering
yDirection } = Direction
direction {
getYDirection :: Ordering
getYDirection = Ordering -> Ordering
reverseOrdering Ordering
yDirection
}
instance Property.Reflectable.ReflectableOnY Direction where
reflectOnY :: Direction -> Direction
reflectOnY direction :: Direction
direction@MkDirection { getXDirection :: Direction -> Ordering
getXDirection = Ordering
xDirection } = Direction
direction {
getXDirection :: Ordering
getXDirection = Ordering -> Ordering
reverseOrdering Ordering
xDirection
}
instance HXT.XmlPickler Direction where
xpickle :: PU Direction
xpickle = (String -> Direction, Direction -> String)
-> PU String -> PU Direction
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (String -> Direction
forall a. Read a => String -> a
read, Direction -> String
forall a. Show a => a -> String
show) (PU String -> PU Direction)
-> ([String] -> PU String) -> [String] -> PU Direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU String -> PU String
forall a. String -> PU a -> PU a
HXT.xpAttr String
tag (PU String -> PU String)
-> ([String] -> PU String) -> [String] -> PU String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> PU String
HXT.xpTextDT (Schema -> PU String)
-> ([String] -> Schema) -> [String] -> PU String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Schema
Text.XML.HXT.Arrow.Pickle.Schema.scEnum ([String] -> PU Direction) -> [String] -> PU Direction
forall a b. (a -> b) -> a -> b
$ (Direction -> String) -> [Direction] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Direction -> String
forall a. Show a => a -> String
show [Direction]
range
instance Data.Array.IArray.Ix Direction where
range :: (Direction, Direction) -> [Direction]
range (Direction
lower, Direction
upper) = Bool -> [Direction] -> [Direction]
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Direction
lower Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Direction
upper Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
forall a. Bounded a => a
maxBound) [Direction]
range
inRange :: (Direction, Direction) -> Direction -> Bool
inRange (Direction
lower, Direction
upper) Direction
_ = Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Direction
lower Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Direction
upper Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
forall a. Bounded a => a
maxBound) Bool
True
index :: (Direction, Direction) -> Direction -> Int
index (Direction
lower, Direction
upper) (MkDirection Ordering
xDirection Ordering
yDirection) = Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Direction
lower Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Direction
upper Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
forall a. Bounded a => a
maxBound) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ case Ordering
xDirection of
Ordering
LT -> case Ordering
yDirection of
Ordering
LT -> Int
0
Ordering
EQ -> Int
1
Ordering
GT -> Int
2
Ordering
EQ -> case Ordering
yDirection of
Ordering
LT -> Int
3
Ordering
EQ -> Exception -> Int
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Int) -> Exception -> Int
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkResultUndefined String
"BishBosh.Attribute.Direction.index:\tundefined direction."
Ordering
GT -> Int
4
Ordering
GT -> case Ordering
yDirection of
Ordering
LT -> Int
5
Ordering
EQ -> Int
6
Ordering
GT -> Int
7
mkDirection
:: Ordering
-> Ordering
-> Direction
mkDirection :: Ordering -> Ordering -> Direction
mkDirection Ordering
EQ Ordering
EQ = Exception -> Direction
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Direction) -> Exception -> Direction
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkResultUndefined String
"BishBosh.Attribute.Direction.mkDirection:\till-defined."
mkDirection Ordering
xDirection Ordering
yDirection = Ordering -> Ordering -> Direction
MkDirection Ordering
xDirection Ordering
yDirection
parallels :: [Direction]
parallels :: [Direction]
parallels = [Direction
w, Direction
s, Direction
n, Direction
e]
diagonals :: [Direction]
diagonals :: [Direction]
diagonals = [Direction
sw, Direction
nw, Direction
se, Direction
ne]
range :: [Direction]
range :: [Direction]
range = [Direction
sw, Direction
w, Direction
nw, Direction
s, Direction
n, Direction
se, Direction
e, Direction
ne]
nDistinctDirections :: NDirections
nDistinctDirections :: Int
nDistinctDirections = [Direction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Direction]
range
opposites :: [(Direction, Direction)]
opposites :: [(Direction, Direction)]
opposites = (Direction -> (Direction, Direction))
-> [Direction] -> [(Direction, Direction)]
forall a b. (a -> b) -> [a] -> [b]
map (Direction -> Direction
forall a. a -> a
id (Direction -> Direction)
-> (Direction -> Direction) -> Direction -> (Direction, Direction)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Direction -> Direction
forall a. Opposable a => a -> a
Property.Opposable.getOpposite) [Direction
sw, Direction
w, Direction
nw, Direction
s]
advanceDirection :: Attribute.LogicalColour.LogicalColour -> Ordering
advanceDirection :: LogicalColour -> Ordering
advanceDirection LogicalColour
Attribute.LogicalColour.Black = Ordering
LT
advanceDirection LogicalColour
_ = Ordering
GT
attackDirectionsForPawn :: Attribute.LogicalColour.LogicalColour -> [Direction]
attackDirectionsForPawn :: LogicalColour -> [Direction]
attackDirectionsForPawn LogicalColour
logicalColour = (Ordering -> Direction) -> [Ordering] -> [Direction]
forall a b. (a -> b) -> [a] -> [b]
map (Ordering -> Ordering -> Direction
`MkDirection` LogicalColour -> Ordering
advanceDirection LogicalColour
logicalColour) [Ordering
LT, Ordering
GT]
areAligned :: Direction -> Direction -> Bool
areAligned :: Direction -> Direction -> Bool
areAligned Direction
direction = (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||) ((Bool, Bool) -> Bool)
-> (Direction -> (Bool, Bool)) -> Direction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
direction) (Direction -> Bool)
-> (Direction -> Bool) -> Direction -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction -> Direction
forall a. Opposable a => a -> a
Property.Opposable.getOpposite Direction
direction))
type ByDirection = Data.Array.IArray.Array Direction
listArrayByDirection :: Data.Array.IArray.IArray a e => [e] -> a Direction e
listArrayByDirection :: [e] -> a Direction e
listArrayByDirection = (Direction, Direction) -> [e] -> a Direction e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
Data.Array.IArray.listArray (Direction
forall a. Bounded a => a
minBound, Direction
forall a. Bounded a => a
maxBound)