{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Typst.Types
  ( RE,
    Val (..),
    ValType (..),
    valType,
    hasType,
    FromVal (..),
    Negatable (..),
    Summable (..),
    Multipliable (..),
    Selector (..),
    Symbol (..),
    Content (..),
    Function (..),
    Arguments (..),
    getPositionalArg,
    getNamedArg,
    Compare (..),
    MP,
    Scope (..),
    FlowDirective (..),
    EvalState (..),
    emptyEvalState,
    ShowRule (..),
    Counter (..),
    LUnit (..),
    Length (..),
    renderLength,
    Horiz (..),
    Vert (..),
    Color (..),
    Direction (..),
    Identifier (..), -- reexported
    lookupIdentifier,
    joinVals,
    prettyVal,
    valToContent,
    repr,
    Attempt (..),
  )
where

import Control.Monad (MonadPlus (..))
import Data.Aeson (FromJSON, parseJSON)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS
import Data.Data (Typeable)
import qualified Data.Foldable as F
import Data.Functor.Classes (Ord1 (liftCompare))
import qualified Data.Map as M
import qualified Data.Map.Ordered as OM
import Data.Maybe (fromMaybe, isJust)
import Data.Scientific (floatingOrInteger)
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import Data.Vector (Vector)
import qualified Data.Vector as V
import Text.Parsec
import qualified Text.PrettyPrint as P
import Text.Read (readMaybe)
import Typst.Regex (RE, makeLiteralRE)
import Typst.Syntax (Identifier (..), Markup)

data Val
  = VNone
  | VAuto
  | VBoolean !Bool
  | VInteger !Integer
  | VFloat !Double
  | VRatio !Rational
  | VLength !Length
  | VAlignment (Maybe Horiz) (Maybe Vert)
  | VAngle !Double -- degrees
  | VFraction !Double
  | VColor !Color
  | VSymbol !Symbol
  | VString !Text
  | VRegex !RE
  | VContent (Seq Content)
  | VArray (Vector Val)
  | VDict (OM.OMap Identifier Val)
  | VTermItem (Seq Content) (Seq Content)
  | VDirection Direction
  | VFunction (Maybe Identifier) (M.Map Identifier Val) Function
  | -- first param is Just ident if element function
    -- second param is a map of subfunctions in this function's scope
    VArguments Arguments
  | VLabel !Text
  | VCounter !Counter
  | VSelector !Selector
  | VModule Identifier (M.Map Identifier Val)
  | VStyles -- just a placeholder for now
  deriving (Int -> Val -> ShowS
[Val] -> ShowS
Val -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Val] -> ShowS
$cshowList :: [Val] -> ShowS
show :: Val -> String
$cshow :: Val -> String
showsPrec :: Int -> Val -> ShowS
$cshowsPrec :: Int -> Val -> ShowS
Show, Val -> Val -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Val -> Val -> Bool
$c/= :: Val -> Val -> Bool
== :: Val -> Val -> Bool
$c== :: Val -> Val -> Bool
Eq, Typeable)

instance FromJSON Val where
  parseJSON :: Value -> Parser Val
parseJSON v :: Value
v@(Aeson.Object {}) =
    OMap Identifier Val -> Val
VDict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys Text -> Identifier
Identifier forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  parseJSON v :: Value
v@(Aeson.Array {}) = Vector Val -> Val
VArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  parseJSON (Aeson.String Text
t) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Val
VString Text
t
  parseJSON (Aeson.Number Scientific
n) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Double -> Val
VFloat Integer -> Val
VInteger (forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
n)
  parseJSON (Aeson.Bool Bool
b) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
b
  parseJSON Value
Aeson.Null = forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone

data ValType
  = TNone
  | TAuto
  | TBoolean
  | TInteger
  | TFloat
  | TRatio
  | TLength
  | TAlignment
  | TAngle
  | TFraction
  | TColor
  | TSymbol
  | TString
  | TRegex
  | TContent
  | TArray
  | TDict
  | TTermItem
  | TDirection
  | TFunction
  | TArguments
  | TModule
  | TSelector
  | TStyles
  | TLabel
  | TCounter
  | TLocation
  | TAny
  | ValType :|: ValType
  deriving (Int -> ValType -> ShowS
[ValType] -> ShowS
ValType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValType] -> ShowS
$cshowList :: [ValType] -> ShowS
show :: ValType -> String
$cshow :: ValType -> String
showsPrec :: Int -> ValType -> ShowS
$cshowsPrec :: Int -> ValType -> ShowS
Show, ValType -> ValType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValType -> ValType -> Bool
$c/= :: ValType -> ValType -> Bool
== :: ValType -> ValType -> Bool
$c== :: ValType -> ValType -> Bool
Eq, Typeable)

valType :: Val -> ValType
valType :: Val -> ValType
valType Val
v =
  case Val
v of
    VNone {} -> ValType
TNone
    VAuto {} -> ValType
TAuto
    VBoolean {} -> ValType
TBoolean
    VInteger {} -> ValType
TInteger
    VFloat {} -> ValType
TFloat
    VRatio {} -> ValType
TRatio
    VLength {} -> ValType
TLength
    VAlignment {} -> ValType
TAlignment
    VAngle {} -> ValType
TAngle
    VFraction {} -> ValType
TFraction
    VColor {} -> ValType
TColor
    VSymbol {} -> ValType
TSymbol
    VString {} -> ValType
TString
    VRegex {} -> ValType
TRegex
    VContent {} -> ValType
TContent
    VArray {} -> ValType
TArray
    VDict {} -> ValType
TDict
    VTermItem {} -> ValType
TTermItem
    VDirection {} -> ValType
TDirection
    VLabel {} -> ValType
TLabel
    VCounter {} -> ValType
TCounter
    VFunction {} -> ValType
TFunction
    VArguments {} -> ValType
TArguments
    VModule {} -> ValType
TModule
    VSelector {} -> ValType
TSelector
    VStyles {} -> ValType
TStyles

hasType :: ValType -> Val -> Bool
hasType :: ValType -> Val -> Bool
hasType ValType
TAny Val
_ = Bool
True
hasType ValType
TLocation (VDict OMap Identifier Val
m) =
  forall a. Maybe a -> Bool
isJust (forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup Identifier
"page" OMap Identifier Val
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup Identifier
"x" OMap Identifier Val
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup Identifier
"y" OMap Identifier Val
m)
hasType (ValType
t1 :|: ValType
t2) Val
v = ValType -> Val -> Bool
hasType ValType
t1 Val
v Bool -> Bool -> Bool
|| ValType -> Val -> Bool
hasType ValType
t2 Val
v
hasType ValType
t Val
v = ValType
t forall a. Eq a => a -> a -> Bool
== Val -> ValType
valType Val
v

class FromVal a where
  fromVal :: (MonadPlus m, MonadFail m) => Val -> m a

instance FromVal Val where
  fromVal :: forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m Val
fromVal = forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance FromVal (Seq Content) where
  fromVal :: forall (m :: * -> *).
(MonadPlus m, MonadFail m) =>
Val -> m (Seq Content)
fromVal = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val -> Seq Content
valToContent

instance FromVal Text where
  fromVal :: forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m Text
fromVal (VContent Seq Content
cs) = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {f :: * -> *}.
(MonadFail f, MonadPlus f) =>
Content -> f Text
go (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Content
cs)
    where
      go :: Content -> f Text
go (Txt Text
t) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
      go (Elt Identifier
"text" Maybe SourcePos
_ Map Identifier Val
fs) =
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"text element has no body")
          forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
fromVal
          (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
"body" Map Identifier Val
fs)
      go Content
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a text element"
  fromVal (VString Text
t) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
  fromVal Val
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a string or content value"

instance FromVal String where
  fromVal :: forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m String
fromVal = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
fromVal

instance FromVal RE where
  fromVal :: forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m RE
fromVal (VString Text
t) = forall (m :: * -> *). MonadFail m => Text -> m RE
makeLiteralRE Text
t
  fromVal (VRegex RE
re) = forall (f :: * -> *) a. Applicative f => a -> f a
pure RE
re
  fromVal Val
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a string or regex"

instance FromVal Integer where
  fromVal :: forall (m :: * -> *).
(MonadPlus m, MonadFail m) =>
Val -> m Integer
fromVal Val
val =
    case Val
val of
      VInteger Integer
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x
      VFloat Double
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
floor Double
x
      VRatio Rational
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
floor Rational
x
      VBoolean Bool
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Bool
x then Integer
1 else Integer
0
      VString Text
x | Just (Integer
xint :: Integer) <- forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
x) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
xint
      Val
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Cannot convert " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Val
val forall a. Semigroup a => a -> a -> a
<> String
" to integer"

instance FromVal Int where
  fromVal :: forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m Int
fromVal Val
val = (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Integer -> Int) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
fromVal Val
val

instance FromVal Rational where
  fromVal :: forall (m :: * -> *).
(MonadPlus m, MonadFail m) =>
Val -> m Rational
fromVal Val
val =
    case Val
val of
      VRatio Rational
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Rational
x
      VInteger Integer
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x
      VString Text
x | Just (Rational
xrat :: Rational) <- forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
x) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Rational
xrat
      Val
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Cannot convert " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Val
val forall a. Semigroup a => a -> a -> a
<> String
" to rational"

instance FromVal Double where
  fromVal :: forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m Double
fromVal Val
val =
    case Val
val of
      VInteger Integer
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x
      VFloat Double
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
x
      VRatio Rational
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational Rational
x
      VString Text
