{-# 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 (..),
    Operations (..),
    XdgDirectory (..),
    EvalState (..),
    emptyEvalState,
    ShowRule (..),
    Counter (..),
    LUnit (..),
    Length (..),
    renderLength,
    Horiz (..),
    Vert (..),
    Color (..),
    Direction (..),
    Identifier (..), -- reexported
    lookupIdentifier,
    joinVals,
    prettyVal,
    valToContent,
    prettyType,
    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, catMaybes)
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 Toml
import qualified Toml.FromValue as Toml
import qualified Toml.Pretty as Toml
import qualified Text.PrettyPrint as P
import Text.Read (readMaybe)
import Typst.Regex (RE, makeLiteralRE)
import Typst.Syntax (Identifier (..), Markup)
import Data.Time (UTCTime, Day, DiffTime, timeOfDayToTime, localDay, localTimeOfDay)
import Data.Time.Format (defaultTimeLocale, formatTime)
import System.Directory (XdgDirectory(..))

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
  | VDateTime (Maybe Day) (Maybe DiffTime)
  | 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
  | VVersion [Integer]
  | VType !ValType
  deriving (Int -> Val -> ShowS
[Val] -> ShowS
Val -> String
(Int -> Val -> ShowS)
-> (Val -> String) -> ([Val] -> ShowS) -> Show Val
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Val -> ShowS
showsPrec :: Int -> Val -> ShowS
$cshow :: Val -> String
show :: Val -> String
$cshowList :: [Val] -> ShowS
showList :: [Val] -> ShowS
Show, Val -> Val -> Bool
(Val -> Val -> Bool) -> (Val -> Val -> Bool) -> Eq Val
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Val -> Val -> Bool
== :: Val -> Val -> Bool
$c/= :: Val -> Val -> Bool
/= :: Val -> Val -> Bool
Eq, Typeable)

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

instance Toml.FromValue Val where
  fromValue :: Value -> Matcher Val
fromValue = Val -> Matcher Val
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Matcher Val) -> (Value -> Val) -> Value -> Matcher Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Val
tomlToVal

tomlToVal :: Toml.Value -> Val
tomlToVal :: Value -> Val
tomlToVal (Toml.Bool Bool
x) = Bool -> Val
VBoolean Bool
x
tomlToVal (Toml.Integer Integer
x) = Integer -> Val
VInteger Integer
x
tomlToVal (Toml.String String
x) = Text -> Val
VString (String -> Text
T.pack String
x)
tomlToVal (Toml.Float Double
x) = Double -> Val
VFloat Double
x
tomlToVal (Toml.TimeOfDay TimeOfDay
x) = Maybe Day -> Maybe DiffTime -> Val
VDateTime Maybe Day
forall a. Maybe a
Nothing (DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just (TimeOfDay -> DiffTime
timeOfDayToTime TimeOfDay
x))
tomlToVal (Toml.Day Day
x) = Maybe Day -> Maybe DiffTime -> Val
VDateTime (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
x) Maybe DiffTime
forall a. Maybe a
Nothing
tomlToVal (Toml.LocalTime LocalTime
x) = Maybe Day -> Maybe DiffTime -> Val
VDateTime (Day -> Maybe Day
forall a. a -> Maybe a
Just (LocalTime -> Day
localDay LocalTime
x)) (DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just (TimeOfDay -> DiffTime
timeOfDayToTime (LocalTime -> TimeOfDay
localTimeOfDay LocalTime
x)))
tomlToVal (Toml.Array [Value]
x) = Vector Val -> Val
VArray ([Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ((Value -> Val) -> [Value] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Val
tomlToVal [Value]
x))
tomlToVal (Toml.Table Table
x) = OMap Identifier Val -> Val
VDict ([(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList [(Text -> Identifier
Identifier (String -> Text
T.pack String
k), Value -> Val
tomlToVal Value
v) | (String
k,Value
v) <- Table -> [(String, Value)]
forall k a. Map k a -> [(k, a)]
M.assocs Table
x])
  -- typst specifies that unsupported datetimes map to strings and we don't have a place for the timezone
tomlToVal v :: Value
v@Toml.ZonedTime{} = Text -> Val
VString (String -> Text
T.pack (TomlDoc -> String
forall a. Show a => a -> String
show (Value -> TomlDoc
Toml.prettyValue Value
v)))

data ValType
  = TNone
  | TAuto
  | TBoolean
  | TInteger
  | TFloat
  | TRatio
  | TLength
  | TAlignment
  | TAngle
  | TFraction
  | TColor
  | TSymbol
  | TString
  | TRegex
  | TDateTime
  | TContent
  | TArray
  | TDict
  | TTermItem
  | TDirection
  | TFunction
  | TArguments
  | TModule
  | TSelector
  | TStyles
  | TLabel
  | TCounter
  | TLocation
  | TVersion
  | TType
  | TAny
  | ValType :|: ValType
  deriving (Int -> ValType -> ShowS
[ValType] -> ShowS
ValType -> String
(Int -> ValType -> ShowS)
-> (ValType -> String) -> ([ValType] -> ShowS) -> Show ValType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValType -> ShowS
showsPrec :: Int -> ValType -> ShowS
$cshow :: ValType -> String
show :: ValType -> String
$cshowList :: [ValType] -> ShowS
showList :: [ValType] -> ShowS
Show, ValType -> ValType -> Bool
(ValType -> ValType -> Bool)
-> (ValType -> ValType -> Bool) -> Eq ValType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValType -> ValType -> Bool
== :: ValType -> ValType -> Bool
$c/= :: ValType -> ValType -> Bool
/= :: ValType -> ValType -> Bool
Eq, Eq ValType
Eq ValType =>
(ValType -> ValType -> Ordering)
-> (ValType -> ValType -> Bool)
-> (ValType -> ValType -> Bool)
-> (ValType -> ValType -> Bool)
-> (ValType -> ValType -> Bool)
-> (ValType -> ValType -> ValType)
-> (ValType -> ValType -> ValType)
-> Ord ValType
ValType -> ValType -> Bool
ValType -> ValType -> Ordering
ValType -> ValType -> ValType
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
$ccompare :: ValType -> ValType -> Ordering
compare :: ValType -> ValType -> Ordering
$c< :: ValType -> ValType -> Bool
< :: ValType -> ValType -> Bool
$c<= :: ValType -> ValType -> Bool
<= :: ValType -> ValType -> Bool
$c> :: ValType -> ValType -> Bool
> :: ValType -> ValType -> Bool
$c>= :: ValType -> ValType -> Bool
>= :: ValType -> ValType -> Bool
$cmax :: ValType -> ValType -> ValType
max :: ValType -> ValType -> ValType
$cmin :: ValType -> ValType -> ValType
min :: ValType -> ValType -> ValType
Ord, 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
    VDateTime {} -> ValType
TDateTime
    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
    VVersion {} -> ValType
TVersion
    VType {} -> ValType
TType

hasType :: ValType -> Val -> Bool
hasType :: ValType -> Val -> Bool
hasType ValType
TAny Val
_ = Bool
True
hasType ValType
TLocation (VDict OMap Identifier Val
m) =
  Maybe Val -> Bool
forall a. Maybe a -> Bool
isJust (Identifier -> OMap Identifier Val -> Maybe Val
forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup Identifier
"page" OMap Identifier Val
m Maybe Val -> Maybe Val -> Maybe Val
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Identifier -> OMap Identifier Val -> Maybe Val
forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup Identifier
"x" OMap Identifier Val
m Maybe Val -> Maybe Val -> Maybe Val
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Identifier -> OMap Identifier Val -> Maybe Val
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 ValType -> ValType -> Bool
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 = Val -> m Val
forall a. a -> m a
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 = Seq Content -> m (Seq Content)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq Content -> m (Seq Content))
-> (Val -> Seq Content) -> Val -> m (Seq Content)
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) = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> m [Text] -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> m Text) -> [Content] -> m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> m Text
forall {f :: * -> *}.
(MonadFail f, MonadPlus f) =>
Content -> f Text
go (Seq Content -> [Content]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Content
cs)
    where
      go :: Content -> f Text
go (Txt Text
t) = Text -> f Text
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
      go (Elt Identifier
"text" Maybe SourcePos
_ Map Identifier Val
fs) =
        f Text -> (Val -> f Text) -> Maybe Val -> f Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (String -> f Text
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"text element has no body")
          Val -> f Text
forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m Text
fromVal
          (Identifier -> Map Identifier Val -> Maybe Val
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
"body" Map Identifier Val
fs)
      go Content
_ = String -> f Text
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a text element"
  fromVal (VString Text
t) = Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
  fromVal Val
_ = String -> m Text
forall a. String -> m a
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 = (Text -> String) -> m Text -> m String
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack (m Text -> m String) -> (Val -> m Text) -> Val -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val -> m Text
forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m Text
fromVal

instance FromVal RE where
  fromVal :: forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m RE
fromVal (VString Text
t) = Text -> m RE
forall (m :: * -> *). MonadFail m => Text -> m RE
makeLiteralRE Text
t
  fromVal (VRegex RE
re) = RE -> m RE
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RE
re
  fromVal Val
_ = String -> m RE
forall a. String -> m a
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 -> Integer -> m Integer
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x
      VFloat Double
x -> Integer -> m Integer
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
x
      VRatio Rational
x -> Integer -> m Integer
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Rational
x
      VBoolean Bool
x -> Integer -> m Integer
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ if Bool
x then Integer
1 else Integer
0
      VString Text
x | Just (Integer
xint :: Integer) <- String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
x) -> Integer -> m Integer
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
xint
      Val
_ -> String -> m Integer
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Integer) -> String -> m Integer
forall a b. (a -> b) -> a -> b
$ String
"Cannot convert " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Val -> String
forall a. Show a => a -> String
show Val
val String -> ShowS
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 = (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Integer -> Int) (Integer -> Int) -> m Integer -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> m Integer
forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
forall (m :: * -> *).
(MonadPlus m, MonadFail m) =>
Val -> m Integer
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 -> Rational -> m Rational
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rational
x
      VInteger Integer
