module BishBosh.Notation.Notation(
CoordinatePairI,
Notation(
getMinC,
getMaxC,
getOrigin,
getOriginOffset
),
encode,
mkMaybeCoordinates,
showsCoordinates,
readsCoordinates,
mkNotation,
inXRange,
inYRange
) where
import Control.Arrow((&&&), (***))
import qualified BishBosh.Cartesian.Abscissa as Cartesian.Abscissa
import qualified BishBosh.Cartesian.Coordinates as Cartesian.Coordinates
import qualified BishBosh.Cartesian.Ordinate as Cartesian.Ordinate
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Type.Length as Type.Length
import qualified Control.Exception
import qualified Data.Char
import qualified Data.List.Extra
import qualified Data.Maybe
type CoordinatePairC = (Char, Char)
type CoordinatePairI = (Type.Length.X, Type.Length.Y)
data Notation = MkNotation {
Notation -> CoordinatePairC
getMinC :: CoordinatePairC,
Notation -> CoordinatePairC
getMaxC :: CoordinatePairC,
Notation -> CoordinatePairI
getOrigin :: CoordinatePairI,
Notation -> CoordinatePairI
getOriginOffset :: CoordinatePairI
}
mkNotation :: CoordinatePairC -> Notation
mkNotation :: CoordinatePairC -> Notation
mkNotation CoordinatePairC
pair
| Bool -> Bool
not (Bool -> Bool) -> ((Bool, Bool) -> Bool) -> (Bool, Bool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool) -> (Bool, Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool
ok (Char -> Bool) -> (Char -> Bool) -> CoordinatePairC -> (Bool, Bool)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Char -> Bool
ok) CoordinatePairC
pair = Exception -> Notation
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Notation) -> Exception -> Notation
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkInvalidDatum String
"BishBosh.Notation.Notation.mkNotation:\tASCII character required."
| Bool
otherwise = Notation
notation
where
ok :: Char -> Bool
ok = (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool) -> (Char -> (Bool, Bool)) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool
Data.Char.isAscii (Char -> Bool) -> (Char -> Bool) -> Char -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Char -> Bool
Data.Char.isAlphaNum)
notation :: Notation
notation = MkNotation :: CoordinatePairC
-> CoordinatePairC
-> CoordinatePairI
-> CoordinatePairI
-> Notation
MkNotation {
getMinC :: CoordinatePairC
getMinC = CoordinatePairC
pair,
getMaxC :: CoordinatePairC
getMaxC = (
X -> Char
Data.Char.chr (X -> Char) -> (X -> X) -> X -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> X
forall a b. (Integral a, Num b) => a -> b
fromIntegral (X -> X) -> (X -> X) -> X -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
X -> X -> X
forall a. Num a => a -> a -> a
+ X -> X
forall a. Enum a => a -> a
pred X
Cartesian.Abscissa.xLength
) (X -> Char) -> (X -> Char) -> CoordinatePairI -> CoordinatePairC
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** X -> Char
Data.Char.chr (X -> Char) -> (X -> X) -> X -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> X
forall a b. (Integral a, Num b) => a -> b
fromIntegral (X -> X) -> (X -> X) -> X -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
X -> X -> X
forall a. Num a => a -> a -> a
+ X -> X
forall a. Enum a => a -> a
pred X
Cartesian.Ordinate.yLength
)
) (CoordinatePairI -> CoordinatePairC)
-> CoordinatePairI -> CoordinatePairC
forall a b. (a -> b) -> a -> b
$ Notation -> CoordinatePairI
getOrigin Notation
notation,
getOrigin :: CoordinatePairI
getOrigin = (
X -> X
forall a b. (Integral a, Num b) => a -> b
fromIntegral (X -> X) -> (Char -> X) -> Char -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> X
Data.Char.ord (Char -> X) -> (Char -> X) -> CoordinatePairC -> CoordinatePairI
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** X -> X
forall a b. (Integral a, Num b) => a -> b
fromIntegral (X -> X) -> (Char -> X) -> Char -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> X
Data.Char.ord
) (CoordinatePairC -> CoordinatePairI)
-> CoordinatePairC -> CoordinatePairI
forall a b. (a -> b) -> a -> b
$ Notation -> CoordinatePairC
getMinC Notation
notation,
getOriginOffset :: CoordinatePairI
getOriginOffset = (
(X
Cartesian.Abscissa.xMin X -> X -> X
forall a. Num a => a -> a -> a
-) (X -> X) -> (X -> X) -> CoordinatePairI -> CoordinatePairI
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (X
Cartesian.Ordinate.yMin X -> X -> X
forall a. Num a => a -> a -> a
-)
) (CoordinatePairI -> CoordinatePairI)
-> CoordinatePairI -> CoordinatePairI
forall a b. (a -> b) -> a -> b
$ Notation -> CoordinatePairI
getOrigin Notation
notation
}
inXRange :: Notation -> Char -> Bool
inXRange :: Notation -> Char -> Bool
inXRange Notation
notation Char
c = (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool) -> (Bool, Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ ((Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c) (Char -> Bool) -> (Notation -> Char) -> Notation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoordinatePairC -> Char
forall a b. (a, b) -> a
fst (CoordinatePairC -> Char)
-> (Notation -> CoordinatePairC) -> Notation -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Notation -> CoordinatePairC
getMinC (Notation -> Bool)
-> (Notation -> Bool) -> Notation -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
c) (Char -> Bool) -> (Notation -> Char) -> Notation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoordinatePairC -> Char
forall a b. (a, b) -> a
fst (CoordinatePairC -> Char)
-> (Notation -> CoordinatePairC) -> Notation -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Notation -> CoordinatePairC
getMaxC) Notation
notation
inYRange :: Notation -> Char -> Bool
inYRange :: Notation -> Char -> Bool
inYRange Notation
notation Char
c = (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool) -> (Bool, Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ ((Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c) (Char -> Bool) -> (Notation -> Char) -> Notation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoordinatePairC -> Char
forall a b. (a, b) -> b
snd (CoordinatePairC -> Char)
-> (Notation -> CoordinatePairC) -> Notation -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Notation -> CoordinatePairC
getMinC (Notation -> Bool)
-> (Notation -> Bool) -> Notation -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
c) (Char -> Bool) -> (Notation -> Char) -> Notation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoordinatePairC -> Char
forall a b. (a, b) -> b
snd (CoordinatePairC -> Char)
-> (Notation -> CoordinatePairC) -> Notation -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Notation -> CoordinatePairC
getMaxC) Notation
notation
inRange :: Notation -> CoordinatePairC -> Bool
inRange :: Notation -> CoordinatePairC -> Bool
inRange Notation
notation = (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool)
-> (CoordinatePairC -> (Bool, Bool)) -> CoordinatePairC -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
(Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool) -> (Char -> (Bool, Bool)) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
(Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
xMinC) (Char -> Bool) -> (Char -> Bool) -> Char -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
xMaxC)
) (Char -> Bool) -> (Char -> Bool) -> CoordinatePairC -> (Bool, Bool)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool) -> (Char -> (Bool, Bool)) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
(Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
yMinC) (Char -> Bool) -> (Char -> Bool) -> Char -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
yMaxC)
)
) where
((Char
xMinC, Char
yMinC), (Char
xMaxC, Char
yMaxC)) = Notation -> CoordinatePairC
getMinC (Notation -> CoordinatePairC)
-> (Notation -> CoordinatePairC)
-> Notation
-> (CoordinatePairC, CoordinatePairC)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Notation -> CoordinatePairC
getMaxC (Notation -> (CoordinatePairC, CoordinatePairC))
-> Notation -> (CoordinatePairC, CoordinatePairC)
forall a b. (a -> b) -> a -> b
$ Notation
notation
encode :: Notation -> Cartesian.Coordinates.Coordinates -> (ShowS, ShowS)
encode :: Notation -> Coordinates -> (ShowS, ShowS)
encode Notation
notation = Char -> ShowS
showChar (Char -> ShowS) -> (Coordinates -> Char) -> Coordinates -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> Char
Data.Char.chr (X -> Char) -> (Coordinates -> X) -> Coordinates -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> X
forall a b. (Integral a, Num b) => a -> b
fromIntegral (X -> X) -> (Coordinates -> X) -> Coordinates -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> X -> X
forall a. Num a => a -> a -> a
subtract X
xOriginOffset (X -> X) -> (Coordinates -> X) -> Coordinates -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates -> X
Cartesian.Coordinates.getX (Coordinates -> ShowS)
-> (Coordinates -> ShowS) -> Coordinates -> (ShowS, ShowS)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Char -> ShowS
showChar (Char -> ShowS) -> (Coordinates -> Char) -> Coordinates -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> Char
Data.Char.chr (X -> Char) -> (Coordinates -> X) -> Coordinates -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> X
forall a b. (Integral a, Num b) => a -> b
fromIntegral (X -> X) -> (Coordinates -> X) -> Coordinates -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> X -> X
forall a. Num a => a -> a -> a
subtract X
yOriginOffset (X -> X) -> (Coordinates -> X) -> Coordinates -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates -> X
Cartesian.Coordinates.getY where
(X
xOriginOffset, X
yOriginOffset) = Notation -> CoordinatePairI
getOriginOffset Notation
notation
mkMaybeCoordinates :: Notation -> CoordinatePairC -> Maybe Cartesian.Coordinates.Coordinates
mkMaybeCoordinates :: Notation -> CoordinatePairC -> Maybe Coordinates
mkMaybeCoordinates Notation
notation CoordinatePairC
pair
| Notation -> CoordinatePairC -> Bool
inRange Notation
notation CoordinatePairC
pair = (X -> X -> Maybe Coordinates)
-> CoordinatePairI -> Maybe Coordinates
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry X -> X -> Maybe Coordinates
Cartesian.Coordinates.mkMaybeCoordinates (CoordinatePairI -> Maybe Coordinates)
-> CoordinatePairI -> Maybe Coordinates
forall a b. (a -> b) -> a -> b
$ (
(X -> X -> X
forall a. Num a => a -> a -> a
+ X
xOriginOffset) (X -> X) -> (Char -> X) -> Char -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> X
forall a b. (Integral a, Num b) => a -> b
fromIntegral (X -> X) -> (Char -> X) -> Char -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> X
Data.Char.ord (Char -> X) -> (Char -> X) -> CoordinatePairC -> CoordinatePairI
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (X -> X -> X
forall a. Num a => a -> a -> a
+ X
yOriginOffset) (X -> X) -> (Char -> X) -> Char -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> X
forall a b. (Integral a, Num b) => a -> b
fromIntegral (X -> X) -> (Char -> X) -> Char -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> X
Data.Char.ord
) CoordinatePairC
pair
| Bool
otherwise = Maybe Coordinates
forall a. Maybe a
Nothing
where
(X
xOriginOffset, X
yOriginOffset) = Notation -> CoordinatePairI
getOriginOffset Notation
notation
showsCoordinates :: Notation -> Cartesian.Coordinates.Coordinates -> ShowS
showsCoordinates :: Notation -> Coordinates -> ShowS
showsCoordinates Notation
notation = (ShowS -> ShowS -> ShowS) -> (ShowS, ShowS) -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ((ShowS, ShowS) -> ShowS)
-> (Coordinates -> (ShowS, ShowS)) -> Coordinates -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Notation -> Coordinates -> (ShowS, ShowS)
encode Notation
notation
readsCoordinates :: Notation -> ReadS Cartesian.Coordinates.Coordinates
readsCoordinates :: Notation -> ReadS Coordinates
readsCoordinates Notation
notation String
s = case ShowS
Data.List.Extra.trimStart String
s of
Char
x : Char
y : String
remainder
| Notation -> CoordinatePairC -> Bool
inRange Notation
notation CoordinatePairC
coordinatePairC -> (Coordinates -> (Coordinates, String))
-> [Coordinates] -> [(Coordinates, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Coordinates -> String -> (Coordinates, String))
-> String -> Coordinates -> (Coordinates, String)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) String
remainder) ([Coordinates] -> [(Coordinates, String)])
-> (Maybe Coordinates -> [Coordinates])
-> Maybe Coordinates
-> [(Coordinates, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Coordinates -> [Coordinates]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe Coordinates -> [(Coordinates, String)])
-> Maybe Coordinates -> [(Coordinates, String)]
forall a b. (a -> b) -> a -> b
$ Notation -> CoordinatePairC -> Maybe Coordinates
mkMaybeCoordinates Notation
notation CoordinatePairC
coordinatePairC
| Bool
otherwise -> []
where
coordinatePairC :: CoordinatePairC
coordinatePairC = (Char
x, Char
y)
String
_ -> []