{-# Language OverloadedStrings #-}
{-# Language DefaultSignatures #-}
module Ipe.PathParser
( Coordinate(..)
, readCoordinate, readPoint
, readMatrix, readRectangle
, runParser
, readPathOperations
, pOperation, pPoint, pCoordinate
) where
import Data.Bifunctor
import Data.Char (isSpace)
import Data.Ext (ext)
import Data.Functor (($>))
import Data.Geometry.Box
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 Ipe.ParserPrimitives
import Ipe.Path (Operation(..))
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'
, 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
'c'
, [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 -> Operation r -> Parser (Operation r)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Operation r
forall r. Operation r
ClosePath
, 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'
, 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] -> 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'
]
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"