x -> Rational -> m Rational
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> m Rational) -> Rational -> m Rational
forall a b. (a -> b) -> a -> b
$ Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x
      VString Text
x | Just (Rational
xrat :: Rational) <- String -> Maybe Rational
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
x) -> Rational -> m Rational
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rational
xrat
      Val
_ -> String -> m Rational
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Rational) -> String -> m Rational
forall a b. (a -> b) -> a -> b
$ String
"Cannot convert " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Val -> String
forall a. Show a => a -> String
show Val
val String -> ShowS
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 -> Double -> m Double
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> m Double) -> Double -> m Double
forall a b. (a -> b) -> a -> b
$ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x
      VFloat Double
x -> Double -> m Double
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
x
      VRatio Rational
x -> Double -> m Double
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> m Double) -> Double -> m Double
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
x
      VString Text
x | Just (Double
xdb :: Double) <- String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
x) -> Double -> m Double
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
xdb
      Val
_ -> String -> m Double
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Double) -> String -> m Double
forall a b. (a -> b) -> a -> b
$ String
"Cannot convert " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Val -> String
forall a. Show a => a -> String
show Val
val String -> ShowS
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) = Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
  fromVal Val
val = String -> m Bool
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Bool) -> String -> m Bool
forall a b. (a -> b) -> a -> b
$ String
"Cannot convert " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Val -> String
forall a. Show a => a -> String
show Val
val String -> ShowS
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) = Length -> m Length
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Length
x
  fromVal (VRatio Rational
x) = Length -> m Length
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Length -> m Length) -> Length -> m Length
forall a b. (a -> b) -> a -> b
$ Rational -> Length
LRatio Rational
x
  fromVal Val
val = String -> m Length
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Length) -> String -> m Length
forall a b. (a -> b) -> a -> b
$ String
"Cannot convert " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Val -> String
forall a. Show a => a -> String
show Val
val String -> ShowS
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) = Function -> m Function
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Function
f
  fromVal Val
val = String -> m Function
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Function) -> String -> m Function
forall a b. (a -> b) -> a -> b
$ Val -> String
forall a. Show a => a -> String
show Val
val String -> ShowS
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) = Direction -> m Direction
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Direction
d
  fromVal Val
val = String -> m Direction
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Direction) -> String -> m Direction
forall a b. (a -> b) -> a -> b
$ Val -> String
forall a. Show a => a -> String
show Val
val String -> ShowS
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) = Counter -> m Counter
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Counter -> m Counter) -> Counter -> m Counter
forall a b. (a -> b) -> a -> b
$ Text -> Counter
CounterCustom Text
t
  fromVal (VLabel Text
t) = Counter -> m Counter
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Counter -> m Counter) -> Counter -> m Counter
forall a b. (a -> b) -> a -> b
$ Text -> Counter
CounterLabel Text
t
  fromVal (VFunction (Just Identifier
"page") Map Identifier Val
_ Function
_) = Counter -> m Counter
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Counter -> m Counter) -> Counter -> m Counter
forall a b. (a -> b) -> a -> b
$ Counter
CounterPage
  fromVal (VFunction (Just Identifier
name) Map Identifier Val
_ Function
_) = Counter -> m Counter
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Counter -> m Counter) -> Counter -> m Counter
forall a b. (a -> b) -> a -> b
$ Selector -> Counter
CounterSelector (Selector -> Counter) -> Selector -> Counter
forall a b. (a -> b) -> a -> b
$ Identifier -> [(Identifier, Val)] -> Selector
SelectElement Identifier
name []
  fromVal (VSelector Selector
s) = Counter -> m Counter
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Counter -> m Counter) -> Counter -> m Counter
forall a b. (a -> b) -> a -> b
$ Selector -> Counter
CounterSelector Selector
s
  fromVal Val