x | Just (Double
xdb :: Double) <- forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
x) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
xdb
      Val
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Cannot convert " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Val
val forall a. Semigroup a => a -> a -> a
<> String
" to double"

instance FromVal Bool where
  fromVal :: forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m Bool
fromVal (VBoolean Bool
b) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
  fromVal Val
val = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Cannot convert " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Val
val forall a. Semigroup a => a -> a -> a
<> String
" to boolean"

instance FromVal Length where
  fromVal :: forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m Length
fromVal (VLength Length
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Length
x
  fromVal (VRatio Rational
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rational -> Length
LRatio Rational
x
  fromVal Val
val = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Cannot convert " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Val
val forall a. Semigroup a => a -> a -> a
<> String
" to length"

instance FromVal Function where
  fromVal :: forall (m :: * -> *).
(MonadPlus m, MonadFail m) =>
Val -> m Function
fromVal (VFunction Maybe Identifier
_ Map Identifier Val
_ Function
f) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Function
f
  fromVal Val
val = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Val
val forall a. Semigroup a => a -> a -> a
<> String
" is not a function"

instance FromVal Direction where
  fromVal :: forall (m :: * -> *).
(MonadPlus m, MonadFail m) =>
Val -> m Direction
fromVal (VDirection Direction
d) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Direction
d
  fromVal Val
val = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Val
val forall a. Semigroup a => a -> a -> a
<> String
" is not a direction"

instance FromVal Counter where
  fromVal :: forall (m :: * -> *).
(MonadPlus m, MonadFail m) =>
Val -> m Counter
fromVal (VString Text
t) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Counter
CounterCustom Text
t
  fromVal (VLabel Text
t) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Counter
CounterLabel Text
t
  fromVal (VFunction (Just Identifier
"page") Map Identifier Val
_ Function
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Counter
CounterPage
  fromVal (VFunction (Just Identifier
name) Map Identifier Val
_ Function
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Selector -> Counter
CounterSelector forall a b. (a -> b) -> a -> b
$ Identifier -> [(Identifier, Val)] -> Selector
SelectElement Identifier
name []
  fromVal (VSelector Selector
s) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Selector -> Counter
CounterSelector Selector
s
  fromVal Val
val = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Val
val forall a. Semigroup a => a -> a -> a
<> String
" is not a counter"

instance FromVal Selector where
  fromVal :: forall (m :: * -> *).
(MonadPlus m, MonadFail m) =>
Val -> m Selector
fromVal (VSelector Selector
s) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Selector
s
  fromVal Val
val = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Val
val forall a. Semigroup a => a -> a -> a
<> String
" is not a selector"

instance FromVal a => FromVal (Maybe a) where
  fromVal :: forall (m :: * -> *).
(MonadPlus m, MonadFail m) =>
Val -> m (Maybe a)
fromVal Val
VNone = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
  fromVal Val
x = (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
fromVal Val
x) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

instance FromVal a => FromVal (Vector a) where
  fromVal :: forall (m :: * -> *).
(MonadPlus m, MonadFail m) =>
Val -> m (Vector a)
fromVal (VArray Vector Val
v) = forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
fromVal Vector Val
v
  fromVal Val
val = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Could not convert " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Val
val forall a. Semigroup a => a -> a -> a
<> String
" to array"

data Selector
  = SelectElement Identifier [(Identifier, Val)]
  | SelectString !Text
  | SelectRegex !RE
  | SelectLabel !Text
  | SelectOr Selector Selector
  | SelectAnd Selector Selector
  | SelectBefore Selector Selector
  | SelectAfter Selector Selector
  deriving (Int -> Selector -> ShowS
[Selector] -> ShowS
Selector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Selector] -> ShowS
$cshowList :: [Selector] -> ShowS
show :: Selector -> String
$cshow :: Selector -> String
showsPrec :: Int -> Selector -> ShowS
$cshowsPrec :: Int -> Selector -> ShowS
Show, Selector -> Selector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Selector -> Selector -> Bool
$c/= :: Selector -> Selector -> Bool
== :: Selector -> Selector -> Bool
$c== :: Selector -> Selector -> Bool
Eq, Eq Selector
Selector -> Selector -> Bool
Selector -> Selector -> Ordering
Selector -> Selector -> Selector
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Selector -> Selector -> Selector
$cmin :: Selector -> Selector -> Selector
max :: Selector -> Selector -> Selector
$cmax :: Selector -> Selector -> Selector
>= :: Selector -> Selector -> Bool
$c>= :: Selector -> Selector -> Bool
> :: Selector -> Selector -> Bool
$c> :: Selector -> Selector -> Bool
<= :: Selector -> Selector -> Bool
$c<= :: Selector -> Selector -> Bool
< :: Selector -> Selector -> Bool
$c< :: Selector -> Selector -> Bool
compare :: Selector -> Selector -> Ordering
$ccompare :: Selector -> Selector -> Ordering
Ord, Typeable)

data Symbol = Symbol
  { Symbol -> Text
symDefault :: !Text,
    Symbol -> Bool
symAccent :: !Bool,
    Symbol -> [(Set Text, Text)]
symVariants :: [(Set.Set Text, Text)]
  }
  deriving (Int -> Symbol -> ShowS
[Symbol] -> ShowS
Symbol -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Symbol] -> ShowS
$cshowList :: [Symbol] -> ShowS
show :: Symbol -> String
$cshow :: Symbol -> String
showsPrec :: Int -> Symbol -> ShowS
$cshowsPrec :: Int -> Symbol -> ShowS
Show, Symbol -> Symbol -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Symbol -> Symbol -> Bool
$c/= :: Symbol -> Symbol -> Bool
== :: Symbol -> Symbol -> Bool
$c== :: Symbol -> Symbol -> Bool
Eq, Typeable)

joinVals :: MonadFail m => Val -> Val -> m Val
joinVals :: forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals = forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
go
  where
    go :: Val -> Val -> f Val
go Val
VNone Val
v = forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
    go Val
v Val
VNone = forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
    go Val
v (VSymbol (Symbol Text
s Bool
_ [(Set Text, Text)]
_)) = Val -> Val -> f Val
go Val
v (Text -> Val
VString Text
s)
    go (VString Text
t) (VString Text
t') = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Text
t forall a. Semigroup a => a -> a -> a
<> Text
t')
    go (VString Text
t) (VContent Seq Content
cs) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent (Text -> Content
Txt Text
t forall a. a -> Seq a -> Seq a
Seq.<| Seq Content
cs)
    go (VContent Seq Content
cs) (VString Text
t) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent (Seq Content
cs forall a. Seq a -> a -> Seq a
Seq.|> Text -> Content
Txt Text
t)
    go (VContent Seq Content
cs) (VContent Seq Content
cs') = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent (Seq Content
cs forall a. Semigroup a => a -> a -> a
<> Seq Content
cs')
    go (VArray Vector Val
vec) (VArray Vector Val
vec') = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val
vec forall a. Semigroup a => a -> a -> a
<> Vector Val
vec')
    go Val
accum Val
v = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Can't combine " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Val
accum forall a. Semigroup a => a -> a -> a
<> String
" and " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Val
v

class Compare a where
  comp :: a -> a -> Maybe Ordering

instance Compare Val where
  comp :: Val -> Val -> Maybe Ordering
comp Val
VNone Val
VNone = forall a. a -> Maybe a
Just Ordering
EQ
  comp Val
VAuto Val
VAuto = forall a. a -> Maybe a
Just Ordering
EQ
  comp (VBoolean Bool
b1) (VBoolean Bool
b2) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare Bool
b1 Bool
b2
  comp (VInteger Integer
i1) (VInteger Integer
i2) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare Integer
i1 Integer
i2
  comp (VFloat Double
f1) (VFloat Double
f2) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare Double
f1 Double
f2
  comp (VInteger Integer
i1) (VFloat Double
f2) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i1) Double
f2
  comp (VFloat Double
f1) (VInteger Integer
i2) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare Double
f1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i2)
  comp (VRatio Rational
r1) (VRatio Rational
r2) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare Rational
r1 Rational
r2
  comp (VRatio Rational
r1) (VLength (LRatio Rational
r2)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare Rational
r1 Rational
r2
  comp (VLength (LRatio Rational
r1)) (VRatio Rational
r2) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare Rational
r1 Rational
r2
  comp (VRatio Rational
r1) Val
x = forall a. Compare a => a -> a -> Maybe Ordering
comp (Double -> Val
VFloat (forall a. Fractional a => Rational -> a
fromRational Rational
r1)) Val
x
  comp Val
x (VRatio Rational
r1) = forall a. Compare a => a -> a -> Maybe Ordering
comp Val
x (Double -> Val
VFloat (forall a. Fractional a => Rational -> a
fromRational Rational
r1))
  comp (VLength Length
x1) (VLength Length
x2) = Length -> Length -> Maybe Ordering
compareLength Length
x1 Length
x2
  comp (VAlignment {}) (VAlignment {}) = forall a. Maybe a
Nothing
  comp (VAngle Double
x1) (VAngle Double
x2) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare Double
x1 Double
x2
  comp (VFraction Double
x1) (VFraction Double
x2) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare Double
x1 Double
x2
  comp (VColor Color
c1) (VColor Color
c2) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare Color
c1 Color
c2
  comp (VSymbol (Symbol Text
s1 Bool
_ [(Set Text, Text)]
_)) (VSymbol (Symbol Text
s2 Bool
_ [(Set Text, Text)]
_)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare Text
s1 Text
s2
  comp (VString Text
s1) (VString Text
s2) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare Text
s1 Text
s2
  comp (VContent Seq Content
c1) (VContent Seq Content
c2) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare Seq Content
c1 Seq Content
c2
  comp (VArray Vector Val
v1) (VArray Vector Val
v2) =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare (\Val
x Val
y -> forall a. a -> Maybe a -> a
fromMaybe Ordering
LT (forall a. Compare a => a -> a -> Maybe Ordering
comp Val
x Val
y)) Vector Val
v1 Vector Val
v2
  comp (VDict OMap Identifier Val
m1) (VDict OMap Identifier Val
m2) =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare (\Val
x Val
y -> forall a. a -> Maybe a -> a
fromMaybe Ordering
LT (forall a. Compare a => a -> a -> Maybe Ordering
comp Val
x Val
y)) (forall k v. OMap k v -> Map k v
OM.toMap OMap Identifier Val
m1) (forall k v. OMap k v -> Map k v
OM.toMap OMap Identifier Val
m2)
  comp (VFunction (Just Identifier
i1) Map Identifier Val
_ Function
_) (VFunction (Just Identifier
i2) Map Identifier Val
_ Function
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare Identifier
i1 Identifier
i2
  comp Val
_ Val
_ = forall a. Maybe a
Nothing

instance Ord Val where
  compare :: Val -> Val -> Ordering
compare Val
v1 Val
v2 = forall a. a -> Maybe a -> a
fromMaybe Ordering
EQ forall a b. (a -> b) -> a -> b
$ forall a. Compare a => a -> a -> Maybe Ordering
comp Val
v1 Val
v2

class Negatable a where
  maybeNegate :: a -> Maybe a

instance Negatable Val where
  maybeNegate :: Val -> Maybe Val
maybeNegate (VInteger Integer
i) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> Val
VInteger (-Integer
i)
  maybeNegate (VFloat Double
f) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (-Double
f)
  maybeNegate (VLength Length
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength forall a b. (a -> b) -> a -> b
$ Length -> Length
negateLength Length
x
  maybeNegate (VAngle Double
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VAngle (-Double
x)
  maybeNegate (VFraction Double
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFraction (-Double
x)
  maybeNegate (VRatio Rational
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (-Rational
x)
  maybeNegate Val
v = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"could not negate " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Val
v

class Negatable a => Summable a where
  maybePlus :: a -> a -> Maybe a
  maybeMinus :: a -> a -> Maybe a
  maybeMinus a
x a
y = forall a. Negatable a => a -> Maybe a
maybeNegate a
y forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Summable a => a -> a -> Maybe a
maybePlus a
x

instance Summable Val where
  maybePlus :: Val -> Val -> Maybe Val
maybePlus Val
VNone Val
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x
  maybePlus Val
x Val
VNone = forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x
  maybePlus (VInteger Integer
i1) (VInteger Integer
i2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> Val
VInteger (Integer
i1 forall a. Num a => a -> a -> a
+ Integer
i2)
  maybePlus (VRatio Rational
r1) (VRatio Rational
r2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (Rational
r1 forall a. Num a => a -> a -> a
+ Rational
r2)
  maybePlus (VFloat Double
f1) (VFloat Double
f2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
f1 forall a. Num a => a -> a -> a
+ Double
f2)
  maybePlus (VInteger Integer
i1) (VFloat Double
f2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i1 forall a. Num a => a -> a -> a
+ Double
f2)
  maybePlus (VFloat Double
f1) (VInteger Integer
i2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
f1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i2)
  maybePlus (VInteger Integer
i1) (VRatio Rational
r2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i1 forall a. Num a => a -> a -> a
+ Rational
r2)
  maybePlus (VRatio Rational
r1) (VInteger Integer
i2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (Rational
r1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i2)
  maybePlus (VFloat Double
f1) (VRatio Rational
r2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
f1 forall a. Num a => a -> a -> a
+ forall a. Fractional a => Rational -> a
fromRational Rational
r2)
  maybePlus (VRatio Rational
r1) (VFloat Double
f2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (forall a. Fractional a => Rational -> a
fromRational Rational
r1 forall a. Num a => a -> a -> a
+ Double
f2)
  maybePlus (VString Text
s1) (VString Text
s2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Text
s1 forall a. Semigroup a => a -> a -> a
<> Text
s2)
  maybePlus (VContent Seq Content
c1) (VContent Seq Content
c2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent (Seq Content
c1 forall a. Semigroup a => a -> a -> a
<> Seq Content
c2)
  maybePlus (VString Text
s1) (VContent Seq Content
c2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent (Text -> Content
Txt Text
s1 forall a. a -> Seq a -> Seq a
Seq.<| Seq Content
c2)
  maybePlus (VContent Seq Content
c1) (VString Text
s2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent (Seq Content
c1 forall a. Seq a -> a -> Seq a
Seq.|> Text -> Content
Txt Text
s2)
  maybePlus (VLength Length
l1) (VLength Length
l2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength (Length
l1 forall a. Semigroup a => a -> a -> a
<> Length
l2)
  maybePlus (VLength Length
l1) (VRatio Rational
r1) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength (Length
l1 forall a. Semigroup a => a -> a -> a
<> Rational -> Length
LRatio Rational
r1)
  maybePlus (VRatio Rational
r1) (VLength Length
l1) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength (Length
l1 forall a. Semigroup a => a -> a -> a
<> Rational -> Length
LRatio Rational
r1)
  maybePlus (VAngle Double
a1) (VAngle Double
a2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VAngle (Double
a1 forall a. Num a => a -> a -> a
+ Double
a2)
  maybePlus (VFraction Double
f1) (VFraction Double
f2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFraction (Double
f1 forall a. Num a => a -> a -> a
+ Double
f2)
  maybePlus (VArray Vector Val
v1) (VArray Vector Val
v2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val
v1 forall a. Semigroup a => a -> a -> a
<> Vector Val
v2)
  maybePlus (VDict OMap Identifier Val
m1) (VDict OMap Identifier Val
m2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ OMap Identifier Val -> Val
VDict (OMap Identifier Val
m1 forall k v. Ord k => OMap k v -> OMap k v -> OMap k v
OM.<>| OMap Identifier Val
m2)
  maybePlus (VColor Color
c) (VLength Length
l) =
    -- Stroke '1pt + red'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ OMap Identifier Val -> Val
VDict forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList [(Identifier
"thickness", Length -> Val
VLength Length
l), (Identifier
"color", Color -> Val
VColor Color
c)]
  maybePlus (VLength Length
l) (VColor Color
c) = forall a. Summable a => a -> a -> Maybe a
maybePlus (Color -> Val
VColor Color
c) (Length -> Val
VLength Length
l)
  maybePlus Val
v1 Val
v2 = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"could not add " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Val
v1 forall a. Semigroup a => a -> a -> a
<> String
" and " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Val
v2

class Multipliable a where
  maybeTimes :: a -> a -> Maybe a
  maybeDividedBy :: a -> a -> Maybe a

instance Multipliable Val where
  maybeTimes :: Val -> Val -> Maybe Val
maybeTimes (VInteger Integer
i1) (VInteger Integer
i2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> Val
VInteger (Integer
i1 forall a. Num a => a -> a -> a
* Integer
i2)
  maybeTimes (VFloat Double
x1) (VFloat Double
x2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
x1 forall a. Num a => a -> a -> a
* Double
x2)
  maybeTimes (VInteger Integer
i1) (VFloat Double
f2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i1 forall a. Num a => a -> a -> a
* Double
f2)
  maybeTimes (VFloat Double
f1) (VInteger Integer
i2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
f1 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i2)
  maybeTimes (VInteger Integer
i) (VArray Vector Val
v) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Vector Val
v)
  maybeTimes (VArray Vector Val
v) (VInteger Integer
i) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Vector Val
v)
  maybeTimes (VInteger Integer
i) (VString Text
s)
    | Integer
i forall a. Ord a => a -> a -> Bool
>= Integer
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Int -> Text -> Text
T.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Text
s)
  maybeTimes (VString Text
s) (VInteger Integer
i)
    | Integer
i forall a. Ord a => a -> a -> Bool
>= Integer
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Int -> Text -> Text
T.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Text
s)
  maybeTimes (VInteger Integer
i) (VContent Seq Content
c)
    | Integer
i forall a. Ord a => a -> a -> Bool
>= Integer
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Seq Content
c)
  maybeTimes (VContent Seq Content
c) (VInteger Integer
i)
    | Integer
i forall a. Ord a => a -> a -> Bool
>= Integer
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Seq Content
c)
  maybeTimes (VInteger Integer
i) (VLength Length
l) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength forall a b. (a -> b) -> a -> b
$ Double -> Length -> Length
timesLength (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Length
l
  maybeTimes (VLength Length
l) (VInteger Integer
i) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength forall a b. (a -> b) -> a -> b
$ Double -> Length -> Length
timesLength (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Length
l
  maybeTimes (VFloat Double
f) (VLength Length
l) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength forall a b. (a -> b) -> a -> b
$ Double -> Length -> Length
timesLength Double
f Length
l
  maybeTimes (VLength Length
l) (VFloat Double
f) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength forall a b. (a -> b) -> a -> b
$ Double -> Length -> Length
timesLength Double
f Length
l
  maybeTimes (VInteger Integer
i) (VAngle Double
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VAngle (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i forall a. Num a => a -> a -> a
* Double
a)
  maybeTimes (VAngle Double
a) (VInteger Integer
i) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VAngle (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i forall a. Num a => a -> a -> a
* Double
a)
  maybeTimes (VFloat Double
f) (VAngle Double
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VAngle (Double
f forall a. Num a => a -> a -> a
* Double
a)
  maybeTimes (VAngle Double
a) (VFloat Double
f) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VAngle (Double
f forall a. Num a => a -> a -> a
* Double
a)
  maybeTimes (VInteger Integer
i) (VFraction Double
f) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFraction (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i forall a. Num a => a -> a -> a
* Double
f)
  maybeTimes (VFraction Double
f) (VInteger Integer
i) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFraction (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i forall a. Num a => a -> a -> a
* Double
f)
  maybeTimes (VFloat Double
x) (VFraction Double
f) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFraction (Double
x forall a. Num a => a -> a -> a
* Double
f)
  maybeTimes (VFraction Double
f) (VFloat Double
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFraction (Double
x forall a. Num a => a -> a -> a
* Double
f)
  maybeTimes (VFraction Double
f1) (VFraction Double
f2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFraction (Double
f1 forall a. Num a => a -> a -> a
* Double
f2)
  maybeTimes (VRatio Rational
r1) (VRatio Rational
r2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (Rational
r1 forall a. Num a => a -> a -> a
* Rational
r2)
  maybeTimes (VInteger Integer
i) (VRatio Rational
r) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i forall a. Num a => a -> a -> a
* Rational
r)
  maybeTimes (VRatio Rational
r) (VInteger Integer
i) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i forall a. Num a => a -> a -> a
* Rational
r)
  maybeTimes (VFloat Double
x) (VRatio Rational
r) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x forall a. Num a => a -> a -> a
* Rational
r)
  maybeTimes (VRatio Rational
r) (VFloat Double
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x forall a. Num a => a -> a -> a
* Rational
r)
  maybeTimes Val
v1 Val
v2 = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"could not multiply " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Val
v1 forall a. Semigroup a => a -> a -> a
<> String
" and " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Val
v2

  maybeDividedBy :: Val -> Val -> Maybe Val
maybeDividedBy (VInteger Integer
i1) (VInteger Integer
i2) =
    if Integer
i1 forall a. Integral a => a -> a -> a
`mod` Integer
i2 forall a. Eq a => a -> a -> Bool
== Integer
0
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> Val
VInteger (Integer
i1 forall a. Integral a => a -> a -> a
`div` Integer
i2)
      else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i1 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i2)
  maybeDividedBy (VFloat Double
x1) (VFloat Double
x2) = forall a. Multipliable a => a -> a -> Maybe a
maybeTimes (Double -> Val
VFloat Double
x1) (Double -> Val
VFloat (Double
1 forall a. Fractional a => a -> a -> a
/ Double
x2))
  maybeDividedBy (VInteger Integer
i1) (VFloat Double
f2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i1 forall a. Fractional a => a -> a -> a
/ Double
f2)
  maybeDividedBy (VFloat Double
f1) (VInteger Integer
i2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
f1 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i2)
  maybeDividedBy (VLength Length
l) (VInteger Integer
i)
    | Integer
i forall a. Ord a => a -> a -> Bool
>= Integer
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Length
l)
  maybeDividedBy (VLength Length
l) (VFloat Double
f) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength forall a b. (a -> b) -> a -> b
$ Double -> Length -> Length
timesLength (Double
1 forall a. Fractional a => a -> a -> a
/ Double
f) Length
l
  maybeDividedBy (VAngle Double
a) (VInteger Integer
i) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VAngle (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i forall a. Fractional a => a -> a -> a
/ Double
a)
  maybeDividedBy (VInteger Integer
i) (VFraction Double
f) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFraction (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i forall a. Fractional a => a -> a -> a
/ Double
f)
  maybeDividedBy (VFraction Double
f) (VInteger Integer
i) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFraction (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i forall a. Fractional a => a -> a -> a
/ Double
f)
  maybeDividedBy (VFraction Double
f1) (VFraction Double
f2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFraction (Double
f1 forall a. Fractional a => a -> a -> a
/ Double
f2)
  maybeDividedBy (VLength Length
l1) (VLength Length
l2)
    | Length
l1 forall a. Eq a => a -> a -> Bool
== Length
l2 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> Val
VInteger Integer
1
  maybeDividedBy (VLength (LExact Double
l1 LUnit
u1)) (VLength (LExact Double
l2 LUnit
u2))
    | LUnit
u1 forall a. Eq a => a -> a -> Bool
== LUnit
u2 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
l1 forall a. Fractional a => a -> a -> a
/ Double
l2)
    | Just Double
pts1 <- LUnit -> Double -> Maybe Double
toPts LUnit
u1 Double
l1,
      Just Double
pts2 <- LUnit -> Double -> Maybe Double
toPts LUnit
u2 Double
l2 =
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
pts1 forall a. Fractional a => a -> a -> a
/ Double
pts2)
  maybeDividedBy (VLength (LRatio Rational
r)) Val
x
    | Just (VRatio Rational
r') <- forall a. Multipliable a => a -> a -> Maybe a
maybeDividedBy (Rational -> Val
VRatio Rational
r) Val
x =
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength (Rational -> Length
LRatio Rational
r')
  maybeDividedBy (VRatio Rational
r1) (VLength (LRatio Rational
r2)) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (Rational
r1 forall a. Fractional a => a -> a -> a
/ Rational
r2)
  maybeDividedBy (VAngle Double
a1) (VAngle Double
a2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
a1 forall a. Fractional a => a -> a -> a
/ Double
a2)
  maybeDividedBy (VRatio Rational
a1) (VRatio Rational
a2) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (Rational
a1 forall a. Fractional a => a -> a -> a
/ Rational
a2)
  maybeDividedBy (VRatio Rational
r) (VInteger Integer
i) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (Rational
r forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)
  maybeDividedBy (VRatio Rational
r) (VFloat Double
x) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (Rational
r forall a. Fractional a => a -> a -> a
/ forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x)
  maybeDividedBy Val
v1 Val
v2 = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"could not divide " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Val
v1 forall a. Semigroup a => a -> a -> a
<> String
" by " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Val
v2

data Content
  = Txt !Text
  | Lab !Text
  | Elt
      { Content -> Identifier
eltName :: Identifier,
        Content -> Maybe SourcePos
eltPos :: Maybe SourcePos,
        Content -> Map Identifier Val
eltFields :: M.Map Identifier Val
      }
  deriving (Int -> Content -> ShowS
[Content] -> ShowS
Content -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Content] -> ShowS
$cshowList :: [Content] -> ShowS
show :: Content -> String
$cshow :: Content -> String
showsPrec :: Int -> Content -> ShowS
$cshowsPrec :: Int -> Content -> ShowS
Show, Typeable)

instance Eq Content where
  Txt Text
t1 == :: Content -> Content -> Bool
== Txt Text
t2 = Text
t1 forall a. Eq a => a -> a -> Bool
== Text
t2
  Lab Text
t1 == Lab Text
t2 = Text
t1 forall a. Eq a => a -> a -> Bool
== Text
t2
  Elt Identifier
n1 Maybe SourcePos
_ Map Identifier Val
f1 == Elt Identifier
n2 Maybe SourcePos
_ Map Identifier Val
f2 = Identifier
n1 forall a. Eq a => a -> a -> Bool
== Identifier
n2 Bool -> Bool -> Bool
&& Map Identifier Val
f1 forall a. Eq a => a -> a -> Bool
== Map Identifier Val
f2
  Content
_ == Content
_ = Bool
False

instance Ord Content where
  compare :: Content -> Content -> Ordering
compare Txt {} Lab {} = Ordering
LT
  compare Lab {} Elt {} = Ordering
LT
  compare Txt {} Elt {} = Ordering
LT
  compare Lab {} Txt {} = Ordering
GT
  compare Elt {} Lab {} = Ordering
GT
  compare Elt {} Txt {} = Ordering
GT
  compare (Txt Text
t1) (Txt Text
t2) = forall a. Ord a => a -> a -> Ordering
compare Text
t1 Text
t2
  compare (Lab Text
t1) (Lab Text
t2) = forall a. Ord a => a -> a -> Ordering
compare Text
t1 Text
t2
  compare (Elt Identifier
n1 Maybe SourcePos
_ Map Identifier Val
f1) (Elt Identifier
n2 Maybe SourcePos
_ Map Identifier Val
f2) = forall a. Ord a => a -> a -> Ordering
compare (Identifier
n1, Map Identifier Val
f1) (Identifier
n2, Map Identifier Val
f2)

instance IsString Content where
  fromString :: String -> Content
fromString String
x = Text -> Content
Txt (String -> Text
T.pack String
x)

newtype Function = Function (forall m. Monad m => Arguments -> MP m Val)
  deriving (Typeable)

instance Show Function where
  show :: Function -> String
show Function
_ = String
"<function>"

instance Eq Function where
  Function
_ == :: Function -> Function -> Bool
== Function
_ = Bool
False

data Scope
  = FunctionScope
  | BlockScope
  deriving (Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scope] -> ShowS
$cshowList :: [Scope] -> ShowS
show :: Scope -> String
$cshow :: Scope -> String
showsPrec :: Int -> Scope -> ShowS
$cshowsPrec :: Int -> Scope -> ShowS
Show, Eq Scope
Scope -> Scope -> Bool
Scope -> Scope -> Ordering
Scope -> Scope -> Scope
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Scope -> Scope -> Scope
$cmin :: Scope -> Scope -> Scope
max :: Scope -> Scope -> Scope
$cmax :: Scope -> Scope -> Scope
>= :: Scope -> Scope -> Bool
$c>= :: Scope -> Scope -> Bool
> :: Scope -> Scope -> Bool
$c> :: Scope -> Scope -> Bool
<= :: Scope -> Scope -> Bool
$c<= :: Scope -> Scope -> Bool
< :: Scope -> Scope -> Bool
$c< :: Scope -> Scope -> Bool
compare :: Scope -> Scope -> Ordering
$ccompare :: Scope -> Scope -> Ordering
Ord, Scope -> Scope -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c== :: Scope -> Scope -> Bool
Eq)

data FlowDirective
  = FlowNormal
  | FlowBreak
  | FlowContinue
  | FlowReturn Bool
  deriving (Int -> FlowDirective -> ShowS
[FlowDirective] -> ShowS
FlowDirective -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlowDirective] -> ShowS
$cshowList :: [FlowDirective] -> ShowS
show :: FlowDirective -> String
$cshow :: FlowDirective -> String
showsPrec :: Int -> FlowDirective -> ShowS
$cshowsPrec :: Int -> FlowDirective -> ShowS
Show, Eq FlowDirective
FlowDirective -> FlowDirective -> Bool
FlowDirective -> FlowDirective -> Ordering
FlowDirective -> FlowDirective -> FlowDirective
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FlowDirective -> FlowDirective -> FlowDirective
$cmin :: FlowDirective -> FlowDirective -> FlowDirective
max :: FlowDirective -> FlowDirective -> FlowDirective
$cmax :: FlowDirective -> FlowDirective -> FlowDirective
>= :: FlowDirective -> FlowDirective -> Bool
$c>= :: FlowDirective -> FlowDirective -> Bool
> :: FlowDirective -> FlowDirective -> Bool
$c> :: FlowDirective -> FlowDirective -> Bool
<= :: FlowDirective -> FlowDirective -> Bool
$c<= :: FlowDirective -> FlowDirective -> Bool
< :: FlowDirective -> FlowDirective -> Bool
$c< :: FlowDirective -> FlowDirective -> Bool
compare :: FlowDirective -> FlowDirective -> Ordering
$ccompare :: FlowDirective -> FlowDirective -> Ordering
Ord, FlowDirective -> FlowDirective -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlowDirective -> FlowDirective -> Bool
$c/= :: FlowDirective -> FlowDirective -> Bool
== :: FlowDirective -> FlowDirective -> Bool
$c== :: FlowDirective -> FlowDirective -> Bool
Eq)

data EvalState m = EvalState
  { forall (m :: * -> *). EvalState m -> [(Scope, Map Identifier Val)]
evalIdentifiers :: [(Scope, M.Map Identifier Val)],
    -- first item is current block, then superordinate block, etc.
    forall (m :: * -> *). EvalState m -> Map Counter Integer
evalCounters :: M.Map Counter Integer,
    forall (m :: * -> *). EvalState m -> Bool
evalMath :: Bool,
    forall (m :: * -> *). EvalState m -> [ShowRule]
evalShowRules :: [ShowRule],
    forall (m :: * -> *). EvalState m -> Map Identifier Arguments
evalStyles :: M.Map Identifier Arguments,
    forall (m :: * -> *). EvalState m -> FlowDirective
evalFlowDirective :: FlowDirective,
    forall (m :: * -> *). EvalState m -> String -> m ByteString
evalLoadBytes :: FilePath -> m BS.ByteString
  }

emptyEvalState :: EvalState m
emptyEvalState :: forall (m :: * -> *). EvalState m
emptyEvalState = EvalState
    { evalIdentifiers :: [(Scope, Map Identifier Val)]
evalIdentifiers = [],
      evalCounters :: Map Counter Integer
evalCounters = forall a. Monoid a => a
mempty,
      evalMath :: Bool
evalMath = Bool
False,
      evalShowRules :: [ShowRule]
evalShowRules = [],
      evalStyles :: Map Identifier Arguments
evalStyles = forall a. Monoid a => a
mempty,
      evalFlowDirective :: FlowDirective
evalFlowDirective = FlowDirective
FlowNormal,
      evalLoadBytes :: String -> m ByteString
evalLoadBytes = forall a. HasCallStack => a
undefined
    }

data Attempt a
  = Success a
  | Failure String
  deriving (Int -> Attempt a -> ShowS
forall a. Show a => Int -> Attempt a -> ShowS
forall a. Show a => [Attempt a] -> ShowS
forall a. Show a => Attempt a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attempt a] -> ShowS
$cshowList :: forall a. Show a => [Attempt a] -> ShowS
show :: Attempt a -> String
$cshow :: forall a. Show a => Attempt a -> String
showsPrec :: Int -> Attempt a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Attempt a -> ShowS
Show, Attempt a -> Attempt a -> Bool
forall a. Eq a => Attempt a -> Attempt a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attempt a -> Attempt a -> Bool
$c/= :: forall a. Eq a => Attempt a -> Attempt a -> Bool
== :: Attempt a -> Attempt a -> Bool
$c== :: forall a. Eq a => Attempt a -> Attempt a -> Bool
Eq, Attempt a -> Attempt a -> Bool
Attempt a -> Attempt a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Attempt a)
forall a. Ord a => Attempt a -> Attempt a -> Bool
forall a. Ord a => Attempt a -> Attempt a -> Ordering
forall a. Ord a => Attempt a -> Attempt a -> Attempt a
min :: Attempt a -> Attempt a -> Attempt a
$cmin :: forall a. Ord a => Attempt a -> Attempt a -> Attempt a
max :: Attempt a -> Attempt a -> Attempt a
$cmax :: forall a. Ord a => Attempt a -> Attempt a -> Attempt a
>= :: Attempt a -> Attempt a -> Bool
$c>= :: forall a. Ord a => Attempt a -> Attempt a -> Bool
> :: Attempt a -> Attempt a -> Bool
$c> :: forall a. Ord a => Attempt a -> Attempt a -> Bool
<= :: Attempt a -> Attempt a -> Bool
$c<= :: forall a. Ord a => Attempt a -> Attempt a -> Bool
< :: Attempt a -> Attempt a -> Bool
$c< :: forall a. Ord a => Attempt a -> Attempt a -> Bool
compare :: Attempt a -> Attempt a -> Ordering
$ccompare :: forall a. Ord a => Attempt a -> Attempt a -> Ordering
Ord, Typeable)

instance Functor Attempt where
  fmap :: forall a b. (a -> b) -> Attempt a -> Attempt b
fmap a -> b
f (Success a
x) = forall a. a -> Attempt a
Success (a -> b
f a
x)
  fmap a -> b
_ (Failure String
s) = forall a. String -> Attempt a
Failure String
s

instance Applicative Attempt where
  pure :: forall a. a -> Attempt a
pure = forall a. a -> Attempt a
Success
  (Success a -> b
f) <*> :: forall a b. Attempt (a -> b) -> Attempt a -> Attempt b
<*> (Success a
a) = forall a. a -> Attempt a
Success (a -> b
f a
a)
  Failure String
s <*> Attempt a
_ = forall a. String -> Attempt a
Failure String
s
  Attempt (a -> b)
_ <*> Failure String
s = forall a. String -> Attempt a
Failure String
s

instance Monad Attempt where
  return :: forall a. a -> Attempt a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Failure String
s >>= :: forall a b. Attempt a -> (a -> Attempt b) -> Attempt b
>>= a -> Attempt b
_ = forall a. String -> Attempt a
Failure String
s
  Success a
x >>= a -> Attempt b
f = a -> Attempt b
f a
x

instance MonadFail Attempt where
  fail :: forall a. String -> Attempt a
fail = forall a. String -> Attempt a
Failure

data ShowRule
  = ShowRule Selector (forall m. Monad m => Content -> MP m (Seq Content))

instance Show ShowRule where
  show :: ShowRule -> String
show (ShowRule Selector
sel forall (m :: * -> *). Monad m => Content -> MP m (Seq Content)
_) = String
"ShowRule " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Selector
sel forall a. Semigroup a => a -> a -> a
<> String
" <function>"

type MP m = ParsecT [Markup] (EvalState m) m

data Arguments = Arguments
  { Arguments -> [Val]
positional :: [Val],
    Arguments -> OMap Identifier Val
named :: OM.OMap Identifier Val
  }
  deriving (Int -> Arguments -> ShowS
[Arguments] -> ShowS
Arguments -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arguments] -> ShowS
$cshowList :: [Arguments] -> ShowS
show :: Arguments -> String
$cshow :: Arguments -> String
showsPrec :: Int -> Arguments -> ShowS
$cshowsPrec :: Int -> Arguments -> ShowS
Show, Arguments -> Arguments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arguments -> Arguments -> Bool
$c/= :: Arguments -> Arguments -> Bool
== :: Arguments -> Arguments -> Bool
$c== :: Arguments -> Arguments -> Bool
Eq, Typeable)

instance Semigroup Arguments where
  Arguments [Val]
ps1 OMap Identifier Val
ns1 <> :: Arguments -> Arguments -> Arguments
<> Arguments [Val]
ps2 OMap Identifier Val
ns2 =
    [Val] -> OMap Identifier Val -> Arguments
Arguments ([Val] -> [Val] -> [Val]
combinePositional [Val]
ps1 [Val]
ps2) (forall k v.
Ord k =>
(k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
OM.unionWithR (\Identifier
_ Val
_ Val
v -> Val
v) OMap Identifier Val
ns1 OMap Identifier Val
ns2)

-- we want to let a later alignment, color, or length supersede rather than
-- adding to an earlier one. For #set.
combinePositional :: [Val] -> [Val] -> [Val]
combinePositional :: [Val] -> [Val] -> [Val]
combinePositional [] [Val]
ys = [Val]
ys
combinePositional [Val]
xs (Val
y : [Val]
ys) =
  case (Val -> ValType
valType Val
y, Val -> ValType
valType (forall a. [a] -> a
last [Val]
xs)) of
    (ValType
TAlignment, ValType
TAlignment) -> forall a. [a] -> [a]
init [Val]
xs forall a. [a] -> [a] -> [a]
++ Val
y forall a. a -> [a] -> [a]
: [Val]
ys
    (ValType
TLength, ValType
TLength) -> forall a. [a] -> [a]
init [Val]
xs forall a. [a] -> [a] -> [a]
++ Val
y forall a. a -> [a] -> [a]
: [Val]
ys
    (ValType
TAngle, ValType
TAngle) -> forall a. [a] -> [a]
init [Val]
xs forall a. [a] -> [a] -> [a]
++ Val
y forall a. a -> [a] -> [a]
: [Val]
ys
    (ValType
TColor, ValType
TColor) -> forall a. [a] -> [a]
init [Val]
xs forall a. [a] -> [a] -> [a]
++ Val
y forall a. a -> [a] -> [a]
: [Val]
ys
    (ValType, ValType)
_ -> [Val]
xs forall a. [a] -> [a] -> [a]
++ Val
y forall a. a -> [a] -> [a]
: [Val]
ys
combinePositional [Val]
xs [Val]
ys = [Val]
xs forall a. [a] -> [a] -> [a]
++ [Val]
ys

instance Monoid Arguments where
  mappend :: Arguments -> Arguments -> Arguments
mappend = forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: Arguments
  mempty :: Arguments
mempty = [Val] -> OMap Identifier Val -> Arguments
Arguments forall a. Monoid a => a
mempty forall k v. OMap k v
OM.empty

getPositionalArg :: (MonadFail m, MonadPlus m, FromVal a) => Int -> Arguments -> m a
getPositionalArg :: forall (m :: * -> *) a.
(MonadFail m, MonadPlus m, FromVal a) =>
Int -> Arguments -> m a
getPositionalArg Int
idx Arguments
args =
  if forall (t :: * -> *) a. Foldable t => t a -> Int
length (Arguments -> [Val]
positional Arguments
args) forall a. Ord a => a -> a -> Bool
< Int
idx
    then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not enough arguments"
    else forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
fromVal (Arguments -> [Val]
positional Arguments
args forall a. [a] -> Int -> a
!! (Int
idx forall a. Num a => a -> a -> a
- Int
1))

getNamedArg :: (MonadFail m, MonadPlus m, FromVal a) => Identifier -> Arguments -> m a
getNamedArg :: forall (m :: * -> *) a.
(MonadFail m, MonadPlus m, FromVal a) =>
Identifier -> Arguments -> m a
getNamedArg ident :: Identifier
ident@(Identifier Text
name) Arguments
args =
  case forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup Identifier
ident (Arguments -> OMap Identifier Val
named Arguments
args) of
    Maybe Val
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"No argument named " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
name
    Just Val
v -> forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
fromVal Val
v

data Counter
  = CounterCustom !Text
  | CounterLabel !Text
  | CounterSelector !Selector
  | CounterPage
  deriving (Counter -> Counter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Counter -> Counter -> Bool
$c/= :: Counter -> Counter -> Bool
== :: Counter -> Counter -> Bool
$c== :: Counter -> Counter -> Bool
Eq, Eq Counter
Counter -> Counter -> Bool
Counter -> Counter -> Ordering
Counter -> Counter -> Counter
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Counter -> Counter -> Counter
$cmin :: Counter -> Counter -> Counter
max :: Counter -> Counter -> Counter
$cmax :: Counter -> Counter -> Counter
>= :: Counter -> Counter -> Bool
$c>= :: Counter -> Counter -> Bool
> :: Counter -> Counter -> Bool
$c> :: Counter -> Counter -> Bool
<= :: Counter -> Counter -> Bool
$c<= :: Counter -> Counter -> Bool
< :: Counter -> Counter -> Bool
$c< :: Counter -> Counter -> Bool
compare :: Counter -> Counter -> Ordering
$ccompare :: Counter -> Counter -> Ordering
Ord, Int -> Counter -> ShowS
[Counter] -> ShowS
Counter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Counter] -> ShowS
$cshowList :: [Counter] -> ShowS
show :: Counter -> String
$cshow :: Counter -> String
showsPrec :: Int -> Counter -> ShowS
$cshowsPrec :: Int -> Counter -> ShowS
Show, Typeable)

data LUnit = LEm | LPt | LIn | LCm | LMm
  deriving (Int -> LUnit -> ShowS
[LUnit] -> ShowS
LUnit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LUnit] -> ShowS
$cshowList :: [LUnit] -> ShowS
show :: LUnit -> String
$cshow :: LUnit -> String
showsPrec :: Int -> LUnit -> ShowS
$cshowsPrec :: Int -> LUnit -> ShowS
Show, LUnit -> LUnit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LUnit -> LUnit -> Bool
$c/= :: LUnit -> LUnit -> Bool
== :: LUnit -> LUnit -> Bool
$c== :: LUnit -> LUnit -> Bool
Eq, Typeable)

data Length
  = LExact Double LUnit
  | LRatio !Rational
  | LSum Length Length
  deriving (Int -> Length -> ShowS
[Length] -> ShowS
Length -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Length] -> ShowS
$cshowList :: [Length] -> ShowS
show :: Length -> String
$cshow :: Length -> String
showsPrec :: Int -> Length -> ShowS
$cshowsPrec :: Int -> Length -> ShowS
Show, Length -> Length -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Length -> Length -> Bool
$c/= :: Length -> Length -> Bool
== :: Length -> Length -> Bool
$c== :: Length -> Length -> Bool
Eq, Typeable)

instance Semigroup Length where
  (LExact Double
x LUnit
xu) <> :: Length -> Length -> Length
<> (LExact Double
y LUnit
yu)
    | Just (Double
z, LUnit
zu) <- (Double, LUnit) -> (Double, LUnit) -> Maybe (Double, LUnit)
addLengths (Double
x, LUnit
xu) (Double
y, LUnit
yu) =
        Double -> LUnit -> Length
LExact Double
z LUnit
zu
  LRatio Rational
x <> LRatio Rational
y = Rational -> Length
LRatio (Rational
x forall a. Num a => a -> a -> a
+ Rational
y)
  LRatio Rational
x <> LExact Double
0 LUnit
_ = Rational -> Length
LRatio Rational
x
  LExact Double
0 LUnit
_ <> LRatio Rational
x = Rational -> Length
LRatio Rational
x
  LRatio Rational
0 <> LExact Double
x LUnit
u = Double -> LUnit -> Length
LExact Double
x LUnit
u
  LExact Double
x LUnit
u <> LRatio Rational
0 = Double -> LUnit -> Length
LExact Double
x LUnit
u
  Length
x <> Length
y = Length -> Length -> Length
LSum Length
x Length
y

instance Monoid Length where
  mappend :: Length -> Length -> Length
mappend = forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: Length
mempty = Double -> LUnit -> Length
LExact Double
0.0 LUnit
LPt

addLengths :: (Double, LUnit) -> (Double, LUnit) -> Maybe (Double, LUnit)
addLengths :: (Double, LUnit) -> (Double, LUnit) -> Maybe (Double, LUnit)
addLengths (Double
0, LUnit
_xu) (Double
y, LUnit
yu) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
y, LUnit
yu)
addLengths (Double
x, LUnit
xu) (Double
0, LUnit
_yu) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
x, LUnit
xu)
addLengths (Double
x, LUnit
xu) (Double
y, LUnit
yu) =
  if LUnit
xu forall a. Eq a => a -> a -> Bool
== LUnit
yu
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
x forall a. Num a => a -> a -> a
+ Double
y, LUnit
xu)
    else do
      Double
x' <- LUnit -> Double -> Maybe Double
toPts LUnit
xu Double
x
      Double
y' <- LUnit -> Double -> Maybe Double
toPts LUnit
yu Double
y
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
x' forall a. Num a => a -> a -> a
+ Double
y', LUnit
LPt)

timesLength :: Double -> Length -> Length
timesLength :: Double -> Length -> Length
timesLength Double
f (LExact Double
l LUnit
u) = Double -> LUnit -> Length
LExact (Double
f forall a. Num a => a -> a -> a
* Double
l) LUnit
u
timesLength Double
f (LRatio Rational
r) = Rational -> Length
LRatio (forall a. Real a => a -> Rational
toRational Double
f forall a. Num a => a -> a -> a
* Rational
r)
timesLength Double
f (LSum Length
l1 Length
l2) = Length -> Length -> Length
LSum (Double -> Length -> Length
timesLength Double
f Length
l1) (Double -> Length -> Length
timesLength Double
f Length
l2)

toPts :: LUnit -> Double -> Maybe Double
toPts :: LUnit -> Double -> Maybe Double
toPts LUnit
LPt Double
x = forall a. a -> Maybe a
Just Double
x
toPts LUnit
LEm Double
_ = forall a. Maybe a
Nothing
toPts LUnit
LIn Double
x = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double
x forall a. Num a => a -> a -> a
* Double
72.0
toPts LUnit
LCm Double
x = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double
x forall a. Num a => a -> a -> a
* Double
28.35
toPts LUnit
LMm Double
x = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double
x forall a. Num a => a -> a -> a
* Double
283.5

-- boolean is true if we need to include parens for LSum
renderLength :: Bool -> Length -> Text
renderLength :: Bool -> Length -> Text
renderLength Bool
parens (LSum Length
l1 Length
l2) =
  (if Bool
parens then (\Text
x -> Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> Text
")") else forall a. a -> a
id)
    (Bool -> Length -> Text
renderLength Bool
True Length
l1 forall a. Semigroup a => a -> a -> a
<> Text
" + " forall a. Semigroup a => a -> a -> a
<> Bool -> Length -> Text
renderLength Bool
True Length
l2)
renderLength Bool
_ (LExact Double
x LUnit
u) =
  String -> Text
T.pack (forall a. Show a => a -> String
show Double
x) forall a. Semigroup a => a -> a -> a
<> LUnit -> Text
renderUnit LUnit
u
renderLength Bool
_ (LRatio Rational
x) = Rational -> Text
toPercent Rational
x

renderUnit :: LUnit -> Text
renderUnit :: LUnit -> Text
renderUnit LUnit
LEm = Text
"em"
renderUnit LUnit
LPt = Text
"pt"
renderUnit LUnit
LIn = Text
"in"
renderUnit LUnit
LCm = Text
"cm"
renderUnit LUnit
LMm = Text
"mm"

compareLength :: Length -> Length -> Maybe Ordering
compareLength :: Length -> Length -> Maybe Ordering
compareLength (LExact Double
x LUnit
xu) (LExact Double
y LUnit
yu)
  | LUnit
xu forall a. Eq a => a -> a -> Bool
== LUnit
yu = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare Double
x Double
y
  | Bool
otherwise = do
      Double
x' <- LUnit -> Double -> Maybe Double
toPts LUnit
xu Double
x
      Double
y' <- LUnit -> Double -> Maybe Double
toPts LUnit
yu Double
y
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare Double
x' Double
y'
compareLength (LRatio Rational
x) (LRatio Rational
y) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Ord a => a -> a -> Ordering
compare Rational
x Rational
y)
compareLength (LSum Length
x1 Length
y1) (LSum Length
x2 Length
y2) = do
  Ordering
z <- Length -> Length -> Maybe Ordering
compareLength Length
x1 Length
x2
  if Ordering
z forall a. Eq a => a -> a -> Bool
== Ordering
EQ
    then Length -> Length -> Maybe Ordering
compareLength Length
y1 Length
y2
    else forall (m :: * -> *) a. MonadPlus m => m a
mzero
compareLength Length
_ Length
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

negateLength :: Length -> Length
negateLength :: Length -> Length
negateLength (LExact Double
x LUnit
u) = Double -> LUnit -> Length
LExact (forall a. Num a => a -> a
negate Double
x) LUnit
u
negateLength (LRatio Rational
x) = Rational -> Length
LRatio (forall a. Num a => a -> a
negate Rational
x)
negateLength (LSum Length
x Length
y) = Length -> Length -> Length
LSum (Length -> Length
negateLength Length
x) (Length -> Length
negateLength Length
y)

data Horiz = HorizStart | HorizEnd | HorizLeft | HorizCenter | HorizRight
  deriving (Int -> Horiz -> ShowS
[Horiz] -> ShowS
Horiz -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Horiz] -> ShowS
$cshowList :: [Horiz] -> ShowS
show :: Horiz -> String
$cshow :: Horiz -> String
showsPrec :: Int -> Horiz -> ShowS
$cshowsPrec :: Int -> Horiz -> ShowS
Show, Horiz -> Horiz -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Horiz -> Horiz -> Bool
$c/= :: Horiz -> Horiz -> Bool
== :: Horiz -> Horiz -> Bool
$c== :: Horiz -> Horiz -> Bool
Eq, Eq Horiz
Horiz -> Horiz -> Bool
Horiz -> Horiz -> Ordering
Horiz -> Horiz -> Horiz
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Horiz -> Horiz -> Horiz
$cmin :: Horiz -> Horiz -> Horiz
max :: Horiz -> Horiz -> Horiz
$cmax :: Horiz -> Horiz -> Horiz
>= :: Horiz -> Horiz -> Bool
$c>= :: Horiz -> Horiz -> Bool
> :: Horiz -> Horiz -> Bool
$c> :: Horiz -> Horiz -> Bool
<= :: Horiz -> Horiz -> Bool
$c<= :: Horiz -> Horiz -> Bool
< :: Horiz -> Horiz -> Bool
$c< :: Horiz -> Horiz -> Bool
compare :: Horiz -> Horiz -> Ordering
$ccompare :: Horiz -> Horiz -> Ordering
Ord, Typeable)

data Vert = VertTop | VertHorizon | VertBottom
  deriving (Int -> Vert -> ShowS
[Vert] -> ShowS
Vert -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vert] -> ShowS
$cshowList :: [Vert] -> ShowS
show :: Vert -> String
$cshow :: Vert -> String
showsPrec :: Int -> Vert -> ShowS
$cshowsPrec :: Int -> Vert -> ShowS
Show, Vert -> Vert -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vert -> Vert -> Bool
$c/= :: Vert -> Vert -> Bool
== :: Vert -> Vert -> Bool
$c== :: Vert -> Vert -> Bool
Eq, Eq Vert
Vert -> Vert -> Bool
Vert -> Vert -> Ordering
Vert -> Vert -> Vert
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Vert -> Vert -> Vert
$cmin :: Vert -> Vert -> Vert
max :: Vert -> Vert -> Vert
$cmax :: Vert -> Vert -> Vert
>= :: Vert -> Vert -> Bool
$c>= :: Vert -> Vert -> Bool
> :: Vert -> Vert -> Bool
$c> :: Vert -> Vert -> Bool
<= :: Vert -> Vert -> Bool
$c<= :: Vert -> Vert -> Bool
< :: Vert -> Vert -> Bool
$c< :: Vert -> Vert -> Bool
compare :: Vert -> Vert -> Ordering
$ccompare :: Vert -> Vert -> Ordering
Ord, Typeable)

data Color
  = RGB Rational Rational Rational Rational
  | CMYK Rational Rational Rational Rational
  | Luma Rational
  deriving (Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show, Color -> Color -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq, Eq Color
Color -> Color -> Bool
Color -> Color -> Ordering
Color -> Color -> Color
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmax :: Color -> Color -> Color
>= :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c< :: Color -> Color -> Bool
compare :: Color -> Color -> Ordering
$ccompare :: Color -> Color -> Ordering
Ord, Typeable)

data Direction = Ltr | Rtl | Ttb | Btt
  deriving (Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show, Direction -> Direction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, Eq Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmax :: Direction -> Direction -> Direction
>= :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c< :: Direction -> Direction -> Bool
compare :: Direction -> Direction -> Ordering
$ccompare :: Direction -> Direction -> Ordering
Ord, Typeable)

prettyVal :: Val -> P.Doc
prettyVal :: Val -> Doc
prettyVal Val
expr =
  case Val
expr of
    VContent Seq Content
cs -> Seq Content -> Doc
prettyContent Seq Content
cs
    VString Text
t -> Doc
"\"" forall a. Semigroup a => a -> a -> a
<> Text -> Doc
escString Text
t forall a. Semigroup a => a -> a -> a
<> Doc
"\""
    VRegex RE
re -> String -> Doc
P.text (forall a. Show a => a -> String
show RE
re)
    Val
VAuto -> Doc
"auto"
    Val
VNone -> Doc
"none"
    VBoolean Bool
True -> Doc
"true"
    VBoolean Bool
False -> Doc
"false"
    VFloat Double
x -> String -> Doc
P.text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
x
    VRatio Rational
x -> Text -> Doc
text forall a b. (a -> b) -> a -> b
$ Rational -> Text
toPercent Rational
x
    VInteger Integer
x -> String -> Doc
P.text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Integer
x
    VAngle Double
x -> String -> Doc
P.text (forall a. Show a => a -> String
show Double
x forall a. Semigroup a => a -> a -> a
<> String
"deg")
    VLength Length
len -> Text -> Doc
text forall a b. (a -> b) -> a -> b
$ Bool -> Length -> Text
renderLength Bool
False Length
len
    VAlignment Maybe Horiz
x Maybe Vert
y -> Text -> Doc
text forall a b. (a -> b) -> a -> b
$
      case (Maybe Horiz
x, Maybe Vert
y) of
        (Maybe Horiz
Nothing, Maybe Vert
Nothing) -> forall a. Monoid a => a
mempty
        (Just Horiz
x', Maybe Vert
Nothing) -> Horiz -> Text
renderHoriz Horiz
x'
        (Maybe Horiz
Nothing, Just Vert
y') -> Vert -> Text
renderVert Vert
y'
        (Just Horiz
x', Just Vert
y') ->
          Text
"Axes(" forall a. Semigroup a => a -> a -> a
<> Horiz -> Text
renderHoriz Horiz
x' forall a. Semigroup a => a -> a -> a
<> Text
", " forall a. Semigroup a => a -> a -> a
<> Vert -> Text
renderVert Vert
y' forall a. Semigroup a => a -> a -> a
<> Text
")"
      where
        renderHoriz :: Horiz -> Text
renderHoriz = Text -> Text
T.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
5 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
        renderVert :: Vert -> Text
renderVert = Text -> Text
T.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
    VFraction Double
x -> String -> Doc
P.text (forall a. Show a => a -> String
show Double
x forall a. Semigroup a => a -> a -> a
<> String
"fr")
    VArray Vector Val
xs ->
      Doc -> Doc
P.parens
        ( [Doc] -> Doc
P.cat forall a b. (a -> b) -> a -> b
$
            Doc -> [Doc] -> [Doc]
P.punctuate Doc
", " forall a b. (a -> b) -> a -> b
$
              forall a b. (a -> b) -> [a] -> [b]
map Val -> Doc
prettyVal (forall a. Vector a -> [a]
V.toList Vector Val
xs)
        )
    VTermItem Seq Content
t Seq Content
d -> Val -> Doc
prettyVal (Vector Val -> Val
VArray [Seq Content -> Val
VContent Seq Content
t, Seq Content -> Val
VContent Seq Content
d])
    VDict OMap Identifier Val
m ->
      Doc -> Doc
P.parens
        ( [Doc] -> Doc
P.sep forall a b. (a -> b) -> a -> b
$
            Doc -> [Doc] -> [Doc]
P.punctuate Doc
"," forall a b. (a -> b) -> a -> b
$
              ( forall a b. (a -> b) -> [a] -> [b]
map
                  ( \(Identifier Text
k, Val
v) ->
                      Text -> Doc
text Text
k forall a. Semigroup a => a -> a -> a
<> Doc
": " forall a. Semigroup a => a -> a -> a
<> Val -> Doc
prettyVal Val
v
                  )
                  (forall k v. OMap k v -> [(k, v)]
OM.assocs OMap Identifier Val
m)
              )
        )
    VDirection Direction
d -> Text -> Doc
text forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Direction
d
    VFunction Maybe Identifier
_ Map Identifier Val
_ Function
_ -> forall a. Monoid a => a
mempty
    VLabel Text
_ -> forall a. Monoid a => a
mempty
    VCounter Counter
_ -> forall a. Monoid a => a
mempty
    VColor (RGB Rational
r Rational
g Rational
b Rational
o) ->
      Doc
"rgb("
        forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (Rational -> Text
toPercent Rational
r)
        forall a. Semigroup a => a -> a -> a
<> Doc
","
        forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (Rational -> Text
toPercent Rational
g)
        forall a. Semigroup a => a -> a -> a
<> Doc
","
        forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (Rational -> Text
toPercent Rational
b)
        forall a. Semigroup a => a -> a -> a
<> Doc
","
        forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (Rational -> Text
toPercent Rational
o)
        forall a. Semigroup a => a -> a -> a
<> Doc
")"
    VColor (CMYK Rational
c Rational
m Rational
y Rational
k) ->
      Doc
"cmyk("
        forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (Rational -> Text
toPercent Rational
c)
        forall a. Semigroup a => a -> a -> a
<> Doc
","
        forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (Rational -> Text
toPercent Rational
m)
        forall a. Semigroup a => a -> a -> a
<> Doc
","
        forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (Rational -> Text
toPercent Rational
y)
        forall a. Semigroup a => a -> a -> a
<> Doc
","
        forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (Rational -> Text
toPercent Rational
k)
        forall a. Semigroup a => a -> a -> a
<> Doc
")"
    VColor (Luma Rational
g) -> Doc
"luma(" forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (Rational -> Text
toPercent Rational
g) forall a. Semigroup a => a -> a -> a
<> Doc
")"
    VModule (Identifier Text
modid) Map Identifier Val
_ -> Doc
"<module " forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text Text
modid forall a. Semigroup a => a -> a -> a
<> Doc
">"
    VArguments Arguments
args ->
      Doc -> Doc
P.parens
        ( [Doc] -> Doc
P.sep
            ( Doc -> [Doc] -> [Doc]
P.punctuate
                Doc
","
                ( [ [Doc] -> Doc
P.sep
                      ( Doc -> [Doc] -> [Doc]
P.punctuate
                          Doc
","
                          ( forall a b. (a -> b) -> [a] -> [b]
map
                              ( \(Identifier Text
k, Val
v) ->
                                  Text -> Doc
text Text
k forall a. Semigroup a => a -> a -> a
<> Doc
": " forall a. Semigroup a => a -> a -> a
<> Val -> Doc
prettyVal Val
v
                              )
                              (forall k v. OMap k v -> [(k, v)]
OM.assocs (Arguments -> OMap Identifier Val
named Arguments
args))
                          )
                      )
                    | Bool -> Bool
not (forall k v. OMap k v -> Bool
OM.null (Arguments -> OMap Identifier Val
named Arguments
args))
                  ]
                    forall a. [a] -> [a] -> [a]
++ [ [Doc] -> Doc
P.cat (Doc -> [Doc] -> [Doc]
P.punctuate Doc
", " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Val -> Doc
prettyVal (Arguments -> [Val]
positional Arguments
args))
                         | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Arguments -> [Val]
positional Arguments
args))
                       ]
                )
            )
        )
    VSymbol (Symbol Text
t Bool
_ [(Set Text, Text)]
_) -> Text -> Doc
text Text
t
    VSelector Selector
_ -> forall a. Monoid a => a
mempty
    Val
VStyles -> forall a. Monoid a => a
mempty

escString :: Text -> P.Doc
escString :: Text -> Doc
escString =
  String -> Doc
P.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
  where
    go :: Char -> String
    go :: Char -> String
go Char
'"' = String
"\\\""
    go Char
'\\' = String
"\\\\"
    go Char
'\n' = String
"\\n"
    go Char
'\r' = String
"\\r"
    go Char
'\t' = String
"\\t"
    go Char
x = [Char
x]

prettyContent :: Seq Content -> P.Doc
prettyContent :: Seq Content -> Doc
prettyContent Seq Content
cs
  | forall a. Seq a -> Int
Seq.length Seq Content
cs forall a. Eq a => a -> a -> Bool
== Int
1 = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Content -> Doc
go Seq Content
cs
  | Bool
otherwise =
      Doc -> Doc
P.braces
        ( Doc
P.space
            forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
P.cat (Doc -> [Doc] -> [Doc]
P.punctuate Doc
", " (forall a b. (a -> b) -> [a] -> [b]
map Content -> Doc
go (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Content
cs)))
            forall a. Semigroup a => a -> a -> a
<> Doc
P.space
        )
  where
    go :: Content -> Doc
go (Txt Text
t) = Doc
"[" forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text Text
t forall a. Semigroup a => a -> a -> a
<> Doc
"]"
    go (Lab Text
l) = Doc
"<" forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text Text
l forall a. Semigroup a => a -> a -> a
<> Doc
">"
    go (Elt (Identifier Text
name) Maybe SourcePos
_ Map Identifier Val
fields) =
      Text -> Doc
text Text
name
        forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
P.parens
          ( [Doc] -> Doc
P.cat forall a b. (a -> b) -> a -> b
$
              Doc -> [Doc] -> [Doc]
P.punctuate
                Doc
", "
                ( forall a b. (a -> b) -> [a] -> [b]
map
                    ( \(Identifier Text
k, Val
v) ->
                        Text -> Doc
text Text
k forall a. Semigroup a => a -> a -> a
<> Doc
": " forall a. Semigroup a => a -> a -> a
<> Val -> Doc
prettyVal Val
v
                    )
                    (forall k a. Map k a -> [(k, a)]
M.toList Map Identifier Val
fields)
                )
          )

valToContent :: Val -> Seq Content
valToContent :: Val -> Seq Content
valToContent (VContent Seq Content
x) = Seq Content
x
valToContent Val
VNone = forall a. Monoid a => a
mempty
valToContent (VString Text
t) = forall a. a -> Seq a
Seq.singleton forall a b. (a -> b) -> a -> b
$ Text -> Content
Txt Text
t
valToContent (VLabel Text
t) = forall a. a -> Seq a
Seq.singleton forall a b. (a -> b) -> a -> b
$ Text -> Content
Lab Text
t
valToContent Val
x = forall a. a -> Seq a
Seq.singleton forall a b. (a -> b) -> a -> b
$ Text -> Content
Txt forall a b. (a -> b) -> a -> b
$ Val -> Text
repr Val
x

renderStyle :: P.Style
renderStyle :: Style
renderStyle = Mode -> Int -> Float -> Style
P.Style Mode
P.PageMode Int
60 Float
2.0

repr :: Val -> Text
repr :: Val -> Text
repr = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Doc -> String
P.renderStyle Style
renderStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val -> Doc
prettyVal

toPercent :: Rational -> Text
toPercent :: Rational -> Text
toPercent Rational
n =
  String -> Text
T.pack (forall a. Show a => a -> String
show (forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
100 forall a. Num a => a -> a -> a
* Rational
n) :: Integer)) forall a. Semigroup a => a -> a -> a
<> Text
"%"

text :: Text -> P.Doc
text :: Text -> Doc
text Text
t = String -> Doc
P.text forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t

lookupIdentifier :: Monad m => Identifier -> MP m Val
lookupIdentifier :: forall (m :: * -> *). Monad m => Identifier -> MP m Val
lookupIdentifier Identifier
ident = do
  let go :: [(a, Map Identifier a)] -> m a
go [] = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Identifier
ident forall a. Semigroup a => a -> a -> a
<> String
" not found"
      go ((a
_, Map Identifier a
i) : [(a, Map Identifier a)]
is) = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
ident Map Identifier a
i of
        Just a
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
        Maybe a
Nothing -> [(a, Map Identifier a)] -> m a
go [(a, Map Identifier a)]
is
  forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *} {a} {a}.
MonadFail m =>
[(a, Map Identifier a)] -> m a
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). EvalState m -> [(Scope, Map Identifier Val)]
evalIdentifiers