{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Diagrams.TwoD.Path.Metafont.Parser
(metafontParser) where
import Text.Parsec
import Text.Parsec.Text
import Diagrams.Prelude hiding (option)
import Diagrams.TwoD.Path.Metafont.Types
num :: Read n => Parser n
num :: forall n. Read n => Parser n
num = String -> n
forall a. Read a => String -> a
read (String -> n)
-> ParsecT Text () Identity String -> ParsecT Text () Identity n
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity String
forall {u}. ParsecT Text u Identity String
float where
sign :: ParsecT Text u Identity String
sign = ParsecT Text u Identity String
forall {u}. ParsecT Text u Identity String
plus ParsecT Text u Identity String
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text u Identity String
forall {u}. ParsecT Text u Identity String
minus ParsecT Text u Identity String
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text u Identity String
forall {u}. ParsecT Text u Identity String
unsigned
plus :: ParsecT Text u Identity String
plus = Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' ParsecT Text u Identity Char
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall a b.
ParsecT Text u Identity a
-> ParsecT Text u Identity b -> ParsecT Text u Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text u Identity String
forall {u}. ParsecT Text u Identity String
unsigned
minus :: ParsecT Text u Identity String
minus = (:) (Char -> String -> String)
-> ParsecT Text u Identity Char
-> ParsecT Text u Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT Text u Identity (String -> String)
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall a b.
ParsecT Text u Identity (a -> b)
-> ParsecT Text u Identity a -> ParsecT Text u Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text u Identity String
forall {u}. ParsecT Text u Identity String
unsigned
unsigned :: ParsecT Text u Identity String
unsigned = ParsecT Text u Identity Char -> ParsecT Text u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
decimal :: ParsecT Text u Identity String
decimal = String
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (ParsecT Text u Identity String -> ParsecT Text u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text u Identity String -> ParsecT Text u Identity String)
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall a b. (a -> b) -> a -> b
$ (:) (Char -> String -> String)
-> ParsecT Text u Identity Char
-> ParsecT Text u Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' ParsecT Text u Identity (String -> String)
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall a b.
ParsecT Text u Identity (a -> b)
-> ParsecT Text u Identity a -> ParsecT Text u Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text u Identity String
forall {u}. ParsecT Text u Identity String
unsigned)
float :: ParsecT Text u Identity String
float = String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String -> String -> String)
-> ParsecT Text u Identity String
-> ParsecT Text u Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text u Identity String
forall {u}. ParsecT Text u Identity String
sign ParsecT Text u Identity (String -> String)
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall a b.
ParsecT Text u Identity (a -> b)
-> ParsecT Text u Identity a -> ParsecT Text u Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text u Identity String
forall {u}. ParsecT Text u Identity String
decimal
xy :: Read n => Parser (n, n)
xy :: forall n. Read n => Parser (n, n)
xy = do
ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
n
x <- Parser n
forall n. Read n => Parser n
num
ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT Text () Identity ()
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',' ParsecT Text () Identity Char
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
n
y <- Parser n
forall n. Read n => Parser n
num
ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
(n, n) -> Parser (n, n)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (n
x,n
y)
pt :: Read n => Parser (P2 n)
pt :: forall n. Read n => Parser (P2 n)
pt = Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT Text () Identity Char
-> ParsecT Text () Identity (P2 n)
-> ParsecT Text () Identity (P2 n)
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((n, n) -> P2 n
forall n. (n, n) -> P2 n
p2 ((n, n) -> P2 n)
-> ParsecT Text () Identity (n, n)
-> ParsecT Text () Identity (P2 n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (n, n)
forall n. Read n => Parser (n, n)
xy) ParsecT Text () Identity (P2 n)
-> ParsecT Text () Identity Char -> ParsecT Text () Identity (P2 n)
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'
anyJoin :: (Num n, Read n) => Parser (PathJoin (Maybe (PathDir n)) (BasicJoin n))
anyJoin :: forall n.
(Num n, Read n) =>
Parser (PathJoin (Maybe (PathDir n)) (BasicJoin n))
anyJoin = Parser (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall n.
Num n =>
Parser (PathJoin (Maybe (PathDir n)) (BasicJoin n))
straightJoin Parser (PathJoin (Maybe (PathDir n)) (BasicJoin n))
-> Parser (PathJoin (Maybe (PathDir n)) (BasicJoin n))
-> Parser (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do
Maybe (PathDir n)
d1' <- ParsecT Text () Identity (PathDir n)
-> ParsecT Text () Identity (Maybe (PathDir n))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT Text () Identity (PathDir n)
forall n. Read n => Parser (PathDir n)
pathDir
BasicJoin n
j' <- Parser (BasicJoin n)
forall n. Num n => Parser (BasicJoin n)
tenseLine Parser (BasicJoin n)
-> Parser (BasicJoin n) -> Parser (BasicJoin n)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser (BasicJoin n)
forall n. (Num n, Read n) => Parser (BasicJoin n)
dotsJoin
Maybe (PathDir n)
d2' <- ParsecT Text () Identity (PathDir n)
-> ParsecT Text () Identity (Maybe (PathDir n))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT Text () Identity (PathDir n)
forall n. Read n => Parser (PathDir n)
pathDir
PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Parser (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Parser (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Parser (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall a b. (a -> b) -> a -> b
$ Maybe (PathDir n)
-> BasicJoin n
-> Maybe (PathDir n)
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
forall d j. d -> j -> d -> PathJoin d j
PJ Maybe (PathDir n)
d1' BasicJoin n
j' Maybe (PathDir n)
d2'
dotsJoin :: (Num n, Read n) => Parser (BasicJoin n)
dotsJoin :: forall n. (Num n, Read n) => Parser (BasicJoin n)
dotsJoin = String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
".." ParsecT Text () Identity String
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT Text () Identity ()
-> ParsecT Text () Identity (BasicJoin n)
-> ParsecT Text () Identity (BasicJoin n)
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
(ParsecT Text () Identity (BasicJoin n)
forall n. Num n => Parser (BasicJoin n)
boundedJoin ParsecT Text () Identity (BasicJoin n)
-> ParsecT Text () Identity (BasicJoin n)
-> ParsecT Text () Identity (BasicJoin n)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>ParsecT Text () Identity (BasicJoin n)
forall n. Read n => Parser (BasicJoin n)
tensionJoin ParsecT Text () Identity (BasicJoin n)
-> ParsecT Text () Identity (BasicJoin n)
-> ParsecT Text () Identity (BasicJoin n)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity (BasicJoin n)
forall n. Read n => Parser (BasicJoin n)
controlJoin ParsecT Text () Identity (BasicJoin n)
-> ParsecT Text () Identity (BasicJoin n)
-> ParsecT Text () Identity (BasicJoin n)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity (BasicJoin n)
forall n. Num n => Parser (BasicJoin n)
plainJoin)
plainJoin :: Num n => Parser (BasicJoin n)
plainJoin :: forall n. Num n => Parser (BasicJoin n)
plainJoin = BasicJoin n -> ParsecT Text () Identity (BasicJoin n)
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TensionJoin n -> BasicJoin n
forall a b. a -> Either a b
Left (TensionJoin n -> BasicJoin n) -> TensionJoin n -> BasicJoin n
forall a b. (a -> b) -> a -> b
$ Tension n -> Tension n -> TensionJoin n
forall n. Tension n -> Tension n -> TensionJoin n
TJ Tension n
t1' Tension n
t1') where
t1' :: Tension n
t1' = n -> Tension n
forall n. n -> Tension n
TensionAmt n
1
tensionJoin :: Read n => Parser (BasicJoin n)
tensionJoin :: forall n. Read n => Parser (BasicJoin n)
tensionJoin = do
String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"tension"
ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
n
t1' <- Parser n
forall n. Read n => Parser n
num
n
t2' <- Parser n -> Parser n
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT Text () Identity ()
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"and" ParsecT Text () Identity String
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT Text () Identity () -> Parser n -> Parser n
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser n
forall n. Read n => Parser n
num Parser n -> ParsecT Text () Identity () -> Parser n
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces) Parser n -> Parser n -> Parser n
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> n -> Parser n
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure n
t1'
String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
".."
BasicJoin n -> Parser (BasicJoin n)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (BasicJoin n -> Parser (BasicJoin n))
-> (TensionJoin n -> BasicJoin n)
-> TensionJoin n
-> Parser (BasicJoin n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TensionJoin n -> BasicJoin n
forall a b. a -> Either a b
Left (TensionJoin n -> Parser (BasicJoin n))
-> TensionJoin n -> Parser (BasicJoin n)
forall a b. (a -> b) -> a -> b
$ Tension n -> Tension n -> TensionJoin n
forall n. Tension n -> Tension n -> TensionJoin n
TJ (n -> Tension n
forall n. n -> Tension n
TensionAmt n
t1') (n -> Tension n
forall n. n -> Tension n
TensionAmt n
t2')
controlJoin :: Read n => Parser (BasicJoin n)
controlJoin :: forall n. Read n => Parser (BasicJoin n)
controlJoin = do
String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"controls" ParsecT Text () Identity String
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
P2 n
z1 <- Parser (P2 n)
forall n. Read n => Parser (P2 n)
pt
ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT Text () Identity ()
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"and" ParsecT Text () Identity String
-> ParsecT Text () Identity () -> ParsecT Text () Identity String
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
P2 n
z2 <- Parser (P2 n)
forall n. Read n => Parser (P2 n)
pt
ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT Text () Identity ()
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
".."
BasicJoin n -> Parser (BasicJoin n)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (BasicJoin n -> Parser (BasicJoin n))
-> (ControlJoin n -> BasicJoin n)
-> ControlJoin n
-> Parser (BasicJoin n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlJoin n -> BasicJoin n
forall a b. b -> Either a b
Right (ControlJoin n -> Parser (BasicJoin n))
-> ControlJoin n -> Parser (BasicJoin n)
forall a b. (a -> b) -> a -> b
$ P2 n -> P2 n -> ControlJoin n
forall n. P2 n -> P2 n -> ControlJoin n
CJ P2 n
z1 P2 n
z2
boundedJoin :: Num n => Parser (BasicJoin n)
boundedJoin :: forall n. Num n => Parser (BasicJoin n)
boundedJoin = Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' ParsecT Text () Identity Char
-> ParsecT Text () Identity (BasicJoin n)
-> ParsecT Text () Identity (BasicJoin n)
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BasicJoin n -> ParsecT Text () Identity (BasicJoin n)
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TensionJoin n -> BasicJoin n
forall a b. a -> Either a b
Left (TensionJoin n -> BasicJoin n) -> TensionJoin n -> BasicJoin n
forall a b. (a -> b) -> a -> b
$ Tension n -> Tension n -> TensionJoin n
forall n. Tension n -> Tension n -> TensionJoin n
TJ Tension n
t Tension n
t) where t :: Tension n
t = n -> Tension n
forall n. n -> Tension n
TensionAtLeast n
1
straightJoin :: Num n => Parser (PathJoin (Maybe (PathDir n)) (BasicJoin n))
straightJoin :: forall n.
Num n =>
Parser (PathJoin (Maybe (PathDir n)) (BasicJoin n))
straightJoin = ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"--" ParsecT Text () Identity String
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Char -> ParsecT Text () Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')) ParsecT Text () Identity ()
-> ParsecT
Text () Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n))
-> ParsecT
Text () Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> ParsecT
Text () Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (PathDir n)
-> BasicJoin n
-> Maybe (PathDir n)
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
forall d j. d -> j -> d -> PathJoin d j
PJ Maybe (PathDir n)
c BasicJoin n
forall {b}. Either (TensionJoin n) b
jj Maybe (PathDir n)
c)
where
c :: Maybe (PathDir n)
c = PathDir n -> Maybe (PathDir n)
forall a. a -> Maybe a
Just (PathDir n -> Maybe (PathDir n)) -> PathDir n -> Maybe (PathDir n)
forall a b. (a -> b) -> a -> b
$ n -> PathDir n
forall n. n -> PathDir n
PathDirCurl n
1
jj :: Either (TensionJoin n) b
jj = TensionJoin n -> Either (TensionJoin n) b
forall a b. a -> Either a b
Left (TensionJoin n -> Either (TensionJoin n) b)
-> TensionJoin n -> Either (TensionJoin n) b
forall a b. (a -> b) -> a -> b
$ Tension n -> Tension n -> TensionJoin n
forall n. Tension n -> Tension n -> TensionJoin n
TJ (n -> Tension n
forall n. n -> Tension n
TensionAmt n
1) (n -> Tension n
forall n. n -> Tension n
TensionAmt n
1)
tenseLine :: Num n => Parser (BasicJoin n)
tenseLine :: forall n. Num n => Parser (BasicJoin n)
tenseLine = String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"---" ParsecT Text () Identity String
-> ParsecT Text () Identity (BasicJoin n)
-> ParsecT Text () Identity (BasicJoin n)
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BasicJoin n -> ParsecT Text () Identity (BasicJoin n)
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TensionJoin n -> BasicJoin n
forall a b. a -> Either a b
Left (TensionJoin n -> BasicJoin n) -> TensionJoin n -> BasicJoin n
forall a b. (a -> b) -> a -> b
$ Tension n -> Tension n -> TensionJoin n
forall n. Tension n -> Tension n -> TensionJoin n
TJ Tension n
t Tension n
t) where t :: Tension n
t = n -> Tension n
forall n. n -> Tension n
TensionAmt n
4096
dir :: Read n => Parser (PathDir n)
dir :: forall n. Read n => Parser (PathDir n)
dir = Dir n -> PathDir n
forall n. Dir n -> PathDir n
PathDirDir (Dir n -> PathDir n) -> ((n, n) -> Dir n) -> (n, n) -> PathDir n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 n -> Dir n
forall (v :: * -> *) n. v n -> Direction v n
direction (V2 n -> Dir n) -> ((n, n) -> V2 n) -> (n, n) -> Dir n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n, n) -> V2 n
forall n. (n, n) -> V2 n
r2 ((n, n) -> PathDir n)
-> ParsecT Text () Identity (n, n)
-> ParsecT Text () Identity (PathDir n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (n, n)
forall n. Read n => Parser (n, n)
xy
curl :: Read n => Parser (PathDir n)
curl :: forall n. Read n => Parser (PathDir n)
curl = n -> PathDir n
forall n. n -> PathDir n
PathDirCurl (n -> PathDir n)
-> ParsecT Text () Identity n
-> ParsecT Text () Identity (PathDir n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"curl" ParsecT Text () Identity String
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT Text () Identity ()
-> ParsecT Text () Identity n -> ParsecT Text () Identity n
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity n
forall n. Read n => Parser n
num)
pathDir :: Read n => Parser (PathDir n)
pathDir :: forall n. Read n => Parser (PathDir n)
pathDir = do
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' ParsecT Text () Identity Char
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
PathDir n
d <- Parser (PathDir n)
forall n. Read n => Parser (PathDir n)
curl Parser (PathDir n) -> Parser (PathDir n) -> Parser (PathDir n)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser (PathDir n)
forall n. Read n => Parser (PathDir n)
dir
ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT Text () Identity ()
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
PathDir n -> Parser (PathDir n)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return PathDir n
d
mfs :: (Num n, Read n) => Parser (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
mfs :: forall n.
(Num n, Read n) =>
Parser (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
mfs = P2 n
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> P2 n
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
forall d j n. P2 n -> PathJoin d j -> P2 n -> MetafontSegment d j n
MFS (P2 n
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> P2 n
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
-> ParsecT Text () Identity (P2 n)
-> ParsecT
Text
()
Identity
(PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> P2 n -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (P2 n)
forall n. Read n => Parser (P2 n)
pt ParsecT
Text
()
Identity
(PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> P2 n -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
-> ParsecT
Text () Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n))
-> ParsecT
Text
()
Identity
(P2 n -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT
Text () Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall n.
(Num n, Read n) =>
Parser (PathJoin (Maybe (PathDir n)) (BasicJoin n))
anyJoin ParsecT
Text
()
Identity
(P2 n -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
-> ParsecT Text () Identity (P2 n)
-> ParsecT
Text
()
Identity
(MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity (P2 n) -> ParsecT Text () Identity (P2 n)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text () Identity (P2 n)
forall n. Read n => Parser (P2 n)
pt
matches :: Stream s m t => ParsecT s u m a -> ParsecT s u m Bool
matches :: forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m Bool
matches ParsecT s u m a
p = Bool -> ParsecT s u m Bool -> ParsecT s u m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (ParsecT s u m a
p ParsecT s u m a -> ParsecT s u m Bool -> ParsecT s u m Bool
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> ParsecT s u m Bool
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
metafontParser :: (Num n, Read n) => Parser (MFPath (Maybe (PathDir n)) (BasicJoin n) n)
metafontParser :: forall n.
(Num n, Read n) =>
Parser (MFPath (Maybe (PathDir n)) (BasicJoin n) n)
metafontParser = do
[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
ss <- ParsecT
Text
()
Identity
(MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
-> ParsecT
Text
()
Identity
[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT
Text
()
Identity
(MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
-> ParsecT
Text
()
Identity
(MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT
Text
()
Identity
(MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall n.
(Num n, Read n) =>
Parser (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
mfs)
P2 n
lastP <- Parser (P2 n)
forall n. Read n => Parser (P2 n)
pt
Maybe (PathDir n)
lastD <- ParsecT Text () Identity (PathDir n)
-> ParsecT Text () Identity (Maybe (PathDir n))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT Text () Identity (PathDir n)
forall n. Read n => Parser (PathDir n)
pathDir
Bool
c <- ParsecT Text () Identity String -> ParsecT Text () Identity Bool
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m Bool
matches (ParsecT Text () Identity String -> ParsecT Text () Identity Bool)
-> ParsecT Text () Identity String -> ParsecT Text () Identity Bool
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"..cycle"
if Bool
c
then MFPath (Maybe (PathDir n)) (BasicJoin n) n
-> Parser (MFPath (Maybe (PathDir n)) (BasicJoin n) n)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MFPath (Maybe (PathDir n)) (BasicJoin n) n
-> Parser (MFPath (Maybe (PathDir n)) (BasicJoin n) n))
-> ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> MFPath (Maybe (PathDir n)) (BasicJoin n) n)
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Parser (MFPath (Maybe (PathDir n)) (BasicJoin n) n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> MFPath (Maybe (PathDir n)) (BasicJoin n) n
forall d j n. Bool -> [MetafontSegment d j n] -> MFPath d j n
MFP Bool
c ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Parser (MFPath (Maybe (PathDir n)) (BasicJoin n) n))
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Parser (MFPath (Maybe (PathDir n)) (BasicJoin n) n)
forall a b. (a -> b) -> a -> b
$ [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
ss [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall a. [a] -> [a] -> [a]
++ [P2 n
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> P2 n
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
forall d j n. P2 n -> PathJoin d j -> P2 n -> MetafontSegment d j n
MFS P2 n
lastP (Maybe (PathDir n)
-> BasicJoin n
-> Maybe (PathDir n)
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
forall d j. d -> j -> d -> PathJoin d j
PJ Maybe (PathDir n)
lastD (TensionJoin n -> BasicJoin n
forall a b. a -> Either a b
Left (TensionJoin n -> BasicJoin n) -> TensionJoin n -> BasicJoin n
forall a b. (a -> b) -> a -> b
$ Tension n -> Tension n -> TensionJoin n
forall n. Tension n -> Tension n -> TensionJoin n
TJ (n -> Tension n
forall n. n -> Tension n
TensionAmt n
1) (n -> Tension n
forall n. n -> Tension n
TensionAmt n
1)) Maybe (PathDir n)
forall a. Maybe a
Nothing) ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
forall a. HasCallStack => [a] -> a
head [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
ssMetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Getting
(P2 n) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n) (P2 n)
-> P2 n
forall s a. s -> Getting a s a -> a
^.Getting
(P2 n) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n) (P2 n)
forall d j n (f :: * -> *).
Functor f =>
(P2 n -> f (P2 n))
-> MetafontSegment d j n -> f (MetafontSegment d j n)
x1)]
else MFPath (Maybe (PathDir n)) (BasicJoin n) n
-> Parser (MFPath (Maybe (PathDir n)) (BasicJoin n) n)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MFPath (Maybe (PathDir n)) (BasicJoin n) n
-> Parser (MFPath (Maybe (PathDir n)) (BasicJoin n) n))
-> MFPath (Maybe (PathDir n)) (BasicJoin n) n
-> Parser (MFPath (Maybe (PathDir n)) (BasicJoin n) n)
forall a b. (a -> b) -> a -> b
$ Bool
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> MFPath (Maybe (PathDir n)) (BasicJoin n) n
forall d j n. Bool -> [MetafontSegment d j n] -> MFPath d j n
MFP Bool
c [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
ss