val = String -> m Counter
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Counter) -> String -> m Counter
forall a b. (a -> b) -> a -> b
$ Val -> String
forall a. Show a => a -> String
show Val
val String -> ShowS
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) = Selector -> m Selector
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Selector
s
  fromVal Val
val = String -> m Selector
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Selector) -> String -> m Selector
forall a b. (a -> b) -> a -> b
$ Val -> String
forall a. Show a => a -> String
show Val
val String -> ShowS
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 = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  fromVal Val
x = (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> m a
forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m a
fromVal Val
x) m (Maybe a) -> m (Maybe a) -> m (Maybe a)
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
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) = (Val -> m a) -> Vector Val -> m (Vector a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM Val -> m a
forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m a
fromVal Vector Val
v
  fromVal Val
val = String -> m (Vector a)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (Vector a)) -> String -> m (Vector a)
forall a b. (a -> b) -> a -> b
$ String
"Could not convert " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Val -> String
forall a. Show a => a -> String
show Val
val String -> ShowS
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
(Int -> Selector -> ShowS)
-> (Selector -> String) -> ([Selector] -> ShowS) -> Show Selector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Selector -> ShowS
showsPrec :: Int -> Selector -> ShowS
$cshow :: Selector -> String
show :: Selector -> String
$cshowList :: [Selector] -> ShowS
showList :: [Selector] -> ShowS
Show, Selector -> Selector -> Bool
(Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool) -> Eq Selector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Selector -> Selector -> Bool
== :: Selector -> Selector -> Bool
$c/= :: Selector -> Selector -> Bool
/= :: Selector -> Selector -> Bool
Eq, Eq Selector
Eq Selector =>
(Selector -> Selector -> Ordering)
-> (Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool)
-> (Selector -> Selector -> Selector)
-> (Selector -> Selector -> Selector)
-> Ord 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
$ccompare :: Selector -> Selector -> Ordering
compare :: Selector -> Selector -> Ordering
$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
>= :: Selector -> Selector -> Bool
$cmax :: Selector -> Selector -> Selector
max :: Selector -> Selector -> Selector
$cmin :: Selector -> Selector -> Selector
min :: Selector -> Selector -> Selector
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
(Int -> Symbol -> ShowS)
-> (Symbol -> String) -> ([Symbol] -> ShowS) -> Show Symbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Symbol -> ShowS
showsPrec :: Int -> Symbol -> ShowS
$cshow :: Symbol -> String
show :: Symbol -> String
$cshowList :: [Symbol] -> ShowS
showList :: [Symbol] -> ShowS
Show, Symbol -> Symbol -> Bool
(Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool) -> Eq Symbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Symbol -> Symbol -> Bool
== :: Symbol -> Symbol -> Bool
$c/= :: Symbol -> Symbol -> Bool
/= :: Symbol -> Symbol -> Bool
Eq, Typeable)

joinVals :: MonadFail m => Val -> Val -> m Val
joinVals :: forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals = Val -> Val -> m Val
forall {f :: * -> *}. Applicative f => Val -> Val -> f Val
go
  where
    go :: Val -> Val -> f Val
go Val
VNone Val
v = Val -> f Val
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
    go Val
v Val
VNone = Val -> f Val
forall a. a -> f a
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') = Val -> f Val
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> f Val) -> Val -> f Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t')
    go (VString Text
t) (VContent Seq Content
cs) = Val -> f Val
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> f Val) -> Val -> f Val
forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent (Text -> Content
Txt Text
t Content -> Seq Content -> Seq Content
forall a. a -> Seq a -> Seq a
Seq.<| Seq Content
cs)
    go (VContent Seq Content
cs) (VString Text
t) = Val -> f Val
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> f Val) -> Val -> f Val
forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent (Seq Content
cs Seq Content -> Content -> Seq Content
forall a. Seq a -> a -> Seq a
Seq.|> Text -> Content
Txt Text
t)
    go (VContent Seq Content
cs) (VContent Seq Content
cs') = Val -> f Val
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> f Val) -> Val -> f Val
forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent (Seq Content
cs Seq Content -> Seq Content -> Seq Content
forall a. Semigroup a => a -> a -> a
<> Seq Content
cs')
    go (VArray Vector Val
vec) (VArray Vector Val
vec') = Val -> f Val
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> f Val) -> Val -> f Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val
vec Vector Val -> Vector Val -> Vector Val
forall a. Semigroup a => a -> a -> a
<> Vector Val
vec')
    go Val
x Val
y = Val -> f Val
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> f Val) -> Val -> f Val
forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent (Seq Content -> Val) -> Seq Content -> Val
forall a b. (a -> b) -> a -> b
$ Val -> Seq Content
valToContent Val
x Seq Content -> Seq Content -> Seq Content
forall a. Semigroup a => a -> a -> a
<> Val -> Seq Content
valToContent Val
y

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

instance Compare Val where
  comp :: Val -> Val -> Maybe Ordering
comp Val
VNone Val
VNone = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
EQ
  comp Val
VAuto Val
VAuto = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
EQ
  comp (VBoolean Bool
b1) (VBoolean Bool
b2) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Bool
b1 Bool
b2
  comp (VInteger Integer
i1) (VInteger Integer
i2) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
i1 Integer
i2
  comp (VFloat Double
f1) (VFloat Double
f2) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
f1 Double
f2
  comp (VInteger Integer
i1) (VFloat Double
f2) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i1) Double
f2
  comp (VFloat Double
f1) (VInteger Integer
i2) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
f1 (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i2)
  comp (VRatio Rational
r1) (VRatio Rational
r2) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Rational
r1 Rational
r2
  comp (VRatio Rational
r1) (VLength (LRatio Rational
r2)) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Rational
r1 Rational
r2
  comp (VLength (LRatio Rational
r1)) (VRatio Rational
r2) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Rational
r1 Rational
r2
  comp (VRatio Rational
r1) Val
x = Val -> Val -> Maybe Ordering
forall a. Compare a => a -> a -> Maybe Ordering
comp (Double -> Val
VFloat (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r1)) Val
x
  comp Val
x (VRatio Rational
r1) = Val -> Val -> Maybe Ordering
forall a. Compare a => a -> a -> Maybe Ordering
comp Val
x (Double -> Val
VFloat (Rational -> Double
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 {}) = Maybe Ordering
forall a. Maybe a
Nothing
  comp (VAngle Double
x1) (VAngle Double
x2) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
x1 Double
x2
  comp (VFraction Double
x1) (VFraction Double
x2) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
x1 Double
x2
  comp (VColor Color
c1) (VColor Color
c2) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Color -> Color -> Ordering
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)]
_)) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
s1 Text
s2
  comp (VString Text
s1) (VString Text
s2) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
s1 Text
s2
  comp (VContent Seq Content
c1) (VContent Seq Content
c2) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Seq Content -> Seq Content -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Seq Content
c1 Seq Content
c2
  comp (VArray Vector Val
v1) (VArray Vector Val
v2) =
    Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ (Val -> Val -> Ordering) -> Vector Val -> Vector Val -> Ordering
