{-# Language OverloadedStrings #-}
{-# Language DefaultSignatures #-}
module Data.Geometry.Ipe.PathParser where
import Data.Bifunctor
import Data.Char (isSpace)
import Data.Ext (ext)
import Data.Geometry.Box
import Data.Geometry.Ipe.ParserPrimitives
import Data.Geometry.Ipe.Path (Operation(..))
import Data.Geometry.Matrix
import Data.Geometry.Point
import Data.Geometry.Vector
import Data.Ratio
import Data.RealNumber.Rational
import Data.Text (Text)
import qualified Data.Text as T
import Text.Parsec.Error (messageString, errorMessages)
class Fractional r => Coordinate r where
fromSeq :: Integer -> Maybe (Int, Integer) -> r
default fromSeq :: (Ord r, Fractional r) => Integer -> Maybe (Int, Integer) -> r
fromSeq = Integer -> Maybe (Int, Integer) -> r
forall r.
(Ord r, Fractional r) =>
Integer -> Maybe (Int, Integer) -> r
defaultFromSeq
defaultFromSeq :: (Ord r, Fractional r)
=> Integer -> Maybe (Int, Integer) -> r
defaultFromSeq :: Integer -> Maybe (Int, Integer) -> r
defaultFromSeq Integer
x Maybe (Int, Integer)
Nothing = Integer -> r
forall a. Num a => Integer -> a
fromInteger Integer
x
defaultFromSeq Integer
x (Just (Int
l,Integer
y)) = let x' :: r
x' = Integer -> r
forall a. Num a => Integer -> a
fromInteger Integer
x
y' :: r
y' = Integer -> r
forall a. Num a => Integer -> a
fromInteger Integer
y
asDecimal :: r -> r
asDecimal r
a = r
a r -> r -> r
forall a. Num a => a -> a -> a
* (r
0.1 r -> Int -> r
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
l)
z :: r
z = if r
x' r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< r
0 then (-r
1) else r
1
in r
z r -> r -> r
forall a. Num a => a -> a -> a
* (r -> r
forall a. Num a => a -> a
abs r
x' r -> r -> r
forall a. Num a => a -> a -> a
+ r -> r
asDecimal r
y')
instance Coordinate Double
instance Coordinate Float
instance Coordinate (Ratio Integer)
instance Coordinate (RealNumber p)
readCoordinate :: Coordinate r => Text -> Either Text r
readCoordinate :: Text -> Either Text r
readCoordinate = Parser r -> Text -> Either Text r
forall a. Parser a -> Text -> Either Text a
runParser Parser r
forall r. Coordinate r => Parser r
pCoordinate
readPoint :: Coordinate r => Text -> Either Text (Point 2 r)
readPoint :: Text -> Either Text (Point 2 r)
readPoint = Parser (Point 2 r) -> Text -> Either Text (Point 2 r)
forall a. Parser a -> Text -> Either Text a
runParser Parser (Point 2 r)
forall r. Coordinate r => Parser (Point 2 r)
pPoint
runParser :: Parser a -> Text -> Either Text a
runParser :: Parser a -> Text -> Either Text a
runParser Parser a
p = (ParseError -> Text)
-> ((a, Text) -> a) -> Either ParseError (a, Text) -> Either Text a
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ParseError -> Text
errorText (a, Text) -> a
forall a b. (a, b) -> a
fst (Either ParseError (a, Text) -> Either Text a)
-> (Text -> Either ParseError (a, Text)) -> Text -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Text -> Either ParseError (a, Text)
forall a. Parser a -> Text -> Either ParseError (a, Text)
runP Parser a
p
data Either' l r = Left' l | Right' r deriving (Int -> Either' l r -> ShowS
[Either' l r] -> ShowS
Either' l r -> String
(Int -> Either' l r -> ShowS)
-> (Either' l r -> String)
-> ([Either' l r] -> ShowS)
-> Show (Either' l r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall l r. (Show l, Show r) => Int -> Either' l r -> ShowS
forall l r. (Show l, Show r) => [Either' l r] -> ShowS
forall l r. (Show l, Show r) => Either' l r -> String
showList :: [Either' l r] -> ShowS
$cshowList :: forall l r. (Show l, Show r) => [Either' l r] -> ShowS
show :: Either' l r -> String
$cshow :: forall l r. (Show l, Show r) => Either' l r -> String
showsPrec :: Int -> Either' l r -> ShowS
$cshowsPrec :: forall l r. (Show l, Show r) => Int -> Either' l r -> ShowS
Show,Either' l r -> Either' l r -> Bool
(Either' l r -> Either' l r -> Bool)
-> (Either' l r -> Either' l r -> Bool) -> Eq (Either' l r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall l r. (Eq l, Eq r) => Either' l r -> Either' l r -> Bool
/= :: Either' l r -> Either' l r -> Bool
$c/= :: forall l r. (Eq l, Eq r) => Either' l r -> Either' l r -> Bool
== :: Either' l r -> Either' l r -> Bool
$c== :: forall l r. (Eq l, Eq r) => Either' l r -> Either' l r -> Bool
Eq)
instance (Semigroup l, Semigroup r) => Semigroup (Either' l r) where
(Left' l
l) <> :: Either' l r -> Either' l r -> Either' l r
<> (Left' l
l') = l -> Either' l r
forall l r. l -> Either' l r
Left' (l -> Either' l r) -> l -> Either' l r
forall a b. (a -> b) -> a -> b
$ l
l l -> l -> l
forall a. Semigroup a => a -> a -> a
<> l
l'
(Left' l
l) <> Either' l r
_ = l -> Either' l r
forall l r. l -> Either' l r
Left' l
l
Either' l r
_ <> (Left' l
l') = l -> Either' l r
forall l r. l -> Either' l r
Left' l
l'
(Right' r
r) <> (Right' r
r') = r -> Either' l r
forall l r. r -> Either' l r
Right' (r -> Either' l r) -> r -> Either' l r
forall a b. (a -> b) -> a -> b
$ r
r r -> r -> r
forall a. Semigroup a => a -> a -> a
<> r
r'
instance (Semigroup l, Semigroup r, Monoid r) => Monoid (Either' l r) where
mempty :: Either' l r
mempty = r -> Either' l r
forall l r. r -> Either' l r
Right' r
forall a. Monoid a => a
mempty
mappend :: Either' l r -> Either' l r -> Either' l r
mappend = Either' l r -> Either' l r -> Either' l r
forall a. Semigroup a => a -> a -> a
(<>)
either' :: (l -> a) -> (r -> a) -> Either' l r -> a
either' :: (l -> a) -> (r -> a) -> Either' l r -> a
either' l -> a
lf r -> a
_ (Left' l
l) = l -> a
lf l
l
either' l -> a
_ r -> a
rf (Right' r
r) = r -> a
rf r
r
readPathOperations :: Coordinate r => Text -> Either Text [Operation r]
readPathOperations :: Text -> Either Text [Operation r]
readPathOperations = Either' [ParseError] [Operation r] -> Either Text [Operation r]
forall b. Either' [ParseError] b -> Either Text b
unWrap (Either' [ParseError] [Operation r] -> Either Text [Operation r])
-> (Text -> Either' [ParseError] [Operation r])
-> Text
-> Either Text [Operation r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either' [ParseError] [Operation r]]
-> Either' [ParseError] [Operation r]
forall a. Monoid a => [a] -> a
mconcat ([Either' [ParseError] [Operation r]]
-> Either' [ParseError] [Operation r])
-> (Text -> [Either' [ParseError] [Operation r]])
-> Text
-> Either' [ParseError] [Operation r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either' [ParseError] [Operation r])
-> [Text] -> [Either' [ParseError] [Operation r]]
forall a b. (a -> b) -> [a] -> [b]
map (Either ParseError (Operation r, Text)
-> Either' [ParseError] [Operation r]
forall a a b. Either a (a, b) -> Either' [a] [a]
wrap (Either ParseError (Operation r, Text)
-> Either' [ParseError] [Operation r])
-> (Text -> Either ParseError (Operation r, Text))
-> Text
-> Either' [ParseError] [Operation r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Operation r)
-> Text -> Either ParseError (Operation r, Text)
forall a. Parser a -> Text -> Either ParseError (a, Text)
runP Parser (Operation r)
forall r. Coordinate r => Parser (Operation r)
pOperation)
([Text] -> [Either' [ParseError] [Operation r]])
-> (Text -> [Text]) -> Text -> [Either' [ParseError] [Operation r]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
clean ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> [Text]
splitKeepDelims String
"mlcqeasuh"
where
unWrap :: Either' [ParseError] b -> Either Text b
unWrap = ([ParseError] -> Either Text b)
-> (b -> Either Text b) -> Either' [ParseError] b -> Either Text b
forall l a r. (l -> a) -> (r -> a) -> Either' l r -> a
either' (Text -> Either Text b
forall a b. a -> Either a b
Left (Text -> Either Text b)
-> ([ParseError] -> Text) -> [ParseError] -> Either Text b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParseError] -> Text
combineErrors) b -> Either Text b
forall a b. b -> Either a b
Right
wrap :: Either a (a, b) -> Either' [a] [a]
wrap = (a -> Either' [a] [a])
-> ((a, b) -> Either' [a] [a])
-> Either a (a, b)
-> Either' [a] [a]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([a] -> Either' [a] [a]
forall l r. l -> Either' l r
Left' ([a] -> Either' [a] [a]) -> (a -> [a]) -> a -> Either' [a] [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[])) ([a] -> Either' [a] [a]
forall l r. r -> Either' l r
Right' ([a] -> Either' [a] [a])
-> ((a, b) -> [a]) -> (a, b) -> Either' [a] [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[]) (a -> [a]) -> ((a, b) -> a) -> (a, b) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst)
trim :: Text -> Text
trim = (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isSpace
clean :: [Text] -> [Text]
clean = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
trim
errorText :: ParseError -> Text
errorText :: ParseError -> Text
errorText = String -> Text
T.pack (String -> Text) -> (ParseError -> String) -> ParseError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String)
-> (ParseError -> [String]) -> ParseError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Message -> String) -> [Message] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Message -> String
messageString ([Message] -> [String])
-> (ParseError -> [Message]) -> ParseError -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> [Message]
errorMessages
combineErrors :: [ParseError] -> Text
combineErrors :: [ParseError] -> Text
combineErrors = [Text] -> Text
T.unlines ([Text] -> Text)
-> ([ParseError] -> [Text]) -> [ParseError] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseError -> Text) -> [ParseError] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ParseError -> Text
errorText
splitKeepDelims :: [Char] -> Text -> [Text]
splitKeepDelims :: String -> Text -> [Text]
splitKeepDelims String
delims Text
t = [Text] -> ((Char, Text) -> [Text]) -> Maybe (Char, Text) -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Text]
mPref (Char, Text) -> [Text]
continue (Maybe (Char, Text) -> [Text]) -> Maybe (Char, Text) -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Char, Text)
T.uncons Text
rest
where
mPref :: [Text]
mPref = if Text -> Bool
T.null Text
pref then [] else [Text
pref]
(Text
pref,Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
delims) Text
t
continue :: (Char, Text) -> [Text]
continue (Char
c,Text
t') = Text
pref Text -> Char -> Text
`T.snoc` Char
c Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: String -> Text -> [Text]
splitKeepDelims String
delims Text
t'
readMatrix :: Coordinate r => Text -> Either Text (Matrix 3 3 r)
readMatrix :: Text -> Either Text (Matrix 3 3 r)
readMatrix = Parser (Matrix 3 3 r) -> Text -> Either Text (Matrix 3 3 r)
forall a. Parser a -> Text -> Either Text a
runParser Parser (Matrix 3 3 r)
forall r. Coordinate r => Parser (Matrix 3 3 r)
pMatrix
readRectangle :: Coordinate r => Text -> Either Text (Rectangle () r)
readRectangle :: Text -> Either Text (Rectangle () r)
readRectangle = Parser (Rectangle () r) -> Text -> Either Text (Rectangle () r)
forall a. Parser a -> Text -> Either Text a
runParser Parser (Rectangle () r)
forall r. Coordinate r => Parser (Rectangle () r)
pRectangle
pOperation :: forall r. Coordinate r => Parser (Operation r)
pOperation :: Parser (Operation r)
pOperation = [Parser (Operation r)] -> Parser (Operation r)
forall a. [Parser a] -> Parser a
pChoice [ Point 2 r -> Operation r
forall r. Point 2 r -> Operation r
MoveTo (Point 2 r -> Operation r)
-> ParsecT Text () Identity (Point 2 r) -> Parser (Operation r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (Point 2 r)
forall r. Coordinate r => Parser (Point 2 r)
pPoint ParsecT Text () Identity (Point 2 r)
-> Char -> ParsecT Text () Identity (Point 2 r)
forall b.
ParsecT Text () Identity b -> Char -> ParsecT Text () Identity b
*>> Char
'm'
, Point 2 r -> Operation r
forall r. Point 2 r -> Operation r
LineTo (Point 2 r -> Operation r)
-> ParsecT Text () Identity (Point 2 r) -> Parser (Operation r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (Point 2 r)
forall r. Coordinate r => Parser (Point 2 r)
pPoint ParsecT Text () Identity (Point 2 r)
-> Char -> ParsecT Text () Identity (Point 2 r)
forall b.
ParsecT Text () Identity b -> Char -> ParsecT Text () Identity b
*>> Char
'l'
, Point 2 r -> Point 2 r -> Point 2 r -> Operation r
forall r. Point 2 r -> Point 2 r -> Point 2 r -> Operation r
CurveTo (Point 2 r -> Point 2 r -> Point 2 r -> Operation r)
-> ParsecT Text () Identity (Point 2 r)
-> ParsecT Text () Identity (Point 2 r -> Point 2 r -> Operation r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (Point 2 r)
forall r. Coordinate r => Parser (Point 2 r)
pPoint ParsecT Text () Identity (Point 2 r -> Point 2 r -> Operation r)
-> ParsecT Text () Identity (Point 2 r)
-> ParsecT Text () Identity (Point 2 r -> Operation r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity (Point 2 r)
pPoint' ParsecT Text () Identity (Point 2 r -> Operation r)
-> ParsecT Text () Identity (Point 2 r) -> Parser (Operation r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity (Point 2 r)
pPoint' ParsecT Text () Identity (Point 2 r)
-> Char -> ParsecT Text () Identity (Point 2 r)
forall b.
ParsecT Text () Identity b -> Char -> ParsecT Text () Identity b
*>> Char
'c'
, Point 2 r -> Point 2 r -> Operation r
forall r. Point 2 r -> Point 2 r -> Operation r
QCurveTo (Point 2 r -> Point 2 r -> Operation r)
-> ParsecT Text () Identity (Point 2 r)
-> ParsecT Text () Identity (Point 2 r -> Operation r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (Point 2 r)
forall r. Coordinate r => Parser (Point 2 r)
pPoint ParsecT Text () Identity (Point 2 r -> Operation r)
-> ParsecT Text () Identity (Point 2 r) -> Parser (Operation r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity (Point 2 r)
pPoint' ParsecT Text () Identity (Point 2 r)
-> Char -> ParsecT Text () Identity (Point 2 r)
forall b.
ParsecT Text () Identity b -> Char -> ParsecT Text () Identity b
*>> Char
'q'
, Matrix 3 3 r -> Operation r
forall r. Matrix 3 3 r -> Operation r
Ellipse (Matrix 3 3 r -> Operation r)
-> ParsecT Text () Identity (Matrix 3 3 r) -> Parser (Operation r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (Matrix 3 3 r)
forall r. Coordinate r => Parser (Matrix 3 3 r)
pMatrix ParsecT Text () Identity (Matrix 3 3 r)
-> Char -> ParsecT Text () Identity (Matrix 3 3 r)
forall b.
ParsecT Text () Identity b -> Char -> ParsecT Text () Identity b
*>> Char
'e'
, Matrix 3 3 r -> Point 2 r -> Operation r
forall r. Matrix 3 3 r -> Point 2 r -> Operation r
ArcTo (Matrix 3 3 r -> Point 2 r -> Operation r)
-> ParsecT Text () Identity (Matrix 3 3 r)
-> ParsecT Text () Identity (Point 2 r -> Operation r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (Matrix 3 3 r)
forall r. Coordinate r => Parser (Matrix 3 3 r)
pMatrix ParsecT Text () Identity (Point 2 r -> Operation r)
-> ParsecT Text () Identity (Point 2 r) -> Parser (Operation r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity (Point 2 r)
pPoint' ParsecT Text () Identity (Point 2 r)
-> Char -> ParsecT Text () Identity (Point 2 r)
forall b.
ParsecT Text () Identity b -> Char -> ParsecT Text () Identity b
*>> Char
'a'
, [Point 2 r] -> Operation r
forall r. [Point 2 r] -> Operation r
Spline ([Point 2 r] -> Operation r)
-> ParsecT Text () Identity [Point 2 r] -> Parser (Operation r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (Point 2 r)
forall r. Coordinate r => Parser (Point 2 r)
pPoint ParsecT Text () Identity (Point 2 r)
-> Parser String -> ParsecT Text () Identity [Point 2 r]
forall a b. Parser a -> Parser b -> Parser [a]
`pSepBy` Parser String
pWhiteSpace ParsecT Text () Identity [Point 2 r]
-> Char -> ParsecT Text () Identity [Point 2 r]
forall b.
ParsecT Text () Identity b -> Char -> ParsecT Text () Identity b
*>> Char
's'
, [Point 2 r] -> Operation r
forall r. [Point 2 r] -> Operation r
ClosedSpline ([Point 2 r] -> Operation r)
-> ParsecT Text () Identity [Point 2 r] -> Parser (Operation r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (Point 2 r)
forall r. Coordinate r => Parser (Point 2 r)
pPoint ParsecT Text () Identity (Point 2 r)
-> Parser String -> ParsecT Text () Identity [Point 2 r]
forall a b. Parser a -> Parser b -> Parser [a]
`pSepBy` Parser String
pWhiteSpace ParsecT Text () Identity [Point 2 r]
-> Char -> ParsecT Text () Identity [Point 2 r]
forall b.
ParsecT Text () Identity b -> Char -> ParsecT Text () Identity b
*>> Char
'u'
, Char -> Parser Char
pChar Char
'h' Parser Char -> Parser (Operation r) -> Parser (Operation r)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Operation r -> Parser (Operation r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Operation r
forall r. Operation r
ClosePath
]
where
pPoint' :: ParsecT Text () Identity (Point 2 r)
pPoint' = Parser String
pWhiteSpace Parser String
-> ParsecT Text () Identity (Point 2 r)
-> ParsecT Text () Identity (Point 2 r)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity (Point 2 r)
forall r. Coordinate r => Parser (Point 2 r)
pPoint
ParsecT Text () Identity b
p *>> :: ParsecT Text () Identity b -> Char -> ParsecT Text () Identity b
*>> Char
c = ParsecT Text () Identity b
p ParsecT Text () Identity b
-> Parser Char -> ParsecT Text () Identity b
forall s (m :: * -> *) t u b a.
(Stream s m t, Reversable s) =>
ParsecT s u m b -> ParsecT s u m a -> ParsecT s u m b
<*>< Parser String
pWhiteSpace Parser String -> Parser Char -> Parser Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
***> Char -> Parser Char
pChar Char
c
pPoint :: Coordinate r => Parser (Point 2 r)
pPoint :: Parser (Point 2 r)
pPoint = r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 (r -> r -> Point 2 r)
-> ParsecT Text () Identity r
-> ParsecT Text () Identity (r -> Point 2 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity r
forall r. Coordinate r => Parser r
pCoordinate ParsecT Text () Identity (r -> Point 2 r)
-> Parser String -> ParsecT Text () Identity (r -> Point 2 r)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
pWhiteSpace ParsecT Text () Identity (r -> Point 2 r)
-> ParsecT Text () Identity r -> Parser (Point 2 r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity r
forall r. Coordinate r => Parser r
pCoordinate
pCoordinate :: Coordinate r => Parser r
pCoordinate :: Parser r
pCoordinate = Integer -> Maybe (Int, Integer) -> r
forall r. Coordinate r => Integer -> Maybe (Int, Integer) -> r
fromSeq (Integer -> Maybe (Int, Integer) -> r)
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity (Maybe (Int, Integer) -> r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Integer
pInteger ParsecT Text () Identity (Maybe (Int, Integer) -> r)
-> ParsecT Text () Identity (Maybe (Int, Integer)) -> Parser r
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity (Maybe (Int, Integer))
pDecimal
where
pDecimal :: ParsecT Text () Identity (Maybe (Int, Integer))
pDecimal = Parser (Int, Integer)
-> ParsecT Text () Identity (Maybe (Int, Integer))
forall a. Parser a -> Parser (Maybe a)
pMaybe (Char -> Parser Char
pChar Char
'.' Parser Char -> Parser (Int, Integer) -> Parser (Int, Integer)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Int, Integer)
pPaddedNatural)
pRectangle :: Coordinate r => Parser (Rectangle () r)
pRectangle :: Parser (Rectangle () r)
pRectangle = (\Point 2 r
p Point 2 r
q -> (Point 2 r :+ ()) -> (Point 2 r :+ ()) -> Rectangle () r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> Box d p r
box (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
p) (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
q)) (Point 2 r -> Point 2 r -> Rectangle () r)
-> ParsecT Text () Identity (Point 2 r)
-> ParsecT Text () Identity (Point 2 r -> Rectangle () r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (Point 2 r)
forall r. Coordinate r => Parser (Point 2 r)
pPoint
ParsecT Text () Identity (Point 2 r -> Rectangle () r)
-> Parser String
-> ParsecT Text () Identity (Point 2 r -> Rectangle () r)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
pWhiteSpace
ParsecT Text () Identity (Point 2 r -> Rectangle () r)
-> ParsecT Text () Identity (Point 2 r) -> Parser (Rectangle () r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity (Point 2 r)
forall r. Coordinate r => Parser (Point 2 r)
pPoint
pMatrix :: Coordinate r => Parser (Matrix 3 3 r)
pMatrix :: Parser (Matrix 3 3 r)
pMatrix = (\r
a [r]
b -> [r] -> Matrix 3 3 r
forall r. Coordinate r => [r] -> Matrix 3 3 r
mkMatrix (r
ar -> [r] -> [r]
forall a. a -> [a] -> [a]
:[r]
b)) (r -> [r] -> Matrix 3 3 r)
-> ParsecT Text () Identity r
-> ParsecT Text () Identity ([r] -> Matrix 3 3 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity r
forall r. Coordinate r => Parser r
pCoordinate
ParsecT Text () Identity ([r] -> Matrix 3 3 r)
-> ParsecT Text () Identity [r] -> Parser (Matrix 3 3 r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ParsecT Text () Identity r -> ParsecT Text () Identity [r]
forall a. Int -> Parser a -> Parser [a]
pCount Int
5 (Parser String
pWhiteSpace Parser String
-> ParsecT Text () Identity r -> ParsecT Text () Identity r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity r
forall r. Coordinate r => Parser r
pCoordinate)
mkMatrix :: Coordinate r => [r] -> Matrix 3 3 r
mkMatrix :: [r] -> Matrix 3 3 r
mkMatrix [r
a,r
b,r
c,r
d,r
e,r
f] = Vector 3 (Vector 3 r) -> Matrix 3 3 r
forall (n :: Nat) (m :: Nat) r.
Vector n (Vector m r) -> Matrix n m r
Matrix (Vector 3 (Vector 3 r) -> Matrix 3 3 r)
-> Vector 3 (Vector 3 r) -> Matrix 3 3 r
forall a b. (a -> b) -> a -> b
$ Vector 3 r -> Vector 3 r -> Vector 3 r -> Vector 3 (Vector 3 r)
forall r. r -> r -> r -> Vector 3 r
Vector3 (r -> r -> r -> Vector 3 r
forall r. r -> r -> r -> Vector 3 r
Vector3 r
a r
c r
e)
(r -> r -> r -> Vector 3 r
forall r. r -> r -> r -> Vector 3 r
Vector3 r
b r
d r
f)
(r -> r -> r -> Vector 3 r
forall r. r -> r -> r -> Vector 3 r
Vector3 r
0 r
0 r
1)
mkMatrix [r]
_ = String -> Matrix 3 3 r
forall a. HasCallStack => String -> a
error String
"mkMatrix: need exactly 6 arguments"