{-# 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

-- points

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
')'

-- Joins

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)
-- 4096 is the constant 'infinity' in Plain MetaFont
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

-- Directions

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

-- Segments & Paths

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)

-- | Parse a 'Text' value in Metafont syntax, as destribed in /The
-- METAFONTbook/.
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