forall a b.
(a -> b -> Ordering) -> Vector a -> Vector b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare (\Val
x Val
y -> Ordering -> Maybe Ordering -> Ordering
forall a. a -> Maybe a -> a
fromMaybe Ordering
LT (Val -> Val -> Maybe Ordering
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) =
    Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ (Val -> Val -> Ordering)
-> Map Identifier Val -> Map Identifier Val -> Ordering
forall a b.
(a -> b -> Ordering)
-> Map Identifier a -> Map Identifier b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare (\Val
x Val
y -> Ordering -> Maybe Ordering -> Ordering
forall a. a -> Maybe a -> a
fromMaybe Ordering
LT (Val -> Val -> Maybe Ordering
forall a. Compare a => a -> a -> Maybe Ordering
comp Val
x Val
y)) (OMap Identifier Val -> Map Identifier Val
forall k v. OMap k v -> Map k v
OM.toMap OMap Identifier Val
m1) (OMap Identifier Val -> Map Identifier Val
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
_) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Identifier -> Identifier -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Identifier
i1 Identifier
i2
  comp (VType ValType
ty1) (VType ValType
ty2) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ ValType -> ValType -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ValType
ty1 ValType
ty2
  comp (VType ValType
TInteger) (VString Text
"integer") = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
EQ
  comp (VString Text
"integer") (VType ValType
TInteger) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
EQ
  comp (VType ValType
ty) (VString Text
s) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ValType -> Text
prettyType ValType
ty) Text
s
  comp (VString Text
s) (VType ValType
ty)  = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
s (ValType -> Text
prettyType ValType
ty)
  comp (VVersion [Integer]
as) (VVersion [Integer]
bs)
    | [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
as Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
bs =
       Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Integer] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Integer]
as ([Integer]
bs [Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++ Int -> Integer -> [Integer]
forall a. Int -> a -> [a]
replicate ([Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
as Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
bs) Integer
0)
    | Bool
otherwise =
       Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Integer] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Integer]
as [Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++ Int -> Integer -> [Integer]
forall a. Int -> a -> [a]
replicate ([Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
as Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
bs) Integer
0) [Integer]
bs
  comp Val
_ Val
_ = Maybe Ordering
forall a. Maybe a
Nothing

instance Ord Val where
  compare :: Val -> Val -> Ordering
compare Val
v1 Val
v2 = Ordering -> Maybe Ordering -> Ordering
forall a. a -> Maybe a -> a
fromMaybe Ordering
EQ (Maybe Ordering -> Ordering) -> Maybe Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$ Val -> Val -> Maybe Ordering
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) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Integer -> Val
VInteger (-Integer
i)
  maybeNegate (VFloat Double
f) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (-Double
f)
  maybeNegate (VLength Length
x) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength (Length -> Val) -> Length -> Val
forall a b. (a -> b) -> a -> b
$ Length -> Length
negateLength Length
x
  maybeNegate (VAngle Double
x) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VAngle (-Double
x)
  maybeNegate (VFraction Double
x) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFraction (-Double
x)
  maybeNegate (VRatio Rational
x) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (-Rational
x)
  maybeNegate Val
v = String -> Maybe Val
forall a. String -> Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Maybe Val) -> String -> Maybe Val
forall a b. (a -> b) -> a -> b
$ String
"could not negate " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Val -> String
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 = a -> Maybe a
forall a. Negatable a => a -> Maybe a
maybeNegate a
y Maybe a -> (a -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> a -> Maybe a
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 = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x
  maybePlus Val
x Val
VNone = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x
  maybePlus (VInteger Integer
i1) (VInteger Integer
i2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Integer -> Val
VInteger (Integer
i1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i2)
  maybePlus (VRatio Rational
r1) (VRatio Rational
r2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (Rational
r1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
r2)
  maybePlus (VFloat Double
f1) (VFloat Double
f2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
f1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
f2)
  maybePlus (VInteger Integer
i1) (VFloat Double
f2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
f2)
  maybePlus (VFloat Double
f1) (VInteger Integer
i2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
f1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i2)
  maybePlus (VInteger Integer
i1) (VRatio Rational
r2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
r2)
  maybePlus (VRatio Rational
r1) (VInteger Integer
i2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (Rational
r1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i2)
  maybePlus (VFloat Double
f1) (VRatio Rational
r2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
f1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r2)
  maybePlus (VRatio Rational
r1) (VFloat Double
f2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
f2)
  maybePlus (VString Text
s1) (VString Text
s2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Text
s1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s2)
  maybePlus (VContent Seq Content
c1) (VContent Seq Content
c2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent (Seq Content
c1 Seq Content -> Seq Content -> Seq Content
forall a. Semigroup a => a -> a -> a
<> Seq Content
c2)
  maybePlus (VString Text
s1) (VContent Seq Content
c2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent (Text -> Content
Txt Text
s1 Content -> Seq Content -> Seq Content
forall a. a -> Seq a -> Seq a
Seq.<| Seq Content
c2)
  maybePlus (VContent Seq Content
c1) (VString Text
s2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent (Seq Content
c1 Seq Content -> Content -> Seq Content
forall a. Seq a -> a -> Seq a
Seq.|> Text -> Content
Txt Text
s2)
  maybePlus (VString Text
s1) sym :: Val
sym@(VSymbol{}) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Text
s1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Val -> Text
repr Val
sym)
  maybePlus sym :: Val
sym@(VSymbol{}) (VString Text
s2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Val -> Text
repr Val
sym Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s2)
  maybePlus (VLength Length
l1) (VLength Length
l2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength (Length
l1 Length -> Length -> Length
forall a. Semigroup a => a -> a -> a
<> Length
l2)
  maybePlus (VLength Length
l1) (VRatio Rational
r1) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength (Length
l1 Length -> Length -> Length
forall a. Semigroup a => a -> a -> a
<> Rational -> Length
LRatio Rational
r1)
  maybePlus (VRatio Rational
r1) (VLength Length
l1) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength (Length
l1 Length -> Length -> Length
forall a. Semigroup a => a -> a -> a
<> Rational -> Length
LRatio Rational
r1)
  maybePlus (VAngle Double
a1) (VAngle Double
a2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VAngle (Double
a1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
a2)
  maybePlus (VFraction Double
f1) (VFraction Double
f2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFraction (Double
f1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
f2)
  maybePlus (VArray Vector Val
v1) (VArray Vector Val
v2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val
v1 Vector Val -> Vector Val -> Vector Val
forall a. Semigroup a => a -> a -> a
<> Vector Val
v2)
  maybePlus (VDict OMap Identifier Val
m1) (VDict OMap Identifier Val
m2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ OMap Identifier Val -> Val
VDict (OMap Identifier Val
m1 OMap Identifier Val -> OMap Identifier Val -> OMap Identifier Val
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'
    Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ OMap Identifier Val -> Val
VDict (OMap Identifier Val -> Val) -> OMap Identifier Val -> Val
forall a b. (a -> b) -> a -> b
$ [(Identifier, Val)] -> OMap Identifier Val
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) = Val -> Val -> Maybe Val
forall a. Summable a => a -> a -> Maybe a
maybePlus (Color -> Val
VColor Color
c) (Length -> Val
VLength Length
l)
  maybePlus Val
v1 Val
v2 = String -> Maybe Val
forall a. String -> Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Maybe Val) -> String -> Maybe Val
forall a b. (a -> b) -> a -> b
$ String
"could not add " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Val -> String
forall a. Show a => a -> String
show Val
v1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" and " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Val -> String
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) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Integer -> Val
VInteger (Integer
i1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i2)
  maybeTimes (VFloat Double
x1) (VFloat Double
x2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x2)
  maybeTimes (VInteger Integer
i1) (VFloat Double
f2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
f2)
  maybeTimes (VFloat Double
f1) (VInteger Integer
i2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
f1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i2)
  maybeTimes (VInteger Integer
i) (VArray Vector Val
v) =
    Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray ([Vector Val] -> Vector Val
forall a. Monoid a => [a] -> a
mconcat ([Vector Val] -> Vector Val) -> [Vector Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$ Int -> Vector Val -> [Vector Val]
forall a. Int -> a -> [a]
replicate (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Vector Val
v)
  maybeTimes (VArray Vector Val
v) (VInteger Integer
i) =
    Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray ([Vector Val] -> Vector Val
forall a. Monoid a => [a] -> a
mconcat ([Vector Val] -> Vector Val) -> [Vector Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$ Int -> Vector Val -> [Vector Val]
forall a. Int -> a -> [a]
replicate (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Vector Val
v)
  maybeTimes (VInteger Integer
i) (VString Text
s)
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Int -> Text -> Text
T.replicate (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Text
s)
  maybeTimes (VString Text
s) (VInteger Integer
i)
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Int -> Text -> Text
T.replicate (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Text
s)
  maybeTimes (VInteger Integer
i) (VContent Seq Content
c)
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent ([Seq Content] -> Seq Content
forall a. Monoid a => [a] -> a
mconcat ([Seq Content] -> Seq Content) -> [Seq Content] -> Seq Content
forall a b. (a -> b) -> a -> b
$ Int -> Seq Content -> [Seq Content]
forall a. Int -> a -> [a]
replicate (Integer -> Int
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 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent ([Seq Content] -> Seq Content
forall a. Monoid a => [a] -> a
mconcat ([Seq Content] -> Seq Content) -> [Seq Content] -> Seq Content
forall a b. (a -> b) -> a -> b
$ Int -> Seq Content -> [Seq Content]
forall a. Int -> a -> [a]
replicate (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Seq Content
c)
  maybeTimes (VInteger Integer
i) (VLength Length
l) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength (Length -> Val) -> Length -> Val
forall a b. (a -> b) -> a -> b
$ Double -> Length -> Length
timesLength (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Length
l
  maybeTimes (VLength Length
l) (VInteger Integer
i) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength (Length -> Val) -> Length -> Val
forall a b. (a -> b) -> a -> b
$ Double -> Length -> Length
timesLength (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Length
l
  maybeTimes (VRatio Rational
r) (VLength Length
l) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength (Length -> Val) -> Length -> Val
forall a b. (a -> b) -> a -> b
$ Double -> Length -> Length
timesLength (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r) Length
l
  maybeTimes (VLength Length
l) (VRatio Rational
r) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength (Length -> Val) -> Length -> Val
forall a b. (a -> b) -> a -> b
$ Double -> Length -> Length
timesLength (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r) Length
l
  maybeTimes (VFloat Double
f) (VLength Length
l) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength (Length -> Val) -> Length -> Val
forall a b. (a -> b) -> a -> b
$ Double -> Length -> Length
timesLength Double
f Length
l
  maybeTimes (VLength Length
l) (VFloat Double
f) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Length -> Val
VLength (Length -> Val) -> Length -> Val
forall a b. (a -> b) -> a -> b
$ Double -> Length -> Length
timesLength Double
f Length
l
  maybeTimes (VInteger Integer
i) (VAngle Double
a) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VAngle (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a)
  maybeTimes (VAngle Double
a) (VInteger Integer
i) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VAngle (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a)
  maybeTimes (VFloat Double
f) (VAngle Double
a) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VAngle (Double
f Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a)
  maybeTimes (VAngle Double
a) (VFloat Double
f) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VAngle (Double
f Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a)
  maybeTimes (VInteger Integer
i) (VFraction Double
f) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFraction (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
f)
  maybeTimes (VFraction Double
f) (VInteger Integer
i) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFraction (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
f)
  maybeTimes (VFloat Double
x) (VFraction Double
f) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFraction (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
f)
  maybeTimes (VFraction Double
f) (VFloat Double
x) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFraction (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
f)
  maybeTimes (VFraction Double
f1) (VFraction Double
f2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFraction (Double
f1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
f2)
  maybeTimes (VRatio Rational
r1) (VRatio Rational
r2) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (Rational
r1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r2)
  maybeTimes (VInteger Integer
i) (VRatio Rational
r) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r)
  maybeTimes (VRatio Rational
r) (VInteger Integer
i) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r)
  maybeTimes (VFloat Double
x) (VRatio Rational
r) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (Double -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r)
  maybeTimes (VRatio Rational
r) (VFloat Double
x) = Val -> Maybe Val
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Rational -> Val
VRatio (Double -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r)
  maybeTimes Val
v1 Val
v2 = String -> Maybe Val
forall a. String -> Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Maybe Val) -> String -> Maybe Val
forall a b. (a -> b) -> a -> b
$ String
"could not multiply " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Val -> String
forall a. Show a => a -> String
show Val
v1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" and " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Val -> String
forall a. Show a => a -> String
show Val
v2

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

instance Eq Content where
  Txt Text
t1 == :: Content -> Content -> Bool
== Txt Text
t2 = Text
t1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t2
  Lab Text
t1 == Lab Text
t2 = Text
t1 Text -> Text -> Bool
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 Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
n2 Bool -> Bool -> Bool
&& Map Identifier Val
f1 Map Identifier Val -> Map Identifier Val -> Bool
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) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
t1 Text
t2
  compare (Lab Text
t1) (Lab Text
t2) = Text -> Text -> Ordering
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) = (Identifier, Map Identifier Val)
-> (Identifier, Map Identifier Val) -> Ordering
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
(Int -> Scope -> ShowS)
-> (Scope -> String) -> ([Scope] -> ShowS) -> Show Scope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scope -> ShowS
showsPrec :: Int -> Scope -> ShowS
$cshow :: Scope -> String
show :: Scope -> String
$cshowList :: [Scope] -> ShowS
showList :: [Scope] -> ShowS
Show, Eq Scope
Eq Scope =>
(Scope -> Scope -> Ordering)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Scope)
-> (Scope -> Scope -> Scope)
-> Ord 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
$ccompare :: Scope -> Scope -> Ordering
compare :: Scope -> Scope -> Ordering
$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
>= :: Scope -> Scope -> Bool
$cmax :: Scope -> Scope -> Scope
max :: Scope -> Scope -> Scope
$cmin :: Scope -> Scope -> Scope
min :: Scope -> Scope -> Scope
Ord, Scope -> Scope -> Bool
(Scope -> Scope -> Bool) -> (Scope -> Scope -> Bool) -> Eq Scope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
/= :: Scope -> Scope -> Bool
Eq)

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

data Operations m =
  Operations
  { forall (m :: * -> *). Operations m -> String -> m ByteString
loadBytes :: FilePath -> m BS.ByteString
  , forall (m :: * -> *). Operations m -> m UTCTime
currentUTCTime :: m UTCTime
  , forall (m :: * -> *). Operations m -> String -> m (Maybe String)
lookupEnvVar :: String -> m (Maybe String)
  , forall (m :: * -> *). Operations m -> String -> m Bool
checkExistence :: FilePath -> m Bool
  }

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
evalPackageRoot :: FilePath,
    forall (m :: * -> *). EvalState m -> Operations m
evalOperations :: Operations m
  }

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

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

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

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

instance Monad Attempt where
  return :: forall a. a -> Attempt a
return = a -> Attempt a
forall a. a -> Attempt a
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
_ = String -> 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 = String -> Attempt a
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 " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Selector -> String
forall a. Show a => a -> String
show Selector
sel String -> ShowS
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
(Int -> Arguments -> ShowS)
-> (Arguments -> String)
-> ([Arguments] -> ShowS)
-> Show Arguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Arguments -> ShowS
showsPrec :: Int -> Arguments -> ShowS
$cshow :: Arguments -> String
show :: Arguments -> String
$cshowList :: [Arguments] -> ShowS
showList :: [Arguments] -> ShowS
Show, Arguments -> Arguments -> Bool
(Arguments -> Arguments -> Bool)
-> (Arguments -> Arguments -> Bool) -> Eq Arguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Arguments -> Arguments -> Bool
== :: Arguments -> Arguments -> Bool
$c/= :: Arguments -> Arguments -> Bool
/= :: 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) ((Identifier -> Val -> Val -> Val)
-> OMap Identifier Val
-> OMap Identifier Val
-> OMap Identifier Val
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 ([Val] -> Val
forall a. HasCallStack => [a] -> a
last [Val]
xs)) of
    (ValType
TAlignment, ValType
TAlignment) -> [Val] -> [Val]
forall a. HasCallStack => [a] -> [a]
init [Val]
xs [Val] -> [Val] -> [Val]
forall a. [a] -> [a] -> [a]
++ Val
y Val -> [Val] -> [Val]
forall a. a -> [a] -> [a]
: [Val]
ys
    (ValType
TLength, ValType
TLength) -> [Val] -> [Val]
forall a. HasCallStack => [a] -> [a]
init [Val]
xs [Val] -> [Val] -> [Val]
forall a. [a] -> [a] -> [a]
++ Val
y Val -> [Val] -> [Val]
forall a. a -> [a] -> [a]
: [Val]
ys
    (ValType
TAngle, ValType
TAngle) -> [Val] -> [Val]
forall a. HasCallStack => [a] -> [a]
init [Val]
xs [Val] -> [Val] -> [Val]
forall a. [a] -> [a] -> [a]
++ Val
y Val -> [Val] -> [Val]
forall a. a -> [a] -> [a]
: [Val]
ys
    (ValType
TColor, ValType
TColor) -> [Val] -> [Val]
forall a. HasCallStack => [a] -> [a]
init [Val]
xs [Val] -> [Val] -> [Val]
forall a. [a] -> [a] -> [a]
++ Val
y Val -> [Val] -> [Val]
forall a. a -> [a] -> [a]
: [Val]
ys
    (ValType, ValType)
_ -> [Val]
xs [Val] -> [Val] -> [Val]
forall a. [a] -> [a] -> [a]
++ Val
y Val -> [Val] -> [Val]
forall a. a -> [a] -> [a]
: [Val]
ys
combinePositional [Val]
xs [Val]
ys = [Val]
xs [Val] -> [Val] -> [Val]
forall a. [a] -> [a] -> [a]
++ [Val]
ys

instance Monoid Arguments where
  mappend :: Arguments -> Arguments -> Arguments
mappend = Arguments -> Arguments -> Arguments
forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: Arguments
  mempty :: Arguments
mempty = [Val] -> OMap Identifier Val -> Arguments
Arguments [Val]
forall a. Monoid a => a
mempty OMap Identifier Val
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 [Val] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Arguments -> [Val]
positional Arguments
args) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
idx
    then String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not enough arguments"
    else Val -> m a
forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m a
fromVal (Arguments -> [Val]
positional Arguments
args [Val] -> Int -> Val
forall a. HasCallStack => [a] -> Int -> a
!! (Int
idx Int -> Int -> Int
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 Identifier -> OMap Identifier Val -> Maybe Val
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 -> String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"No argument named " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
name
    Just Val
v -> Val -> m a
forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m a
fromVal Val
v

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

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

data Length
  = LExact Double LUnit
  | LRatio !Rational
  | LSum Length Length
  deriving (Int -> Length -> ShowS
[Length] -> ShowS
Length -> String
(Int -> Length -> ShowS)
-> (Length -> String) -> ([Length] -> ShowS) -> Show Length
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Length -> ShowS
showsPrec :: Int -> Length -> ShowS
$cshow :: Length -> String
show :: Length -> String
$cshowList :: [Length] -> ShowS
showList :: [Length] -> ShowS
Show, Length -> Length -> Bool
(Length -> Length -> Bool)
-> (Length -> Length -> Bool) -> Eq Length
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Length -> Length -> Bool
== :: Length -> Length -> Bool
$c/= :: Length -> Length -> Bool
/= :: 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 Rational -> Rational -> Rational
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 = Length -> Length -> Length
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) = (Double, LUnit) -> Maybe (Double, LUnit)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
y, LUnit
yu)
addLengths (Double
x, LUnit
xu) (Double
0, LUnit
_yu) = (Double, LUnit) -> Maybe (Double, LUnit)
forall a. a -> Maybe a
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 LUnit -> LUnit -> Bool
forall a. Eq a => a -> a -> Bool
== LUnit
yu
    then (Double, LUnit) -> Maybe (Double, LUnit)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
x Double -> Double -> Double
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
      (Double, LUnit) -> Maybe (Double, LUnit)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
x' Double -> Double -> Double
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
l) LUnit
u
timesLength Double
f (LRatio Rational
r) = Rational -> Length
LRatio (Double -> Rational
forall a. Real a => a -> Rational
toRational Double
f Rational -> Rational -> Rational
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 = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
x
toPts LUnit
LEm Double
_ = Maybe Double
forall a. Maybe a
Nothing
toPts LUnit
LIn Double
x = Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
72.0
toPts LUnit
LCm Double
x = Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
28.35
toPts LUnit
LMm Double
x = Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Double
x Double -> Double -> Double
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
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") else Text -> Text
forall a. a -> a
id)
    (Bool -> Length -> Text
renderLength Bool
True Length
l1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" + " Text -> Text -> 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 (Double -> String
forall a. Show a => a -> String
show Double
x) Text -> Text -> Text
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 LUnit -> LUnit -> Bool
forall a. Eq a => a -> a -> Bool
== LUnit
yu = Ordering -> Maybe Ordering
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Ordering
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
      Ordering -> Maybe Ordering
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
x' Double
y'
compareLength (LRatio Rational
x) (LRatio Rational
y) = Ordering -> Maybe Ordering
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> Rational -> Ordering
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 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
    then Length -> Length -> Maybe Ordering
compareLength Length
y1 Length
y2
    else Maybe Ordering
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
compareLength Length
_ Length
_ = Maybe Ordering
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

negateLength :: Length -> Length
negateLength :: Length -> Length
negateLength (LExact Double
x LUnit
u) = Double -> LUnit -> Length
LExact (Double -> Double
forall a. Num a => a -> a
negate Double
x) LUnit
u
negateLength (LRatio Rational
x) = Rational -> Length
LRatio (Rational -> Rational
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
(Int -> Horiz -> ShowS)
-> (Horiz -> String) -> ([Horiz] -> ShowS) -> Show Horiz
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Horiz -> ShowS
showsPrec :: Int -> Horiz -> ShowS
$cshow :: Horiz -> String
show :: Horiz -> String
$cshowList :: [Horiz] -> ShowS
showList :: [Horiz] -> ShowS
Show, Horiz -> Horiz -> Bool
(Horiz -> Horiz -> Bool) -> (Horiz -> Horiz -> Bool) -> Eq Horiz
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Horiz -> Horiz -> Bool
== :: Horiz -> Horiz -> Bool
$c/= :: Horiz -> Horiz -> Bool
/= :: Horiz -> Horiz -> Bool
Eq, Eq Horiz
Eq Horiz =>
(Horiz -> Horiz -> Ordering)
-> (Horiz -> Horiz -> Bool)
-> (Horiz -> Horiz -> Bool)
-> (Horiz -> Horiz -> Bool)
-> (Horiz -> Horiz -> Bool)
-> (Horiz -> Horiz -> Horiz)
-> (Horiz -> Horiz -> Horiz)
-> Ord 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
$ccompare :: Horiz -> Horiz -> Ordering
compare :: Horiz -> Horiz -> Ordering
$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
>= :: Horiz -> Horiz -> Bool
$cmax :: Horiz -> Horiz -> Horiz
max :: Horiz -> Horiz -> Horiz
$cmin :: Horiz -> Horiz -> Horiz
min :: Horiz -> Horiz -> Horiz
Ord, Typeable)

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

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

data Direction = Ltr | Rtl | Ttb | Btt
  deriving (Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> String
show :: Direction -> String
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show, Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq, Eq Direction
Eq Direction =>
(Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord 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
$ccompare :: Direction -> Direction -> Ordering
compare :: Direction -> Direction -> Ordering
$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
>= :: Direction -> Direction -> Bool
$cmax :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
min :: Direction -> Direction -> Direction
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
"\"" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
escString Text
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"\""
    VRegex RE
re -> String -> Doc
P.text (RE -> String
forall a. Show a => a -> String
show RE
re)
    VDateTime Maybe Day
d Maybe DiffTime
t -> String -> Doc
P.text ([String] -> String
unwords ([Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes
       [Day -> String
forall a. Show a => a -> String
show (Day -> String) -> Maybe Day -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
d, TimeLocale -> String -> DiffTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%0H:%0M:%0S" (DiffTime -> String) -> Maybe DiffTime -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DiffTime
t]))
    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 (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
x
    VRatio Rational
x -> Text -> Doc
text (Text -> Doc) -> Text -> Doc
forall a b. (a -> b) -> a -> b
$ Rational -> Text
toPercent Rational
x
    VInteger Integer
x -> String -> Doc
P.text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
x
    VAngle Double
x -> String -> Doc
P.text (Double -> String
forall a. Show a => a -> String
show Double
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"deg")
    VLength Length
len -> Text -> Doc
text (Text -> Doc) -> Text -> Doc
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 (Text -> Doc) -> Text -> Doc
forall a b. (a -> b) -> a -> b
$
      case (Maybe Horiz
x, Maybe Vert
y) of
        (Maybe Horiz
Nothing, Maybe Vert
Nothing) -> Text
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(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Horiz -> Text
renderHoriz Horiz
x' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Vert -> Text
renderVert Vert
y' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
      where
        renderHoriz :: Horiz -> Text
renderHoriz = Text -> Text
T.toLower (Text -> Text) -> (Horiz -> Text) -> Horiz -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
5 (Text -> Text) -> (Horiz -> Text) -> Horiz -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Horiz -> String) -> Horiz -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Horiz -> String
forall a. Show a => a -> String
show
        renderVert :: Vert -> Text
renderVert = Text -> Text
T.toLower (Text -> Text) -> (Vert -> Text) -> Vert -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
4 (Text -> Text) -> (Vert -> Text) -> Vert -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Vert -> String) -> Vert -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vert -> String
forall a. Show a => a -> String
show
    VFraction Double
x -> String -> Doc
P.text (Double -> String
forall a. Show a => a -> String
show Double
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"fr")
    VArray Vector Val
xs ->
      Doc -> Doc
P.parens
        ( [Doc] -> Doc
P.cat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
            Doc -> [Doc] -> [Doc]
P.punctuate Doc
", " ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$
              (Val -> Doc) -> [Val] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Val -> Doc
prettyVal (Vector Val -> [Val]
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 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
            Doc -> [Doc] -> [Doc]
P.punctuate Doc
"," ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$
              ( ((Identifier, Val) -> Doc) -> [(Identifier, Val)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map
                  ( \(Identifier Text
k, Val
v) ->
                      Text -> Doc
text Text
k Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
": " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Val -> Doc
prettyVal Val
v
                  )
                  (OMap Identifier Val -> [(Identifier, Val)]
forall k v. OMap k v -> [(k, v)]
OM.assocs OMap Identifier Val
m)
              )
        )
    VDirection Direction
d -> Text -> Doc
text (Text -> Doc) -> Text -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Direction -> String
forall a. Show a => a -> String
show Direction
d
    VFunction Maybe Identifier
_ Map Identifier Val
_ Function
_ -> Doc
forall a. Monoid a => a
mempty
    VLabel Text
t -> Text -> Doc
text (Text -> Doc) -> Text -> Doc
forall a b. (a -> b) -> a -> b
$ Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
    VCounter Counter
_ -> Doc
forall a. Monoid a => a
mempty
    VColor (RGB Rational
r Rational
g Rational
b Rational
o) ->
      Doc
"rgb("
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (Rational -> Text
toPercent Rational
r)
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
","
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (Rational -> Text
toPercent Rational
g)
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
","
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (Rational -> Text
toPercent Rational
b)
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
","
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (Rational -> Text
toPercent Rational
o)
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
")"
    VColor (CMYK Rational
c Rational
m Rational
y Rational
k) ->
      Doc
"cmyk("
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (Rational -> Text
toPercent Rational
c)
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
","
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (Rational -> Text
toPercent Rational
m)
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
","
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (Rational -> Text
toPercent Rational
y)
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
","
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (Rational -> Text
toPercent Rational
k)
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
")"
    VColor (Luma Rational
g) -> Doc
"luma(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (Rational -> Text
toPercent Rational
g) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
")"
    VModule (Identifier Text
modid) Map Identifier Val
_ -> Doc
"<module " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text Text
modid Doc -> Doc -> Doc
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
","
                          ( ((Identifier, Val) -> Doc) -> [(Identifier, Val)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map
                              ( \(Identifier Text
k, Val
v) ->
                                  Text -> Doc
text Text
k Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
": " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Val -> Doc
prettyVal Val
v
                              )
                              (OMap Identifier Val -> [(Identifier, Val)]
forall k v. OMap k v -> [(k, v)]
OM.assocs (Arguments -> OMap Identifier Val
named Arguments
args))
                          )
                      )
                    | Bool -> Bool
not (OMap Identifier Val -> Bool
forall k v. OMap k v -> Bool
OM.null (Arguments -> OMap Identifier Val
named Arguments
args))
                  ]
                    [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [ [Doc] -> Doc
P.cat (Doc -> [Doc] -> [Doc]
P.punctuate Doc
", " ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Val -> Doc) -> [Val] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Val -> Doc
prettyVal (Arguments -> [Val]
positional Arguments
args))
                         | Bool -> Bool
not ([Val] -> Bool
forall a. [a] -> Bool
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
_ -> Doc
forall a. Monoid a => a
mempty
    Val
VStyles -> Doc
forall a. Monoid a => a
mempty
    VVersion [Integer]
xs -> Text -> Doc
text (Text -> Doc) -> Text -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"." ((Integer -> Text) -> [Integer] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show) [Integer]
xs)
    VType ValType
ty -> Text -> Doc
text (Text -> Doc) -> Text -> Doc
forall a b. (a -> b) -> a -> b
$ ValType -> Text
prettyType ValType
ty

prettyType :: ValType -> Text
prettyType :: ValType -> Text
prettyType ValType
TDict = Text
"dictionary"
prettyType ValType
TInteger = Text
"int"
prettyType ValType
x = Text -> Text
T.toLower (Text -> Text) -> (ValType -> Text) -> ValType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (ValType -> String) -> ValType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> (ValType -> String) -> ValType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValType -> String
forall a. Show a => a -> String
show (ValType -> Text) -> ValType -> Text
forall a b. (a -> b) -> a -> b
$ ValType
x

escString :: Text -> P.Doc
escString :: Text -> Doc
escString =
  String -> Doc
P.text (String -> Doc) -> (Text -> String) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
go ShowS -> (Text -> String) -> Text -> String
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
Item String
x]

prettyContent :: Seq Content -> P.Doc
prettyContent :: Seq Content -> Doc
prettyContent Seq Content
cs
  | Seq Content -> Int
forall a. Seq a -> Int
Seq.length Seq Content
cs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = (Content -> Doc) -> Seq Content -> Doc
forall m a. Monoid m => (a -> m) -> Seq a -> m
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
            Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
P.cat (Doc -> [Doc] -> [Doc]
P.punctuate Doc
", " ((Content -> Doc) -> [Content] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Content -> Doc
go (Seq Content -> [Content]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Content
cs)))
            Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
P.space
        )
  where
    go :: Content -> Doc
go (Txt Text
t) = Doc
"[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text Text
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"]"
    go (Lab Text
l) = Doc
"<" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text Text
l Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
">"
    go (Elt (Identifier Text
name) Maybe SourcePos
_ Map Identifier Val
fields) =
      Text -> Doc
text Text
name
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
P.parens
          ( [Doc] -> Doc
P.cat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
              Doc -> [Doc] -> [Doc]
P.punctuate
                Doc
", "
                ( ((Identifier, Val) -> Doc) -> [(Identifier, Val)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map
                    ( \(Identifier Text
k, Val
v) ->
                        Text -> Doc
text Text
k Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
": " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Val -> Doc
prettyVal Val
v
                    )
                    (Map Identifier Val -> [(Identifier, Val)]
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 = Seq Content
forall a. Monoid a => a
mempty
valToContent (VString Text
t) = Content -> Seq Content
forall a. a -> Seq a
Seq.singleton (Content -> Seq Content) -> Content -> Seq Content
forall a b. (a -> b) -> a -> b
$ Text -> Content
Txt Text
t
valToContent (VLabel Text
t) = Content -> Seq Content
forall a. a -> Seq a
Seq.singleton (Content -> Seq Content) -> Content -> Seq Content
forall a b. (a -> b) -> a -> b
$ Text -> Content
Lab Text
t
valToContent Val
x = Content -> Seq Content
forall a. a -> Seq a
Seq.singleton (Content -> Seq Content) -> Content -> Seq Content
forall a b. (a -> b) -> a -> b
$ Text -> Content
Txt (Text -> Content) -> Text -> Content
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 (String -> Text) -> (Val -> String) -> Val -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Doc -> String
P.renderStyle Style
renderStyle (Doc -> String) -> (Val -> Doc) -> Val -> String
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 (Integer -> String
forall a. Show a => a -> String
show (Rational -> Integer
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
100 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
n) :: Integer)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%"

text :: Text -> P.Doc
text :: Text -> Doc
text Text
t = String -> Doc
P.text (String -> Doc) -> String -> Doc
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 [] = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ Identifier -> String
forall a. Show a => a -> String
show Identifier
ident String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" not found"
      go ((a
_, Map Identifier a
i) : [(a, Map Identifier a)]
is) = case Identifier -> Map Identifier a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
ident Map Identifier a
i of
        Just a
v -> a -> m a
forall a. a -> m a
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
  ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState ParsecT [Markup] (EvalState m) m (EvalState m)
-> (EvalState m -> MP m Val) -> MP m Val
forall a b.
ParsecT [Markup] (EvalState m) m a
-> (a -> ParsecT [Markup] (EvalState m) m b)
-> ParsecT [Markup] (EvalState m) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Scope, Map Identifier Val)] -> MP m Val
forall {m :: * -> *} {a} {a}.
MonadFail m =>
[(a, Map Identifier a)] -> m a
go ([(Scope, Map Identifier Val)] -> MP m Val)
-> (EvalState m -> [(Scope, Map Identifier Val)])
-> EvalState m
-> MP m Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState m -> [(Scope, Map Identifier Val)]
forall (m :: * -> *). EvalState m -> [(Scope, Map Identifier Val)]
evalIdentifiers